C311 script6.txt -- 2/17/97

---

CONTINUATION-PASSING STYLE (CPS)

Continuations are the key to understand control

  e.g. recursion, dynamic binding

  So far our interpreters do little to explain control, since control
  in the source language is expressed in terms of control in the
  host (meta) language.

+++

Contintuation-passing style (CPS) is good for

-- understanding tail form (important efficiency and memory usage consideration)

-- understanding first-class continuations (call-with-current-continuation)

-- understanding control issues in general

-- some compilation techniques

For the above we will be learning a general CPS transformation technique
that uses a single continuation with one argument.

Other uses of CPS include:
	
-- writing procedures with multiple continuations

-- writing procedures returning multiple results

---

WRITING PROCEDURES WITH MULTIPLE CONTINUATIONS

First, without using continuations, we look up the binding of name in an
environment represented as an association list (alist):

(let ((x (assq name env)))
  (if x
    (let ((value (cdr x)))
      SUCCESS CODE)
    FAILURE CODE))

+++

Here's a better way using success and failure continuations.  

We package the above mess so we only have to look at it once.

(define lookup
  (lambda (name env succeed fail)
    (let ((x (assq name env)))
      (if x
	(succeed (cdr x))
	(fail)))))

Now our programs look much better

(lookup name env
  (lambda (value)
    SUCCESS CODE)
  (lambda ()
    FAILURE CODE))

---

In this case, and many others, there are two ways for the program to
continue, so we have two continuations.

Each continuation takes as many arguments as are needed for the information
that is specific to it.

+++

In normal programming there is a single implicit continuation.

In logic programming (e.g. in the Prolog language), both success and
failure continuations are implicit at all times.

Exception handlers are a kind of implicit failure continuation.

In some applications there may be even more than two continuations,
implicit or explicit.

If all but one continuation is exceptional (happens rarely), it may be
clearest to let the common continuation be the explicit one, and handle the
others with exceptions.

If more than one continuation is common, as in the lookup example,
it is often clearest to use explicit continuation passing.

---

USING CONTINUATIONS TO RETURN MULTIPLE VALUES

Many procedures need to return multiple values.  There are a few ways to do
this.

1. Return a data structure containing the values, as above.
   Example: in integer division, it is about as efficient to generate both the
   quotient and remainder at the same time, as to generate either of them
   separately.  Suppose the DIVIDE procedure returns both, say as a pair.  We
   could use it as follows:

    (let ((p (divide x y)))
      (let ((quoient (car p))
	    (remainder (cdr p)))
	...))

+++

2. In some languages there is a mechanism for returning multiple values.
   For example, in Scheme:

    (define divide
      (lambda (numerator denominator)
	... (values quotient remainder) ...))

    (call-with-values
      (lambda () (divide numerator denominator))
      (lambda (quotient remainder)
	...))

+++

3. use continuation-passing style, with a single continuation that takes
   more than one value.

    (define divide
      (lambda (numerator denominator continuation)
	... (continuation quotient remainder) ...))

    (divide numerator denominator
      (lambda (quotient remainder)
	...))

---

To understand the connection between high-level programs (e.g. in Scheme)
and low-level implementation (e.g. assembly language), we will learn to
take a Scheme program and transform it into a form that is almost assembly
language.

  This provides insight into compilation and semantics (program excecution)
  for both high-level languages such as Scheme and low-level languages such
  as C.

The transformation will be in several steps.  The first, and most complex,
is CPS.

---

Given

(define fact
  (lambda (n)
    (if (zero? n) 1 (* n (fact (- n 1))))))

   (fact 4)

consider the following trace

 = (* 4 (fact 3))
 = (* 4 (* 3 (fact 2)))
 = (* 4 (* 3 (* 2 (fact 1))))
 = (* 4 (* 3 (* 2 (* 1 (fact 0)))))
 = (* 4 (* 3 (* 2 (* 1 1))))
 = (* 4 (* 3 (* 2 1)))
 = (* 4 (* 3 2))
 = (* 4 6)
 = 24

+++

This demonstrates recursive control behavior.

---

On the other hand, for

