From direct style, via CPS, to the stack machine

Table of Contents

1 Factorial

This is the known and much-loved factorial function:

1.1 Direct Style

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

And here is a sample interaction with fact:

> (fact 0)
1
> (fact 5)
120
> (fact 10)
3628800

1.2 CPS

Converting factorial to CPS is straightforward: The standard recursive factorial contains exactly one recursive call, which is not in tail position, so one continuation needs to be constructed aside from the initial continuation:

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

Here is a sample interaction with the CPS version of fact:

> (fact 5 (lambda (x) x))
120
> (fact 5 (lambda (x) `(the result is ,x)))
(the result is 120)

Notice that you have a lot of freedom in selecting the initial continuation, and of course, this effects the final result.

1.3 Representation-Independent (RI) with respect to the continuation

To make the CPS version RI, we need to abstract over the creation and application of the closure. This means that every place where a continuation is applied, we're going to use the ak procedure (short for apply-continuation), and every place where a continuation is created, we're going to use a constructor procedure ^k-<something>. Whatever state the original continuation (that is represented as a closure) contains, needs to be passed onto the constructor. In the case of factorial, we shall be passing n and k:

(define fact
  (lambda (n k)
    (if (zero? n)
        (ak 1 k)
        (fact (- n 1)
              (^k-fact n k)))))

(define ^k-init
  (lambda ()
    (lambda (x) x)))

(define ^k-fact
  (lambda (n k)
    (lambda (x)
      (ak (* n x) k))))

(define ak
  (lambda (x k)
    (k x)))

1.4 RI & defunctionalized

(define with (lambda (s f) (apply f s)))

(define fact
  (lambda (n k)
    (if (zero? n)
        (ak 1 k)
        (fact (- n 1)
              (^k-fact n k)))))

(define ^k-init
  (lambda ()
    `(k-init)))

(define ^k-fact
  (lambda (n k)
    `(k-fact ,n ,k)))

(define ak
  (lambda (x k)
    (cond ((eq? (car k) 'k-init) x)
          ((eq? (car k) 'k-fact)
           (with k
             (lambda (_ n k)
               (ak (* n x) k))))
          (else (error 'ak "I don't recognize this continuation")))))

Sample run:

> (fact 0 (^k-init))
1
> (fact 5 (^k-init))
120
> (fact 20 (^k-init))
2432902008176640000

If we examine the kind of continuations we create using nested records, we see

> (^k-fact 1 (^k-fact 2 (^k-fact 3 (^k-fact 4 (^k-fact 5 (^k-init))))))
(k-fact 1 (k-fact 2 (k-fact 3 (k-fact 4 (k-fact 5 (k-init))))))

What we would like to do now is to flatten this representation, by exploiting the right-associativity of the continuation data structure. This associativity is induced by the fact that the continuation is always the last field in any continuation.

1.5 RI, defunctionalized, flattened

(define with (lambda (s f) (apply f s)))

(define fact
  (lambda (n k)
    (if (zero? n)
        (ak 1 k)
        (fact (- n 1)
              (^k-fact n k)))))

(define ^k-init
  (lambda ()
    `(k-init)))

