Consider the following definitions:
(define tree-sum
(lambda (ls)
(cond
[(null? ls) 0]
[(pair? (car ls))
(+ (tree-sum (car ls))
(tree-sum (cdr ls)))]
[else (+ (car ls) (tree-sum (cdr ls)))])))
(define walk
(lambda (v ls)
(cond
[(symbol? v)
(let ((p (assq v ls)))
(cond
[p (walk (cdr p) ls)]
[else v]))]
[else v])))
(define depth
(lambda (ls)
(cond
[(null? ls) 1]
[(pair? (car ls))
(let ((l (add1 (depth (car ls))))
(r (depth (cdr ls))))
(if (< l r) r l))]
[else (depth (cdr ls))])))
(define ack
(lambda (n m)
(cond
[(zero? n) (add1 m)]
[(zero? m) (ack (sub1 n) 1)]
[else (ack (sub1 n)
(ack n (sub1 m)))])))
(define fact
(lambda (n)
((lambda (fact)
(fact fact n))
(lambda (fact n)
(cond
[(zero? n) 1]
[else (* n (fact fact (sub1 n)))])))))
(define pascal
(lambda (n)
(let ((pascal
(lambda (pascal)
(lambda (m a)
(cond
[(> m n) '()]
[else (let ((a (+ a m)))
(cons a ((pascal pascal) (add1 m) a)))])))))
((pascal pascal) 1 0))))
CPS each function. Test your CPSed functions using the initial
continuation returned from the empty-k procedure (see
examples below). When CPSing, any calls to functions not defined
above (such as assq) are treated as primitive calls.
fact in direct-style.
(define fact
(lambda (n)
(cond
[(zero? n) 1]
[else (* n (fact (sub1 n)))])))
Here is fact-cps, which is the CPS version of fact.
(define fact-cps
(lambda (n k)
(cond
[(zero? n) (k 1)]
[else (fact-cps (sub1 n) (lambda (v)
(k (* n v))))])))
Since fact-cps consumes two arguments instead of one, we need to define a "driver" function called fact.
(define fact
(lambda (n)
(fact-cps n (empty-k))))
We could use the identity function (lambda (v) v) as the
initial continuation, but we want to signal an error
if the initial continuation is invoked more than once.
Therefore, we will use the continuation returned from
calling the empty-k procedure.
(define empty-k
(lambda ()
(let ([okay #t])
(lambda (v)
(if okay
(begin
(set! okay #f)
v)
(error 'mt-k "k invoked in non-tail position"))))))
Just for fun, let's write an incorrect definition
of fact-cps that invokes the continuation k multiple
times.
(define fact-cps
(lambda (n k)
(cond
[(zero? n) (k 1)]
[else (fact-cps (sub1 n) (k (lambda (v)
(k (* n v)))))])))
When we test our new version, we get an error!
Error in mt-k: k invoked in non-tail position. Type (debug) to enter the debugger.Here is one more example, using the Fibonacci function. First we define
fib in direct-style.
(define fib
(lambda (n)
(cond
[(zero? n) 1]
[(= n 1) 1]
[else (+ (fib (sub1 n)) (fib (sub1 (sub1 n))))])))
Now we transform fib into continuation-passing style.
(define fib-cps
(lambda (n k)
(cond
[(zero? n) (k 1)]
[(= n 1) (k 1)]
[else (fib-cps (sub1 n) (lambda (v)
(fib-cps (sub1 (sub1 n)) (lambda (w)
(k (+ v w))))))])))
Once again, we must define a driver function.
(define fib
(lambda (n)
(fib-cps n (empty-k))))
(define M
(lambda (f)
(lambda (ls)
(cond
((null? ls) '())
(else (cons (f (car ls)) ((M f) (cdr ls))))))))
Because this program is difficult, we have provided a sample call for you.
((M add1) '(1 2 3)) => '(2 3 4)
prod function, which takes a list of numbers as its argument, and returns their product.
(define prod
(lambda (lon)
(letcc k
(letrec ((prod (lambda (lon)
(cond
[(null? lon) 1]
[(zero? (car lon)) (k 0)]
[else (* (car lon) (prod (cdr lon)))]))))
(prod lon)))))
(prod '(4 2 3)) => 24
(prod '(7)) => 7
(prod '()) => 1
(prod '(4 0 2 3)) => 0
prod uses letcc to capture the continuation outside of the letrec.
If prod encounters a zero in the list, it avoids unnecessary work by immediately invoking the continuation with the value zero.
letcc is not part of the R5RS Scheme standard, but can be macro defined in terms of call/cc.
(define-syntax letcc
(syntax-rules ()
[(_ k e) (call/cc (lambda (k) e))]))
Use your knowledge of CPS to rewrite prod without letcc (or call/cc).
Your definition of prod must still take a single argument (a list of numbers) and must still
avoid doing extra work when it encounters a zero in lon.