** 6. Continuations **

6.1.

A use of function arguments is what a function should do in various
unusual cases.  E.g. what to do if don't find a key in an assoc list.

(define (fetch-or-absent key lst if-absent)
   (if (null? lst) (if-absent)
      (let* ((entry (car alst))
             (k (car entry)))
         (if (equal? k key) entry
	    (fetch-or-absent key (cdr alst) if-absent)))))

(define (fetch key lst)
   (fetch-or-absent key lst (lambda () (error "key not found"))))

(define (fetch-or-init! key lst init-value)
   (fetch key lst (lambda () (store! key init-value lst) init-value)))


Here, a function argument is passed in as a kind of "exception
handler", except that it can't cause any non-local control flow other
than error (yet!).  Can do things that exns can't, since exns cut back
the stack to the handler (termination model of exceptions), while
invoked functions can return to the raise site with a real value
(resumption model of exceptions).

E.g. arithmetic overflow can have a closure passed in which handles
the overflow case, providing a value to use and resuming execution.

(define (mul-with-overflow x y on-overflow)
   (if (will-overflow-on-mul? x y) (on-overflow x y)
      (prim-mul x y)))

--------------------------------------------------------------------------

6.2.

A similar strategy can be used for other control structures,
i.e. passing in code blocks to use for "what to do if this is the
outcome"

E.g., if-present code blocks on fetch-or-absent.  In this case,
if-present is passed what would have been the result of fetch:

(define (fetch-if-present-or-absent key lst if-present if-absent)
   (if (null? lst) (if-absent)
      (let* ((entry (car alst))
             (k (car entry)))
         (if (equal? k key) (if-present entry)
	    (fetch-or-absent key (cdr alst) if-present if-absent)))))


User-written if:

(define (my-if test if-true if-false)
   (if test (if-true) (if-false)))

(define (my-if-not test if-true if-false)
   (if (not test) (if-true) (if-false)))


Following this style, all return values are implemented by calling
some argument function, called the "continuation".  A continuation is
a function that's called to effect a return, continuing on with some
line of program execution.  The continuation function encapsulates
"the rest of the program".  Continuation functions are invoked via
tail calls; they don't return results to the callers, they're more
like jumps.  This is refered to as "continuation-passing style".

--------------------------------------------------------------------------

6.3.

Regular languages have a special "normal continuation", which is the
implicit continuation which is invoked by normal return.  Such an
invocation is an implicit tail call, too.

Scheme provides a way to grab a hold of the implicit normal
continuation, *reifying* it as an procedure value.  They way this is
done is with the call-with-current-continuation (call/cc) built-in
function.

[Note that the MIT-Scheme interpreter doesn't implement call/cc
correctly; you have to write call-with-current-continuation instead.]

(call-with-current-continuation (lambda (the-current-cont)
   ... body ... (the-current-cont result) ...))

call/cc takes a function argument (typically a lambda literal) that
itself takes one argument, which is the reified continuation.  If
invoked on a value, this continuation will immediately return the
value as the result of the call/cc call.  This return cuts back any
stack between the call/cc call and the invocation of the-current-cont.

With this one very powerful (and confusing) mechanism, Scheme users
can program lots of very interesting control structures, without any
other primitive mechanisms.  (Orthogonality at its most extreme.)

Examples:
*) error handlers
*) termination-style exceptions
*) co-routines
*) threads (simulated parallelism)
*) backtracking

Ex: computing product of elements of a list, but with early exit if 0
is seen:

Before:

(define (prod lst)
   (reduce
      (lambda (x accum) (* x accum)) 
      1
      lst))

After:

(define (prod lst)
   (call-with-current-continuation (lambda (exit)
      (reduce
         (lambda (x accum) (if (= x 0) (exit 0) (* x accum)))
         1
         lst))))

Can implement a bunch of control structures on top of call/cc, that
have simpler/more restricted interfaces, such as loops with break &
continue options, and terminating exceptions.

--------------------------------------------------------------------------

6.4.

Threads:

;; This is a simple non-preemptive threads package, written using
;; call/cc continuations.

;; Each thread is represented by a zero-arg function.  There's a
;; global queue of runnable threads.

;; parallel-do is the main function invoked by clients of this thread
;; package.  suspend should be called liberally within client
;; functions to enable time-slicing.


;; a global queue of runnable threads
(define *threads* ())

;; create a new runnable thread & add it to the front of the thread queue
(define (spawn fn)
   (set! *threads* (cons fn *threads*)))

;; add a thread to the end of the thread queue
(define (spawn-last thread)
   (set! *threads* (append! *threads* (list thread))))

;; remove the thread at the front of the thread queue
(define (select-thread)
   (let ((thread (car *threads*)))
      (set! *threads* (cdr *threads*))
      thread))

;; run a thread
(define (run-thread thread)
  ;; run a thread simply by invoking it
  (thread))

;; suspend the current thread, selecting another to run.
(define (suspend)
  ;; first reify the current thread's continuation, and save it on the
  ;; thread list.  then remove a thread off the list, and run it.
   (call-with-current-continuation (lambda (this-thread)
      (spawn-last (lambda () (this-thread ())))
      (run-thread (select-thread)))))

;; finish the current thread, selecting another to run.  like suspend,
;; but don't save this thread onto the stack
(define (finish-thread)
  (run-thread (select-thread)))

;; a top-level thread executer, that takes a list of functions and
;; runs them until they all complete.
(define (parallel-do fn-list)
  ;; initialize the thread queue
  (set! *threads* ())
  ;; put all argument functions onto the thread queue, where each
  ;; thread is created from the user's function and the finish-thread command
  (map (lambda (fn)
	 (let ((thread (lambda () (fn) (finish-thread))))
	   (spawn-last thread)))
       fn-list)
  ;; now start a dummy thread that just suspends until there's no more
  ;; work to do
  (define (controller)
    (if (null? *threads*)
	;; no more suspended tasks; return a dummy result value
	() 
	(begin
	  ;; run a time-slice for each task
	  (suspend)
	  ;; loop
	  (controller))))
  (controller))


;; an example map function that suspends itself before each call to
;; the user's mapping function
(define (map-thread f lst)
  (map (lambda (elem) 
	 (suspend)
	 (f elem))
       lst))


;; a logging version of map-thread, that prints out a message each
;; time it calls the mapping function
(define (map-thread-logging label f lst)
  (map-thread (lambda (elem)
		(display label) (display "...") (newline)
		(f elem)) 
	      lst))


;; an example of two threads run in parallel
(define (test-threads)
  (parallel-do
   (list
    (lambda () 
      (display
       (map-thread-logging "thread 1" (lambda (n) (* n n)) '(3 4 5)))
      (newline))
    (lambda ()
      (display
       (map-thread-logging "thread 2" (lambda (n) (+ n n)) '(3 4 5 6 7)))
      (newline)))))