(define ^k-fact
  (lambda (n k)
    `(k-fact ,n ,@k)))

(define ak
  (lambda (x k)
    (cond ((eq? (car k) 'k-init) x)
          ((eq? (car k) 'k-fact)
           (with k
             (lambda (_ n . k)
               (ak (* n x) k))))
          (else (error 'ak "I don't recognize this continuation")))))

Sample run:

> (fact 0 (^k-init))
1
> (fact 5 (^k-init))
120
> (fact 20 (^k-init))
2432902008176640000

In contrast to the previous representation of continuations, as nested records, these continuations are flat:

> (^k-fact 1 (^k-fact 2 (^k-fact 3 (^k-fact 4 (^k-fact 5 (^k-init))))))
(k-fact 1 k-fact 2 k-fact 3 k-fact 4 k-fact 5 k-init)

The fact that the continuation is now a flat structure, and that all procedure calls that are not built-in are in tail-position, implies that we can implement the continuations using a flat LIFO data structure: A stack.

1.6 The stack machine

(define with (lambda (s f) (apply f s)))

(define n #f)
(define x #f)
(define k #f)

(define *stack* '())

(define clear-stack
  (lambda ()
    (set! *stack* '())))

(define push
  (lambda (x)
    (set! *stack*
      (cons x *stack*))))

(define pop
  (lambda ()
    (with *stack*
      (lambda (x . s)
        (set! *stack* s)
        x))))

(define fact
  (lambda (nn)
    (set! n nn)
    (clear-stack)
    (push 'k-init)
    (fact-sm)))

(define fact-sm
  (lambda ()
    (if (zero? n)
        (begin
          (set! x 1)
          (ak))
        (begin
          (push n)
          (push 'k-fact)
          (set! n (- n 1))
          (fact-sm)))))

(define ak
  (lambda ()
    (set! k (pop))
    (cond ((eq? k 'k-init) x)
          ((eq? k 'k-fact)
           (set! n (pop))
           (set! x (* n x))
           (ak))
          (else (error 'ak "I don't recognize this continuation")))))

Sample interaction:

> (fact 0)
1
> (fact 5)
120
> (fact 10)
3628800

A lightly-hacked version of ak for tracing the stack upon return:

> (fact 0)
About to return from the top frame:(k-init)
1
> (fact 3)
About to return from the top frame:(k-fact 1 k-fact 2 k-fact 3 k-init)
About to return from the top frame:(k-fact 2 k-fact 3 k-init)
About to return from the top frame:(k-fact 3 k-init)
About to return from the top frame:(k-init)
6

2 Fibonacci (naïve, recursive)

2.1 Direct Style

(define fib
  (lambda (n)
    (if (< n 2)
        n
        (+ (fib (- n 1))
           (fib (- n 2))))))

Sample interaction:

> (fib 0)
0
> (fib 1)
1
> (fib 10)
55

2.2 CPS

(define fib
  (lambda (n k)
    (if (< n 2)
        (k n)
        (fib (- n 2)
             (lambda (x2)
               (fib (- n 1)
                    (lambda (x1)
                      (k (+ x1 x2)))))))))
> (fib 0 (lambda (x) x))
0
> (fib 0 (lambda (x) x))
0
> (fib 1 (lambda (x) x))
1
> (fib 5 (lambda (x) x))
5
> (fib 10 (lambda (x) x))
55
> (fib 10 (lambda (x) `((fib 10) => ,x)))
((fib 10) => 55)

2.3 Representation-Independent (RI) with respect to the continuation

(define fib
  (lambda (n k)
    (if (< n 2)
        (ak n k)
        (fib (- n 2)
             (^k-fib1 n k)))))

(define ^k-init
  (lambda ()
    (lambda (x) x)))

(define ^k-fib1
  (lambda (n k)
    (lambda (x2)
      (fib (- n 1)
           (^k-fib2 x2 k)))))

(define ^k-fib2
  (lambda (x2 k)
    (lambda (x)
      (ak (+ x x2) k))))

(define ak
  (lambda (x k)
    (k x)))

Sample interaction:

> (fib 0 (^k-init))
0
> (fib 1 (^k-init))
1
> (fib 3 (^k-init))
2
> (fib 10 (^k-init))
55

2.4 RI & defunctionalized

(define fib
  (lambda (n k)
    (if (< n 2)
        (ak n k)
        (fib (- n 2)
             (^k-fib1 n k)))))

