| trampoline-other-schedulers.scm - Multithreaded schedulers: seesaw and trampoline. | Lecture 3 - slide 42 : 43 Program 5 |
(define (return x) (tag 'done x))
(define (bounce thunk) (tag 'doing thunk))
(define (call thunk) (thunk))
(define (tag label thing) (cons label thing))
(define tag-of car)
(define tag-value cdr)
(define (pogo-stick thread)
(cond ((eqv? 'done (tag-of thread))
(tag-value thread))
((eqv? 'doing (tag-of thread))
(pogo-stick (call (tag-value thread))))))
(define (seesaw thread-1 thread-2)
(cond ((eqv? 'done (tag-of thread-1))
(tag-value thread-1))
((eqv? 'doing (tag-of thread-1))
(seesaw thread-2 (call (tag-value thread-1))))))
(define (trampoline thread-queue)
(let ((head (car thread-queue)))
(cond ((eqv? 'done (tag-of head)) (tag-value head))
((eqv? 'doing (tag-of head))
(trampoline
(append
(cdr thread-queue)
(list (call (tag-value head)))))))))
(define (fact-iter n acc)
(if (zero? n)
(return acc)
(bounce
(lambda ()
(fact-iter
(- n 1)
(* acc n))))))
(define (mem? n lst)
(cond ((null? lst) (return #f))
((= (car lst ) n) (return #t))
(else (bounce
(lambda ()
(mem? n (cdr lst)))))))
(define (fib n)
(fib-iter n 0 0 1))
(define (fib-iter n i small large)
(if (< i n)
(bounce
(lambda ()
(fib-iter n (+ i 1) large (+ large small))))
(return small)))
; > (seesaw (fact-iter 5 1) (fib 8))
; 120
; > (seesaw (fact-iter -1 1) (fib 8))
; 21
; > (trampoline (list (fact-iter -1 1) (mem? 5 (list 2 8 9 1 3 4 3 5 )) (fib 8)))
; #t