(define fact-iter
  (lambda (n)
    (fact-iter-acc n 1)))

(define fact-iter-acc
  (lambda (n a)
    (if (zero? n) a (fact-iter-acc (- n 1) (* n a)))))

we have the following trace

   (fact-iter 4)
 = (fact-iter-acc 4 1)
 = (fact-iter-acc 3 4)
 = (fact-iter-acc 2 12)
 = (fact-iter-acc 1 24)
 = (fact-iter-acc 0 24)
 = 24

+++

This demonstrates ITERATIVE CONTROL BEHAVIOR.

In fact, since in this case no data storage is allocated, we have
ITERATIVE BEHAVIOR.

---

When is control behavior iterative?

+++

For another example, compare

    (define append
      (lambda (ls1 ls2)
	(if (null? ls1)
	  ls2
	  (cons (car ls1)
	    (append (cdr ls1) ls2)))))

and

    (define revappend
      (lambda (ls1 ls2)
	(if (null? ls1)
	  ls2
	  (revappend (cdr ls1) (cons (car ls1) ls2)))))

---

An expression is in TAIL POSITION WITH RESPECT TO A FORM if its value is
returned immediately as the value of the enclosing form.

Consider:

    (if (zero? x)
      (f (g x))
      (if (positive? x)
	1
	(f x)))

+++

We say an expression is simple in TAIL POSITION if in tail position
with respect to the nearest lexically enclosing lambda expression.

A TAIL CALL is a call in tail position.

A TAIL RECURSIVE PROGRAM is one in which all (directly or indirectly)
recursive calls are tail calls,

A tail call is PROPER (implemented "properly") if it does not result in any
growth of the control state.

An implementation is PROPERLY TAIL RECURSIVE if all tail calls are proper.

What is the point of all this terminology?

+++

FACT: In a properly tail recursive implementation, a tail recursive program
executes with iterative control behavior.

Scheme (and a few other functional or "mostly functional" programming
languages) require that their implementations be properly tail recursive. 

MOTO: Proper tail recursion subsumes iteration.

---

Whether a program actually has iterative control behavior is undecidable.
For example,

    (lambda (n)
      (if (strange-predicate? n)
	  (fact n)
	  (fact-iter n)))

---

A tail-recursive program can be translated into a "flowchart" form in which
all (recursive) procedure calls take no arguments.  For example,

    (define fact-iter
      (lambda (n)
	(let ((a 1))
	  (letrec ((loop (lambda ()
			   (if (zero? n)
			       a
			       (begin
				 (set! a (* n a))
				 (set! n (- n 1))
				 (loop))))))
	    (loop)))))

+++

IMPLEMENTATION: A proper tail call with no arguments is a GOTO.

---

We have seen that some (non-tail recursive) Scheme programs (e.g. FACT)
can be converted into equivalent tail-recursive programs (e.g. FACT-ITER).

Can ANY Scheme program be converted into an equivalent tail-recursive program.

+++

YES, that's what the CPS transformation does!

---

To understand CPS, we first need the concept of an expression CONTEXT.

Consider the context of a recursive call in our trace of FACT:

    (* 4 (* 3 (* 2 (fact 1))))

+++

We represent a context as a expression with a hole in it:

    (* 4 (* 3 (* 2 HOLE)))

+++

Now we "abstract over the hole" by wrapping the expression in a lambda form
with one argument and filling the hole with the argument.

    k = (lambda (v) (* 4 (* 3 (* 2 v))))

+++

Then if we invoke this procedure with the call that was replaced by the
hole, we get back the value of the original expression:

    (k (fact 1))  = (* 4 (* 3 (* 2 (fact 1))))

---

Before going into the CPS transformation in general, here is the result of
applying it to the FACT procedure:

    (define fact-cps
      (lambda (n k)
	(if (zero? n)
	    (k 1)
	    (fact-cps (- n 1) 
	      (lambda (v) (k (* n v)))))))

+++

We argue, by induction on N, that (K (FACT N)) = (FACT-CPS N K) for any K.  

If N = 0, (K (FACT 0)) = (K 1) = (FACT-CPS 0 K).

