;; Nada Amin (namin@mit.edu)
;; 6.945 Problem Set 8
;; Due: Wed. 16 Apr. 2008

;(load "../test-manager/load.scm")
(load "load.scm")

;; Problem 8.1
#|

Let N be the sum of the depth of all terminal leaves. Then the fringe
procedure takes O(N) time and space. Indeed, for each terminal leaf,
append might copy it at most a number of times proportional to its
depth.

|#

;; Problem 8.2

;; A.
#|

If we had not thunkified the second argument to be appended, then
(lazy-fringe (cdr subtree)) would be executed non-lazily recursively, and so
we would be doing much more work in advance than necessary.

|#

;; B.

(define (lazy-fringe subtree)
  (define (walk subtree thunk)
    (cond ((pair? subtree)
	   (walk (car subtree)
		 (lambda ()
		   (walk (cdr subtree)
			 thunk))))
	  ((null? subtree)
	   (thunk))
	  (else (cons-stream subtree (thunk)))))
  (walk subtree (lambda () '())))

(define (lazy-same-fringe? tree1 tree2)
  (let lp ((f1 (lazy-fringe tree1))
	   (f2 (lazy-fringe tree2)))
    (cond ((and (stream-null? f1) (stream-null? f2)) #t)
	  ((or  (stream-null? f1) (stream-null? f2)) #f)
	  ((eq? (stream-car   f1) (stream-car   f2))
	   (lp  (stream-cdr   f1) (stream-cdr   f2)))
	  (else #f))))
#|
(lazy-same-fringe? '((a b) c ((d)) e (f ((g h))))
		   '(a b c ((d) () e) (f (g (h)))))
;Value: #t

(lazy-same-fringe? '((a b) c ((d)) e (f ((g h))))
                   '(a b c ((d) () e) (g (f (h)))))
;Value: #f
|#

;; Problem 8.3

#|

It is necessary to use the expression "(lambda () (resume-thunk))"
rather than just "resume-thunk" as the returned value of the fringe
generator, so that "(set! resume-thunk continue)" affects the returned
value.

|#

;; Problem 8.4

#| 

If we accidentally left out the return when done, we would be messing
up the coroutine mechanism at the end. We would just keep resuming the
thunk from the same old continuation, without updating it, so the
thunk would ignore its new context totally.

Example:
(define x (make-coroutine (lambda (return) (lambda () (return 'bar) 'foo))))
(x)
; Value: bar
(list (x) (x))
; Value: foo, instead of (foo foo)

#|

;; Problem 8.5

(define (make-pipe)
  (define lock (conspire:make-lock))
  (define queue (queue:make))
  (define (writer value)
    (conspire:acquire-lock lock)
    (queue:add-to-end! queue value)
    (conspire:unlock lock)
    value)
  (define (reader)
    (conspire:acquire-lock lock)
    (if (queue:empty? queue)
	(begin
	  (conspire:unlock lock)
	  (conspire:switch-threads
	   (lambda () (not (queue:empty? queue))))
	  (reader))
	(let ((value (queue:get-first queue)))
	  (conspire:unlock lock)
	  value)))
  (list writer reader))

(define (pipe-writer pipe) (car pipe))

(define (pipe-reader pipe) (cadr pipe))

(define *done* (list '*done*))

(define (piped-same-fringe? tree1 tree2)
  (let ((p1 (make-pipe)) (p2 (make-pipe)))
    (let ((thread1
	   (conspire:make-thread
	    conspire:runnable
	    (lambda ()
	      (piped-fringe-generator tree1 (pipe-writer p1)))))
	  (thread2
	   (conspire:make-thread
	    conspire:runnable
	    (lambda ()
	      (piped-fringe-generator tree2 (pipe-writer p2)))))
	  (f1 (pipe-reader p1))
	  (f2 (pipe-reader p2)))
      (let lp ((x1 (f1)) (x2 (f2)))
	(cond ((and (eq? x1 *done*) (eq? x2 *done*)) #t)
	      ((or  (eq? x1 *done*) (eq? x2 *done*)) #f)
	      ((eq? x1 x2) (lp (f1) (f2)))
	      (else #f))))))

(define (piped-fringe-generator tree return)
  (define (lp tree)
    (cond ((pair? tree)
	   (lp (car tree))
	   (lp (cdr tree)))
	  ((null? tree) unspecific)
	  (else
	   (return tree))))
  (lp tree)
  (return *done*))

#|
(define (print-same-fringe tree1 tree2)
  (if (piped-same-fringe? tree1 tree2)
      (write-line `(same fringe ,tree1 ,tree2))
      (write-line `(diff fringe ,tree1 ,tree2))))

(with-time-sharing-conspiracy
 (lambda ()
   (conspire:make-thread 
    conspire:runnable
    (lambda ()
      (print-same-fringe '((a b) c ((d)) e (f ((g h))))
			 '(a b c ((d) () e) (f (g (h)))))))
   (conspire:make-thread 
    conspire:runnable
    (lambda ()
      (print-same-fringe '((a b) c ((d)) e (f ((g h))))
			 '(a b c ((d) () e) (g (f (h)))))))
   (conspire:null-job)))

(same fringe ((a b) c ((d)) e (f ((g h)))) (a b c ((d) () e) (f (g (h)))))
(diff fringe ((a b) c ((d)) e (f ((g h)))) (a b c ((d) () e) (g (f (h)))))
;Value: done
|#

;; Problem 8.6

(define (make-threaded-filter job)
  (let ((pipe (make-pipe)))
    (let ((writer (pipe-writer pipe))
	  (reader (pipe-reader pipe)))
      (conspire:make-thread conspire:runnable (lambda () (job writer)))
      reader)))

(define (tf-piped-same-fringe? tree1 tree2)
  (let ((f1 (make-threaded-filter (tf-piped-fringe-generator tree1)))
	(f2 (make-threaded-filter (tf-piped-fringe-generator tree2))))
    (let lp ((x1 (f1)) (x2 (f2)))
      (cond ((and (eq? x1 *done*) (eq? x2 *done*)) #t)
	    ((or  (eq? x1 *done*) (eq? x2 *done*)) #f)
	    ((eq? x1 x2) (lp (f1) (f2)))
	    (else #f)))))

(define (tf-piped-fringe-generator tree)
  (lambda (return)
    (define (lp tree)
      (cond ((pair? tree)
	     (lp (car tree))
	     (lp (cdr tree)))
	    ((null? tree) unspecific)
	    (else
	     (return tree))))
    (lp tree)
    (return *done*)))

#|
(with-time-sharing-conspiracy
 (lambda ()
   (tf-piped-same-fringe?
    '((a b) c ((d)) e (f ((g h))))
    '(a b c ((d) () e) (f (g (h)))))
   ))
;Value: #t

(with-time-sharing-conspiracy
 (lambda ()
   (tf-piped-same-fringe?
    '((a b) c ((d)) e (f ((g h))))
    '(a b c ((d) () e) (g (f (h)))))
   ))
;Value: #f

(with-time-sharing-conspiracy
 (lambda ()
   (tf-piped-same-fringe?
    '((a b) c ((d)) e (f ((g h))))
    '(a b c ((d) () e) (g (f ))))
   ))
;Value: #f
|#