(define ak
  (lambda (x k)
    (cond ((eq? (car k) 'k-init) x)
          ((eq? (car k) 'k-fib1)
           (with k
             (lambda (_ n k)
               (fib (- n 1)
                    (^k-fib2 x k)))))
          ((eq? (car k) 'k-fib2)
           (with k
             (lambda (_ x2 k)
               (ak (+ x x2) k))))
          (else (error 'ak "I don't recognize this continuation")))))

(define ^k-init
  (lambda ()
    `(k-init)))

(define ^k-fib1
  (lambda (n k)
    `(k-fib1 ,n ,k)))

(define ^k-fib2
  (lambda (x2 k)
    `(k-fib2 ,x2 ,k)))

Sample interaction:

> (fib 0 (^k-init))
0
> (fib 1 (^k-init))
1
> (fib 10 (^k-init))
55

2.5 The stack machine

(define with (lambda (s f) (apply f s)))

(define n #f)
(define x #f)
(define x2 #f)
(define k #f)

(define *stack* '())

(define clear-stack
  (lambda ()
    (set! *stack* '())))

(define push
  (lambda (x)
    (set! *stack*
      (cons x *stack*))))

(define pop
  (lambda ()
    (with *stack*
      (lambda (x . s)
        (set! *stack* s)
        x))))

(define fib
  (lambda (nn)
    (set! n nn)
    (clear-stack)
    (push 'k-init)
    (fib-sm)))

(define fib-sm
  (lambda ()
    (if (< n 2)
        (begin
          (set! x n)
          (ak))
        (begin
          (push n)
          (push 'k-fib1)
          (set! n (- n 2))
          (fib-sm)))))

(define ak
  (lambda ()
   (set! k (pop))
    (cond ((eq? k 'k-init) x)
          ((eq? k 'k-fib1)
           (set! n (pop))
           (push x)
           (push 'k-fib2)
           (set! n (- n 1))
           (fib-sm))
          ((eq? k 'k-fib2)
           (set! x2 (pop))
           (set! x (+ x x2))
           (ak))
          (else (error 'ak "I don't recognize this continuation")))))

Sample interaction:

> (fib 8)
21
> (fib 9)
34
> (fib 10)
55

A lightly-hacked version of ak for tracing the stack upon return:

> (fib 4)
About to return from the top frame:(k-fib1 2 k-fib1 4 k-init)
About to return from the top frame:(k-fib2 0 k-fib1 4 k-init)
About to return from the top frame:(k-fib1 4 k-init)
About to return from the top frame:(k-fib1 3 k-fib2 1 k-init)
About to return from the top frame:(k-fib1 2 k-fib2 1 k-fib2 1 k-init)
About to return from the top frame:(k-fib2 0 k-fib2 1 k-fib2 1 k-init)
About to return from the top frame:(k-fib2 1 k-fib2 1 k-init)
About to return from the top frame:(k-fib2 1 k-init)
About to return from the top frame:(k-init)
3
> (fib 6)
About to return from the top frame:(k-fib1 2 k-fib1 4 k-fib1 6 k-init)
About to return from the top frame:(k-fib2 0 k-fib1 4 k-fib1 6 k-init)
About to return from the top frame:(k-fib1 4 k-fib1 6 k-init)
About to return from the top frame:(k-fib1 3 k-fib2 1 k-fib1 6 k-init)
About to return from the top frame:(k-fib1 2 k-fib2 1 k-fib2 1 k-fib1 6 k-init)
About to return from the top frame:(k-fib2 0 k-fib2 1 k-fib2 1 k-fib1 6 k-init)
About to return from the top frame:(k-fib2 1 k-fib2 1 k-fib1 6 k-init)
About to return from the top frame:(k-fib2 1 k-fib1 6 k-init)
About to return from the top frame:(k-fib1 6 k-init)
About to return from the top frame:(k-fib1 3 k-fib1 5 k-fib2 3 k-init)
About to return from the top frame:(k-fib1 2 k-fib2 1 k-fib1 5 k-fib2 3 k-init)
About to return from the top frame:(k-fib2 0 k-fib2 1 k-fib1 5 k-fib2 3 k-init)
About to return from the top frame:(k-fib2 1 k-fib1 5 k-fib2 3 k-init)
About to return from the top frame:(k-fib1 5 k-fib2 3 k-init)
About to return from the top frame:(k-fib1 2 k-fib1 4 k-fib2 2 k-fib2 3 k-init)
About to return from the top frame:(k-fib2 0 k-fib1 4 k-fib2 2 k-fib2 3 k-init)
About to return from the top frame:(k-fib1 4 k-fib2 2 k-fib2 3 k-init)
About to return from the top frame:(k-fib1 3 k-fib2 1 k-fib2 2 k-fib2 3 k-init)
About to return from the top frame:(k-fib1 2 k-fib2 1 k-fib2 1 k-fib2 2 k-fib2 3 k-init)
About to return from the top frame:(k-fib2 0 k-fib2 1 k-fib2 1 k-fib2 2 k-fib2 3 k-init)
About to return from the top frame:(k-fib2 1 k-fib2 1 k-fib2 2 k-fib2 3 k-init)
About to return from the top frame:(k-fib2 1 k-fib2 2 k-fib2 3 k-init)
About to return from the top frame:(k-fib2 2 k-fib2 3 k-init)
About to return from the top frame:(k-fib2 3 k-init)
About to return from the top frame:(k-init)
8

3 Fibonacci (efficient, recursive)

3.1 Direct Style

(define fib
  (lambda (n)
    (run n (lambda (x1 x2 x3 x4) x3))))

(define run
  (lambda (n k)
    (cond ((= n 0) (k 1 0 0 1)) 
          ((= n 1) (k 1 1 1 0)) 
          (else (run (quotient n 2)
                     (lambda (x1 x2 x3 x4)
                       (let ((*x2x3 (* x2 x3)))
                         (let ((z1 (+ (* x1 x1) *x2x3))
                               (z2 (+ (* x1 x3) (* x3 x4)))
                               (z3 (+ (* x1 x2) (* x2 x4)))
                               (z4 (+ *x2x3 (* x4 x4))))
                           (if (even? n) (k z1 z2 z3 z4)
                               (k (+ z1 z2) (+ z3 z4) z1 z3))))))))))

Sample interaction:

> (fib 0)
0
> (fib 1)
1
> (fib 2)
1
> (fib 3)
2
> (fib 5)
5
> (fib 10)
55

3.2 CPS

(define fib
  (lambda (n)
    (run n (lambda (x1 x2 x3 x4) x3))))

(define run
  (lambda (n k)
    (cond ((= n 0) (ak 1 0 0 1 k))
          ((= n 1) (ak 1 1 1 0 k))
          (else (run (quotient n 2)
                     (lambda (x1 x2 x3 x4)
                       (let ((*x2x3 (* x2 x3)))
                         (let ((z1 (+ (* x1 x1) *x2x3))
                               (z2 (+ (* x1 x3) (* x3 x4)))
                               (z3 (+ (* x1 x2) (* x2 x4)))
                               (z4 (+ *x2x3 (* x4 x4))))
                           (if (even? n)
                               (ak z1 z2 z3 z4 k)
                               (ak (+ z1 z2) (+ z3 z4) z1 z3 k))))))))))

Sample interaction:

> (fib 10)
55
> (fib 11)
89
> (fib 12)
144

3.3 Representation-Independent (RI) with respect to the continuation

(define fib
  (lambda (n)
    (run n (^k-init))))

(define run
  (lambda (n k)
    (cond ((= n 0) (ak 1 0 0 1 k))
          ((= n 1) (ak 1 1 1 0 k))
          (else (run (quotient n 2)
                     (^k-fib n k))))))

(define ^k-init
  (lambda ()
    (lambda (x1 x2 x3 x4) x3)))

(define ^k-fib
  (lambda (n k)
    (lambda (x1 x2 x3 x4)
      (let ((*x2x3 (* x2 x3)))
        (let ((z1 (+ (* x1 x1) *x2x3))
              (z2 (+ (* x1 x3) (* x3 x4)))
              (z3 (+ (* x1 x2) (* x2 x4)))
              (z4 (+ *x2x3 (* x4 x4))))
          (if (even? n)
              (ak z1 z2 z3 z4 k)
              (ak (+ z1 z2) (+ z3 z4) z1 z3 k)))))))

(define ak
  (lambda (x1 x2 x3 x4 k)
    (k x1 x2 x3 x4)))

Sample interaction

> (fib 10)
55
> (fib 11)
89
> (fib 12)
144

3.4 RI & defunctionalized

(define fib
  (lambda (n)
    (run n (^k-init))))

(define run
  (lambda (n k)
    (cond ((= n 0) (ak 1 0 0 1 k))
          ((= n 1) (ak 1 1 1 0 k))
          (else (run (quotient n 2)
                     (^k-fib n k))))))

(define ^k-init
  (lambda ()
    `(k-init)))

(define ^k-fib
  (lambda (n k)
    `(k-fib ,n ,k)))

(define ak
  (lambda (x1 x2 x3 x4 k)
    (cond ((eq? (car k) 'k-init) x3)
          ((eq? (car k) 'k-fib)
           (with k
             (lambda (_ n k)
               (let ((*x2x3 (* x2 x3)))
                 (let ((z1 (+ (* x1 x1) *x2x3))
                       (z2 (+ (* x1 x3) (* x3 x4)))
                       (z3 (+ (* x1 x2) (* x2 x4)))
                       (z4 (+ *x2x3 (* x4 x4))))
                   (if (even? n)
                       (ak z1 z2 z3 z4 k)
                       (ak (+ z1 z2) (+ z3 z4) z1 z3 k)))))))
             (else (error 'ak "I don't recognize this continuation")))))

Sample interaction:

> (fib 3)
2
> (fib 4)
3
> (fib 5)
5

3.5 The stack machine

(define with (lambda (s f) (apply f s)))

(define n #f)
(define x1 #f)
(define x2 #f)
(define x3 #f)
(define x4 #f)
(define z1 #f)
(define z2 #f)
(define z3 #f)
(define z4 #f)
(define *x2x3 #f)
(define k #f)

(define *stack* '())

(define clear-stack
  (lambda ()
    (set! *stack* '())))

(define push
  (lambda (x)
    (set! *stack*
      (cons x *stack*))))

(define pop
  (lambda ()
    (with *stack*
      (lambda (x . s)
        (set! *stack* s)
        x))))

(define fib
  (lambda (nn)
    (set! n nn)
    (clear-stack)
    (push 'k-init)
    (run-sm)))

(define run-sm
  (lambda ()
    (cond ((= n 0)
           (set! x1 1) (set! x2 0)
           (set! x3 0) (set! x4 1)
           (ak))
          ((= n 1)
           (set! x1 1) (set! x2 1)
           (set! x3 1) (set! x4 0)
           (ak))
          (else (push n)
                (push 'k-fib)
                (set! n (quotient n 2))
                (run-sm)))))

(define ak
  (lambda ()
    (set! k (pop))
    (cond ((eq? k 'k-init) x3)
          ((eq? k 'k-fib)
           (set! n (pop))
           (set! *x2x3 (* x2 x3))
           (set! z1 (+ (* x1 x1) *x2x3))
           (set! z2 (+ (* x1 x3) (* x3 x4)))
           (set! z3 (+ (* x1 x2) (* x2 x4)))
           (set! z4 (+ *x2x3 (* x4 x4)))
           (if (even? n)
                (begin
                  (set! x1 z1) (set! x2 z2)
                  (set! x3 z3) (set! x4 z4)
                  (ak))
                (begin
                  (set! x1 (+ z1 z2)) (set! x2 (+ z3 z4))
                  (set! x3 z1) (set! x4 z3)
                  (ak))))
          (else (error 'ak "I don't recognize this continuation")))))

Sample interaction:

> (fib 6)
8
> (fib 7)
13
> (fib 8)
21

A lightly-hacked version of ak for tracing the stack upon return:

> (fib 10)
About to return from the top frame:(k-fib 2 k-fib 5 k-fib 10 k-init)
About to return from the top frame:(k-fib 5 k-fib 10 k-init)
About to return from the top frame:(k-fib 10 k-init)
About to return from the top frame:(k-init)
55

4 Ackermann

4.1 Direct Style

(define ack
  (lambda (a b)
    (cond ((zero? a) (+ b 1))
          ((zero? b) (ack (- a 1) 1))
          (else (ack (- a 1)
                     (ack a (- b 1)))))))
> (ack 0 1)
2
> (ack 2 2)
7
> (ack 3 3)
61
> (ack 3 10)
8189

4.2 CPS

(define ack
  (lambda (a b k)
    (cond ((zero? a) (k (+ b 1)))
          ((zero? b) (ack (- a 1) 1 k))
          (else (ack a (- b 1)
                     (lambda (x)
                       (ack (- a 1) x k)))))))

Sample interaction:

> (ack 2 2 (lambda (x) x))
7
> (ack 3 3 (lambda (x) `((ack 3 3) => ,x)))
((ack 3 3) => 61)

4.3 Representation-Independent (RI) with respect to the continuation

(define ack
  (lambda (a b k)
    (cond ((zero? a) (ak (+ b 1) k))
          ((zero? b) (ack (- a 1) 1 k))
          (else (ack a (- b 1)
                     (^k-ack a k))))))

(define ^k-init
  (lambda ()
    (lambda (x) x)))

(define ^k-ack
  (lambda (a k)
    (lambda (x)
      (ack (- a 1) x k))))

(define ak
  (lambda (x k)
    (k x)))

Sample interaction:

> (ack 2 2 (^k-init))
7
> (ack 3 3 (^k-init))
61

4.4 RI & defunctionalized

(define with (lambda (s f) (apply f s)))

(define ack
  (lambda (a b k)
    (cond ((zero? a) (ak (+ b 1) k))
          ((zero? b) (ack (- a 1) 1 k))
          (else (ack a (- b 1)
                     (^k-ack a k))))))

(define ^k-init
  (lambda ()
    `(k-init)))

(define ^k-ack
  (lambda (a k)
    `(k-ack ,a ,k)))

(define ak
  (lambda (x k)
    (cond ((eq? (car k) 'k-init) x)
          ((eq? (car k) 'k-ack)
           (with k
             (lambda (_ a k)
               (ack (- a 1) x k))))
          (else (error 'ak "I don't recognize this continuation")))))

Sample interaction:

> (ack 2 2 (^k-init))
7
> (ack 3 3 (^k-init))
61

4.5 The stack machine

(define with (lambda (s f) (apply f s)))

(define a #f)
(define b #f)
(define x #f)
(define k #f)

(define *stack* '())

(define clear-stack
  (lambda ()
    (set! *stack* '())))

(define push
  (lambda (x)
    (set! *stack*
      (cons x *stack*))))

(define pop
  (lambda ()
    (with *stack*
      (lambda (x . s)
        (set! *stack* s)
        x))))

(define ack
  (lambda (aa bb)
    (set! a aa)
    (set! b bb)
    (clear-stack)
    (push 'k-init)
    (ack-sm)))

(define ack-sm
  (lambda ()
    (cond ((zero? a)
           (set! x (+ b 1))
           (ak))
          ((zero? b)
           (set! b 1)
           (set! a (- a 1))
           (ack-sm))
          (else (push a)
                (push 'k-ack)
                (set! b (- b 1))
                (ack-sm)))))

(define ak
  (lambda ()
    (set! k (pop))
    (cond ((eq? k 'k-init) x)
          ((eq? k 'k-ack)
           (set! a (pop))
           (set! b x)
           (set! a (- a 1))
           (ack-sm))
          (else (error 'ak "I don't recognize this continuation")))))

Sample interaction:

> (ack 0 2)
3
> (ack 2 2)
7
> (ack 3 4)
125

A lightly-hacked version of ak for tracing the stack upon return:

> (ack 2 2)
About to return from the top frame:(k-ack 1 k-ack 2 k-ack 2 k-init)
About to return from the top frame:(k-ack 2 k-ack 2 k-init)
About to return from the top frame:(k-ack 1 k-ack 1 k-ack 1 k-ack 2 k-init)
About to return from the top frame:(k-ack 1 k-ack 1 k-ack 2 k-init)
About to return from the top frame:(k-ack 1 k-ack 2 k-init)
About to return from the top frame:(k-ack 2 k-init)
About to return from the top frame:(k-ack 1 k-ack 1 k-ack 1 k-ack 1 k-ack 1 k-init)
About to return from the top frame:(k-ack 1 k-ack 1 k-ack 1 k-ack 1 k-init)
About to return from the top frame:(k-ack 1 k-ack 1 k-ack 1 k-init)
About to return from the top frame:(k-ack 1 k-ack 1 k-init)
About to return from the top frame:(k-ack 1 k-init)
About to return from the top frame:(k-init)
7

Date: 2012-01-11 17:38:00 IST

Author: Mayer Goldberg

Validate XHTML 1.0