If N > 0, we reason as follows:

   (k (fact n))

 = (k (* n (fact (- n 1))))    by the definition of FACT

 = ((lambda (v) (k (* n v)))   by beta-conversion 
    (fact (- n 1)))

 = (fact-cps (- n 1)           by the induction hypothesis
     (lambda (v) (k (* n v))))

 = (fact-cps n k)              by the definition of FACT-CPS

---

For example,

   (fact-cps 4 k)
 = (fact-cps 3 (lambda (v) (k (* 4 v))))
 = (fact-cps 2 (lambda (v) (k (* 4 (* 3 v)))))
 = (fact-cps 1 (lambda (v) (k (* 4 (* 3 (* 2 v))))))
 = (fact-cps 0 (lambda (v) (k (* 4 (* 3 (* 2 (* 1 v)))))))
 = (k (* 4 (* 3 (* 2 (* 1 1)))))
 = (k 24)

---

Before presenting the formal rules, we work through a few examples of CPS.

(define remove
  (lambda (s los)
    (if (null? los)
      '()
      (if (eq? s (car los))
	(remove s (cdr los))
	(cons (car los) (remove s (cdr los)))))))

+++
(define remove-cps
  (lambda (s los k)
    (k (if (null? los)
	 '()
	 (if (eq? s (car los))
	   (remove s (cdr los))
	   (cons (car los) (remove s (cdr los))))))))

