summaryrefslogtreecommitdiffstats
path: root/ps08_conspiracies
diff options
context:
space:
mode:
Diffstat (limited to 'ps08_conspiracies')
-rw-r--r--ps08_conspiracies/bnewbold_ps08.txt59
-rw-r--r--ps08_conspiracies/bnewbold_ps08_work.scm214
-rw-r--r--ps08_conspiracies/load.scm2
3 files changed, 274 insertions, 1 deletions
diff --git a/ps08_conspiracies/bnewbold_ps08.txt b/ps08_conspiracies/bnewbold_ps08.txt
new file mode 100644
index 0000000..5a7c174
--- /dev/null
+++ b/ps08_conspiracies/bnewbold_ps08.txt
@@ -0,0 +1,59 @@
+;;; 6.945 Problem Set #8 Comments
+;;; 04/18/2009
+;;; Bryan Newbold <bnewbold@mit.edu>
+
+Problem 8.1:
+--------------------------------
+The algorithm is of O(n^2) in the number of list elements including empty lists
+and and the implicit empty list which terminates every list. The total number
+of elements is thus larger than the resulting fringe by a factor of the depth
+(plus whatever extra non-implicit empty lists).
+
+Problem 8.2:
+--------------------------------
+A)
+If it wasn't thunk-ified, the expression (lazy-fringe (cdr subtree)) passed as
+a parameter to stream-append would be recursively evaluated when first passed;
+delaying this evaluation is the entire point. The way to go forward with
+stream-append would be to turn the reference to (cdr subtree) into a lazy
+stream itself; thunkifying does effectively the same thing.
+
+B)
+[see code in bnewbold_ps08_work.scm]
+
+Problem 8.3:
+--------------------------------
+The side effects from use of set! ruin any lambda-calculus rules. Here the
+lambda wrapper preserves the context of resume-thunk; the procedure associated
+with resume-thunk can get set! to something new, but the version wrapped up in
+a lambda and returned will be the original procedure defined a couple
+expressions earlier.
+
+Problem 8.4:
+--------------------------------
+Running with pretty print gives the following output:
+
+ (a a)
+ (b b)
+ (c c)
+ (d d)
+ (e e)
+ (f f)
+ (g g)
+ (h h)
+ ((*done*) a)
+ ;Value: #f
+
+Without passing *done* to return, *done* thunks through out of all the built
+up continuations, dragging the evaluation context back to the point when it
+was acs-coroutine-fringe-generator was first defined. This causes f2 to be
+redefined starting at the begining of the tree ('a) so that the two
+coroutines never return *done* together.
+
+Problem 8.5:
+--------------------------------
+[see code in bnewbold_ps08_work.scm]
+
+Problem 8.6:
+--------------------------------
+[see code in bnewbold_ps08_work.scm]
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
+|#
diff --git a/ps08_conspiracies/load.scm b/ps08_conspiracies/load.scm
index f4945db..c56b098 100644
--- a/ps08_conspiracies/load.scm
+++ b/ps08_conspiracies/load.scm
@@ -1,5 +1,5 @@
;; On The Fringes of Fun with Control Structures
-(load "same-fringe")
+;(load "same-fringe")
;; Communication among Threads
(load "conspire")
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-21 14:03:46 +0000