;;; 6.945 Problem Set #8 Source Code
;;; 04/19/2009
;;; Bryan Newbold <bnewbold@mit.edu>

(load "load")

;;;------------------------------------------------------------------------
;;; Problem 8.2B:

(define the-empty-stream (stream))

(define (lazy-fringe subtree)
  (define (lazy-walk subtree ans)
    (cond ((pair? subtree)
	   (lazy-walk (car subtree) 
		      (lazy-walk (cdr subtree) ans)))
	  ((null? subtree) ans)
	  (else (cons-stream subtree ans))))
  (lazy-walk subtree the-empty-stream))

(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))))

#| Test it!
(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.5:

(define (make-pipe)
  (let ((queue (queue:make))
	(lock (conspire:make-lock)))
    (list lock queue)))

(define (pipe-writer p)
  (lambda (thing)
    (conspire:acquire-lock (car p))
    (queue:add-to-end! (cadr p) thing)
    (conspire:unlock (car p))))

(define (pipe-reader p)
  (lambda ()
    (let lp ((nothing-here 0))
      (conspire:acquire-lock (car p))
      (cond ((queue:empty? (cadr p))
	     (conspire:unlock (car p))
	     (conspire:thread-yield)
	     (lp 0))
	    (else
	     (let ((ans (queue:get-first (cadr p))))
	       (conspire:unlock (car p))
	       ans))))))

#| Test!

(with-conspiracy
    (lambda ()
      (define test-pipe (make-pipe))
      (define reader (pipe-reader test-pipe))
      (define writer (pipe-writer test-pipe))
      (writer 10)
      (writer 20)
      (reader)))
;Value: 10

|#



     (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*))

#| Test some more!

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

|#

;;;------------------------------------------------------------------------
;;; Problem 8.6:

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

#| Testy!

(with-conspiracy
    (lambda ()
      (make-threaded-filter (lambda x x))))
;Value: #[compound-procedure 31]

(with-conspiracy
    (lambda ()
      (define make-an-int
	(let ((count 0))
	  (lambda ()
	    (set! count (+ count 1))
	    count)))
      (define (return-an-int return)
	(return (make-an-int)))
      (return-an-int pp)
      (define go
	(make-threaded-filter return-an-int))
      (go)))
;Value: 2

|#

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

(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
|#