From cd57e7c557d01f9d74e6849c6988b61d827d182a Mon Sep 17 00:00:00 2001 From: bnewbold Date: Mon, 20 Apr 2009 19:41:39 -0400 Subject: ps08 done --- ps08_conspiracies/bnewbold_ps08.txt | 59 +++++++++ ps08_conspiracies/bnewbold_ps08_work.scm | 214 +++++++++++++++++++++++++++++++ ps08_conspiracies/load.scm | 2 +- 3 files changed, 274 insertions(+), 1 deletion(-) create mode 100644 ps08_conspiracies/bnewbold_ps08.txt create mode 100644 ps08_conspiracies/bnewbold_ps08_work.scm 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 + +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 + +(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") -- cgit v1.2.3