+++
(define remove-cps
  (lambda (s los k)
    (if (null? los)
      (k '())
      (k (if (eq? s (car los))
	   (remove s (cdr los))
	   (cons (car los) (remove s (cdr los))))))))

+++
(define remove-cps
  (lambda (s los k)
    (if (null? los)
      (k '())
      (if (eq? s (car los))
	(k (remove s (cdr los)))
	(k (cons (car los) (remove s (cdr los))))))))

+++
(define remove-cps
  (lambda (s los k)
    (if (null? los)
      (k '())
      (if (eq? s (car los))
	(remove-cps s (cdr los) k)
	(k (cons (car los) (remove s (cdr los))))))))

+++
(define remove-cps
  (lambda (s los k)
    (if (null? los)
      (k '())
      (if (eq? s (car los))
	(remove-cps s (cdr los) k)
	(remove-cps s (cdr los)
	  (lambda (v)
	    (k (cons (car los) v))))))))

+++
(define remove
  (lambda (s los)
    (remove-cps s los (lambda (v) v))))

---

(define subst
  (lambda (new old slst)
    (if (null? slst)
      '()
      (if (symbol? (car slst))
	(if (eq? (car slst) old)
	  (cons new (subst new old (cdr slst)))
	  (cons (car slst) (subst new old (cdr slst))))
	(cons (subst new old (car slst))
	  (subst new old (cdr slst)))))))

+++
(define subst-cps
  (lambda (new old slst k)
    (k (if (null? slst)
	 '()
	 (if (symbol? (car slst))
	   (if (eq? (car slst) old)
	     (cons new (subst new old (cdr slst)))
	     (cons (car slst) (subst new old (cdr slst))))
	   (cons (subst new old (car slst))
	     (subst new old (cdr slst))))))))

+++
(define subst-cps
  (lambda (new old slst k)
    (if (null? slst)
      (k '())
      (k (if (symbol? (car slst))
	   (if (eq? (car slst) old)
	     (cons new (subst new old (cdr slst)))
	     (cons (car slst) (subst new old (cdr slst))))
	   (cons (subst new old (car slst))
	     (subst new old (cdr slst))))))))

+++
(define subst-cps
  (lambda (new old slst k)
    (if (null? slst)
      (k '())
      (if (symbol? (car slst))
	(k (if (eq? (car slst) old)
	     (cons new (subst new old (cdr slst)))
	     (cons (car slst) (subst new old (cdr slst)))))
	(k (cons (subst new old (car slst))
	     (subst new old (cdr slst))))))))

+++
(define subst-cps
  (lambda (new old slst k)
    (if (null? slst)
      (k '())
      (if (symbol? (car slst))
	(if (eq? (car slst) old)
	  (k (cons new (subst new old (cdr slst))))
	  (k (cons (car slst) (subst new old (cdr slst)))))
	(subst-cps new old (car slst)
	  (lambda (v)
	    (k (cons v (subst new old (cdr slst))))))))))

This gives the effect of left to right argument evaluation.

+++
(define subst-cps
  (lambda (new old slst k)
    (if (null? slst)
      (k '())
      (if (symbol? (car slst))
	(if (eq? (car slst) old)
	  (subst-cps new old (cdr slst)
	    (lambda (v)  (k (cons new v))))
	  (subst-cps new old (cdr slst)
	    (lambda (v)  (k (cons (car slst) v)))))
	(subst-cps new old (car slst)
	  (lambda (v)
	    (k (cons v (subst new old (cdr slst))))))))))

+++
(define subst-cps
  (lambda (new old slst k)
    (if (null? slst)
      (k '())
      (if (symbol? (car slst))
	(if (eq? (car slst) old)
	  (subst-cps new old (cdr slst)
	    (lambda (v) (k (cons new v))))
	  (subst-cps new old (cdr slst)
	    (lambda (v) (k (cons (car slst) v)))))
	(subst-cps new old (car slst)
	  (lambda (v)
	    (subst-subst new old (cdr slst)
	      (lambda (v1) (k (cons v v1))))))))))

---

(define remove
  (lambda (s los)
    (letrec
      ((loop 
         (lambda (los)
           (if (null? los)
	     '()
	     (if (eq? s (car los))
	       (loop (cdr los))
	       (cons (car los) (loop (cdr los))))))))
      (loop los))))

+++
(define remove-cps
  (lambda (s los k)
    (k (letrec
	 ((loop
	    (lambda (los k)
	      (k (if (null? los)
		   '()
		   (if (eq? s (car los))
		     (loop (cdr los))
		     (cons (car los) (loop (cdr los))))))) ))
	 (loop los)))))

+++
(define remove-cps
  (lambda (s los k)
    (letrec
      ((loop
	 (lambda (los k)
	   (k (if (null? los)
		'()
		(if (eq? s (car los))
		  (loop (cdr los))
		  (cons (car los) (loop (cdr los)))))))))
      (k (loop los)))))

+++
(define remove-cps
  (lambda (s los k)
    (letrec 
      ((loop 
	 (lambda (los k)
	   (k (if (null? los)
		'()
		(if (eq? s (car los))
		  (loop (cdr los))
		  (cons (car los) (loop (cdr los)))))))))
      (loop los k))))

...

(define remove-cps
  (lambda (s los k)
    (letrec 
      ((loop 
	 (lambda (los k)
	   (if (null? los)
		(k '())
		(if (eq? s (car los))
		  (loop (cdr los) k)
		  (loop (cdr los)
		    (lambda (v)
		      (k (cons (car los) v)))))))))
      (loop los k))))

+++
Or if COND were used:

   (k (cond
	((null? los) '())
	((eq? s (car los)) (remove s (cdr los)))
	(else (cons (car los) (remove s (cdr los))))))
 = (cond
     ((null? los)  (k '()))
     ((eq? s (car los))  (k (remove s (cdr los))))
     (else  (k (cons (car los) (remove s (cdr los))))))

---

The continuation that is passed initially (which could also be considered
the final continuation, since it is the last one to be invoked), could be
just (lambda (x) x).  But then some errors in CPS (such as not doing it at
all!) would not be apparent.  So for better testing, the following is
recommended. 

> (define final-valcont
    (lambda (v)
      (display "The answer is: ")
      (write v)
      (newline)))
> (define remove-cps
    (lambda (s los k)
      (letrec 
	((loop 
	   (lambda (los k)
	     (if (null? los)
	       (k '())
	       (if (eq? s (car los))
		 (loop (cdr los) k)
		 (loop (cdr los)
		   (lambda (v)
		     (k (cons (car los) v)))))))))
	(loop los k))))
> (remove-cps 'b '(a b c b a) final-valcont)
The answer is: (a c a)

---

END

---