-------------
Problem 6.1:
What is the worst-case time order of growth of this procedure? This
is a bit tricky, because your answer depends on how you decide to
measure the input argument. Is it the length of the fringe? Is the
depth of the tree relevant? So make sure you explain your answer
clearly.
The number of times an element has to be CONSed is equal to the sum of the
depths of each leaf. In order to be 'raised' a level, each element in a
sub-list must be CONSed onto nil.
-------------
Problem 6.2:
This implementation of lazy fringe has the same problem of recopying
the resulting stream that our original fringe program had recopying
the resulting list. Write a stream program that eliminates this
recopying using a technique similar to what we did above.
(define (lazy-fringe s)
(define (walk s ans)
(cond ((pair? s)
(walk (car s)
(walk (cdr s)
ans)))
((null? s) ans)
(else (cons-stream s ans))))
(walk s the-empty-stream))
-------------
Problem 6.3:
Why is it necessary to have the expression "(lambda () (next))" rather
than just "next" as the returned value of the fringe generator?
Aren't they the same, by the eta rule of lambda calculus?
They are the same, but not yet. (NEXT) changes the value of its internal state
each time it is called, but returning a thunk that calls NEXT when the thunk is
called doesn't change the value of NEXT. The eta rule of the lambda calculus exists
in the Land Before Time, when functions always have the same value when called
with the same arguments.
-------------
Problem 6.4:
Suppose I accidentally left out the return, so that the last line of
the fringe generator were just *done* rather than (return *done*).
What behavior would I get? Why? (I actually made this mistake. It
took me about 1/2 hour to figure out what went wrong! GJS)
(define (fringe-coroutine tree)
(make-coroutine
(fringe-gen tree)))
(begin
(define foo
(fringe-coroutine '(a)))
(define bar
(fringe-coroutine '(a b c))))
(let ((x (foo))
(y (bar)))
(list 'foo: x 'bar: y))
(bar)
(bar)
(bar)
(foo)
(list (foo) 'this-will-not-appear)
(list (bar) 'this-will-not-appear)
(begin
(define foo
(fringe-coroutine '(a b)))
(define bar
(fringe-coroutine '(a b c)))
(define qux
(fringe-coroutine '(a b c d e))))
(let* ((x (foo))
(y (bar)))
(list 'foo: x 'bar: y))
(let* ((x (bar))
(y (qux)))
(list 'bar: x 'qux: y))
(let* ((x (qux))
(y (foo)))
(list 'foo: x 'qux: y))
When the coroutine exits without exiting through its yield mechanism, it exits
into the continuation that existed when it was first called, sets its value in
that continuation, and then returns to that continuation. Once this occurs
once, subsequent *done* results also exit into that continuation. No matter
what context the coroutine is called in, it will always return from the
continuation in which it was first called. If the next thing that would happen
in that continuation is that another coroutine would be called, it is. This can
result in the second coroutine returning a valid result, which will then be
available in the prior continuation that was mistakenly invoked, and will update
the second coroutine's internal state in a manner that is globally available, ie
will affect valid outside calls to that coroutine. However, if the second
coroutine also yields from a false return continuation, it will return in the
continuation in which it was first invoked, with its value in that continuation
set to *done*.
-------------
Problem 6.5:
Implement the pipe mechanism implied by the program above. It should
work under the conspire time-sharing monitor. Remember, if the pipe
is empty a reader must wait until something is available to be read.
Also, since this is supposed to work under preemptive time sharing,
the pipe must be correctly interlocked.
(define-record-type pipe-type
(pipe:make-record front-ptr
rear-ptr)
pipe?
(front-ptr pipe:front-ptr
pipe:set-front-ptr!)
(rear-ptr pipe:rear-ptr
pipe:set-rear-ptr!))
(define (pipe:make)
(pipe:make-record '() '()))
(define make-pipe pipe:make)
(define (pipe:empty? pipe)
(null? (pipe:front-ptr pipe)))
(define (pipe:get-first pipe)
(if (pipe:empty? pipe)
(error "get-first called with an empty pipe" pipe)
(let ((first (car (pipe:front-ptr pipe)))
(rest (cdr (pipe:front-ptr pipe))))
(pipe:set-front-ptr! pipe rest)
(if (null? rest)
(pipe:set-rear-ptr! pipe '()))
first)))
(define (pipe:add-to-end! pipe item)
(let ((new-pair (cons item '())))
(cond ((null? (pipe:front-ptr pipe))
(pipe:set-front-ptr! pipe new-pair)
(pipe:set-rear-ptr! pipe new-pair))
(else
(set-cdr! (pipe:rear-ptr pipe) new-pair)
(pipe:set-rear-ptr! pipe new-pair))))
'done)
(define (pipe:delete-from-pipe! pipe item)
(pipe:set-front-ptr! pipe
(delq item
(pipe:front-ptr pipe)))
(if (pair? (pipe:front-ptr pipe))
(pipe:set-rear-ptr! pipe
(last-pair (pipe:front-ptr pipe)))
(pipe:set-rear-ptr! pipe '()))
'done)
(define (pipe-writer pipe)
(lambda (item)
(without-interrupts
(lambda ()
(pipe:add-to-end! pipe item)))))
(define pipe-reader
(lambda (pipe)
(lambda ()
(if (pipe:empty? pipe)
(begin (error "pipe-reader called with an empty pipe" pipe)
(conspire:switch-threads
(lambda () (not (pipe:empty? pipe)))))
(pipe:get-first pipe)))))
#|
(begin
(load "~/classes/symbolic/psets/06/conspire.scm")
(define *done* (list '*done*))
(define (samefringe t1 t2)
(let ((p1 (make-pipe)) (p2 (make-pipe)))
(let ((thread1
(conspire:make-thread
conspire:runnable
(lambda ()
(fringe-gen t1 (pipe-writer p1)))))
(thread2
(conspire:make-thread
conspire:runnable
(lambda ()
(fringe-gen t2 (pipe-writer p2)))))
(f1 (pipe-reader p1))
(f2 (pipe-reader p2)))
(conspire:thread-yield)
(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 (fringe-gen tree return)
(define (lp tree)
(cond ((pair? tree)
(lp (car tree))
(lp (cdr tree)))
((null? tree))
(else
(return tree))))
(lp tree)
(return *done*))
)
(samefringe '((a b) c)
'(a (b c)))
(samefringe '((a b) c)
'(a (b c d)))
-------------
(define (samefringe t1 t2)
(let ((f1 (make-threaded-filter (fringe-gen t1)))
(f2 (make-threaded-filter (fringe-gen t2))))
(conspire:thread-yield)
(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 ((fringe-gen tree) return)
(define (lp tree)
(cond ((pair? tree)
(lp (car tree))
(lp (cdr tree)))
((null? tree))
(else
(return tree))))
(lp tree)
(return *done*))
-------------
Problem 6.6:
Write make-threaded-filter to implement this interface. Demonstrate
your program.
(define (make-threaded-filter values-producing-form)
(let* ((this-pipe (make-pipe))
(reader (pipe-reader this-pipe)))
(conspire:make-thread
conspire:runnable
(lambda ()
(values-producing-form (pipe-writer this-pipe))))
(pp *thread-queue*)
reader))
(samefringe '((a b) c)
'(a (b c)))
(samefringe '((a b) c)
'(a (b c d)))