;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;	ObserverMemoryLeak.scheme
;;	Kulisics, Joseph D.
;;	2008 April 4
;;
;;	A scheme example of unintentional object retention.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;	LOCAL-INPUT-OBJECT
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define local-input-object (lambda (observer)
   (let ((SendDatum
            (lambda (datum)
	       ((observer 'ReceiveDatum) datum))))
      (letrec ((ReadLoop
                  (lambda ()
		     (let ((outobj (local-output-object observer)))
		        (begin
		           (display "Enter a number: ")
			   ((observer 'ReceiveDatum) (read))
			   (ReadLoop))))))
         (let ((dispatch
	          (lambda (message)
		     (cond ((equal? message 'SendDatum) SendDatum)
		           ((equal? message 'ReadLoop) ReadLoop)
		           (else (error "local-input-object: Unknown Message" message))))))
            dispatch)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;	LOCAL-OUTPUT-OBJECT
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define local-output-object (lambda (observer)
   (let ((local-datum #f))
      (let ((ReceiveDatum
               (lambda (datum)
		  (if (not local-datum)
		      (begin
		         (set! local-datum datum)
			 (display local-datum)
			 (newline))
		      (begin
	                 (display local-datum)
		         (newline))))))
         (let ((dispatch
	          (lambda (message)
		     (cond ((equal? message 'ReceiveDatum) ReceiveDatum)
			   (else (error "local-output-object: Unknown Message" message))))))
	    ((observer 'AddDatumListener) dispatch))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;	OBSERVER
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define observer (lambda ()
   (let ((listeners '()))
      (let ((SendDatum
               (letrec ((SendIter
	                   (lambda (datum listeners)
			      (if (null? listeners)
			          #t
				  (begin
				     (((car listeners) 'ReceiveDatum) datum)
				     (SendIter datum (cdr listeners)))))))
	          (lambda (datum) (SendIter datum listeners)))))
         (let ((ReceiveDatum (lambda (datum) (SendDatum datum)))
               (AddDatumListener (lambda (object) (begin (set! listeners (cons object listeners)) object)))
               (RemoveDatumListener
	          (letrec ((RemoveIter
		              (lambda (object listeners)
			         (cond ((null? listeners) listeners)
			               ((eq? (car listeners) object) (RemoveIter object (cdr listeners)))
				       (else (cons (car listeners) (RemoveIter object (cdr listeners))))))))
	             (lambda (object) (begin (set! listeners (RemoveIter object listeners)) object))))
               (DebugListeners (lambda () listeners)))
            (let ((dispatch
	             (lambda (message)
			(cond ((equal? message 'ReceiveDatum) ReceiveDatum)
		           ((equal? message 'SendDatum) SendDatum)
			   ((equal? message 'AddDatumListener) AddDatumListener)
			   ((equal? message 'RemoveDatumListener) RemoveDatumListener)
			   ((equal? message 'DebugListeners) DebugListeners)
			   (else (error "observer: Unknown Message" message))))))
               dispatch))))))
      
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;	DRIVER
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(newline)
(define test (local-input-object (observer)))
((test 'ReadLoop))