1 files changed, 214 insertions, 0 deletions
diff --git a/ps08_conspiracies/bnewbold_ps08_work.scm b/ps08_conspiracies/bnewbold_ps08_work.scm
new file mode 100644
index 0000000..42686ec
--- /dev/null
+++ b/ps08_conspiracies/bnewbold_ps08_work.scm
@@ -0,0 +1,214 @@
+;;; 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
+|#