PPL

CPS

Moed A 2007

Solution

(define scale-tree (λ (tree factor) (map (λ (sub-tree) (if (list? sub-tree) (scale-tree sub-tree factor) (* sub-tree factor))) tree)))

(scale-tree '(((1 4) 2)) 5)(scale-tree '( ) 2)

Continuation Passing Style

• Main idea: instead of returning a value, you pass it as a parameter to another function

• More specific: every user defined procedure f$ gets another parameter called continuation. When f$ ends we apply the continuation

• Distinction between creating the continuation and applying it

• All user defined function are in tail-position

Simple Examples:

Normal(define square (lambda (x)

(* x x)))

(define add1 (lambda (x)

(+ x 1)))

CPS(define square$(lambda (x cont)

(cont (* x x)))

(define add1$(lambda (x cont)

(cont (+ x 1))))

> (add1$ 5 (λ(x) x))( (λ(x) x) (+ 5 1) )6

> (square$ 5 (λ(x) x))( (λ(x) x) (* 5 5) )25

> (add1$ 5 (λ(x) (square$ x

(λ(x) x))))

(define square$(lambda (x cont)(cont (* x x)))(define add1$(lambda (x cont) (cont (+ x 1))))

( (λ(x) (square$ x (λ(x) x))))

(+ 5 1) )

( (λ (x) x) 36 )36

Evaluation Order

Order unknown(define h2 (λ (x y) (mult (square x) (add1 y))))

(define mult (λ (x y) (* x y)))

We set the order(define h2$ (λ (x y cont) (square$ x (λ (square-res) (add1$ y (λ (add1-res) (mult$ square-res add1-res cont)))))))

(define square$(lambda (x cont)(cont (* x x)))(define add1$(lambda (x cont) (cont (+ x 1))))

CPS is Good For:

• Order of computation (just seen)• Turning recursion into iteration (seen in the

past, see more now)• Controlling multiple future computations (the

true power of CPS)

A Word about Typing…

• You can avoid complicated typing by using letrec (see notes)

Recursion Into Iteration(define fact (λ (n) (if (= n 0) 1 (* n (fact (- n 1))))))

(fact 3)

(define fact$ (λ (n cont) (if (= n 0) (cont 1) (fact$ (- n 1) (λ (res) (cont (* n res)))))))

(fact$ 3 (λ (x) x)) ; ==>(fact$ 2 (λ (res1)

((λ (x) x) (* 3 res1))))

; ==>(fact$ 1 (λ (res2)

((λ (res1)

((λ (x) x) (* 3 res1)))

(* 2 res2))))

; ==>(fact$ 0 (λ (res3)

((λ (res2)

((λ (res1)

((λ (x) x) (* 3 res1)))

(* 2 res2)))

(* 1 res3))))

( (λ (res3)

( (λ (res2)

( (λ (res1)

( (λ (x) x) (* 3 res1)))

(* 2 res2)))

(* 1 res3)))

1); ==>( (λ (res2)

( (λ (res1)

( (λ (x) x) (* 3 res1)))

(* 2 res2)))

1); ==>( (λ (res1)

( (λ (x) x) (* 3 res1)))

2); ==>( (λ (x) x) 6)6

CPS Map(define map (λ (f lst) (if (null? lst) lst (cons (f (car lst)) (map f (cdr lst))))))

(define map$ (λ (f$ list c) (if (null? list) (c list) (f$ (car list) (λ (f-res) (map$ f$ (cdr list) (λ (map-cdr) (c (cons f-res map-cdr)))))))))

> (map$ (λ (x c) (c (* x x))) ‘(1 3) (λ (x) x))

((λ (x c) (c (* x x))) 1 (λ (f-res) (map$ (λ (x c) (c (* x x)) ‘(3) (λ (map-res) ( (λ (x) x) (cons f-res map-

res)) ))))))

(define map$ (λ (f$ list c) (if (null? list) (c list) (f$ (car list) (λ (f-res) (map$ f$ (cdr list) (λ (map-res) (c (cons f-res map-res)))))))))

Map$ Another Version(define map$ (λ (f$ list cont) (if (null? list) (cont list) (map$ f$ (cdr list) (λ (map-res) (f$ (car list) (λ (f-res) (cont (cons f-res map-res)))))))))

Multiple Future Computation

• The true power of CPS• Most useful example: errors– Errors are unplanned future– The primitive error breaks the calculation and

returns void• We want more control, and we can do it with

CPS

Sum List with Error(define sumlist (lambda (li) (cond ((null? li) 0) ((not (number? (car li))) (error "non numeric value!")) (else (+ (car li) (sumlist (cdr li)))))))

(sumlist '(1 2 a))

Try 1

(define sumlist (lambda (li) (cond ((null? li) 0) ((not (number? (car li))) (error "non numeric value!") 0) (else (+ (car li) (sumlist (cdr li)))))))

Try 2

(define sumlist (lambda (li) (cond ((null? li) 0) ((not (number? (car li))) #f) (else (let ((sum-cdr (sumlist (cdr li)))) (if sum-cdr (+ (car li) sum-cdr) #f))))))

Why is it so Complicated

• We are deep inside the recursion: the stack is full with frames and we need to “close” every one of them

• If only there was a way NOT to open frames on the stack…

Sum List with CPS

(define sumlist$ (λ (l succ fail) (cond ( (null? l) (succ l) ) ( (number? (car l)) (sumlist$ (cdr l) (λ (sum-cdr-l) (succ (+ (car l) sum-cdr-l)))

fail)) (else (fail l)))))

Run Example

(sumlist$ '(1 2 3 a) (lambda (x) x) (lambda (x) (display x) (display " ") (display 'not-a-num)))

Fail Continuation For Backtracking;; Purpose: Find the left most even leaf of a binary ;; tree whose leaves are labeled by numbers.;; Type: [LIST -> Number union Boolean];; Examples: (leftmost-even ’((1 2) (3 4))) ==> 2;; (leftmost-even ’((1 1) (3 3))) ==> #f(define leftmost-even (λ (tree) (letrec ((iter (λ (tree) (cond ((null? tree) #f) ((not (list? tree)) (if (even? tree) tree #f)) (else (let ((res-car (iter (car tree)))) (if res-car res-car (iter (cdr tree))))))))) (iter tree))))

No CPS

Fail Continuation For Backtracking(define leftmost-even$ (λ (tree succ-cont fail-cont) (cond ((null? tree) (fail-cont)) ; Empty tree ((not (list? tree)) ; Leaf tree (if (even? tree) (succ-cont tree) (fail-cont))) (else ; Composite tree (leftmost-even$ (car tree) succ-cont (λ () (leftmost-even$ (cdr tree) succ-cont fail-cont)))))))

(leftmost-even$ ((1 2) (3 4)) (λ (x) x) (λ () #f)) ==>

(leftmost-even$ (1 2) (λ (x) x) (λ () (leftmost-even$ ((3 4)) (λ (x) x) (λ ()

#f)))) ;==>

(leftmost-even$ 1 (λ (x) x) (λ () (leftmost-even$ (2) (λ (x) x) (λ () (leftmost-even$ ((3 4)) (λ (x) x) (λ () #f)))))) ;==>*

(leftmost-even$ (2) (λ (x) x) (λ () (leftmost-even$ ((3 4)) (λ (x) x) (λ () #f)))) ;==>*

( (λ (x) x) 2) ;==>2

Construct Tree with CPS(define replace-leftmost (λ (tree old new succ-cont fail-cont) (cond ((null? tree) (fail-cont)) ; Empty tree ((not (list? tree)) ; Leaf tree (if (eq? tree old) (succ-cont new) (fail-cont))) (else ; Composite tree (replace-leftmost$ (car tree) (λ (car-res) (succ-cont (cons car-res (cdr tree)))) (λ () (replace-leftmost$ (cdr tree) (λ (cdr-res) (succ-cont (cons (car tree) cdr-res))) fail-cont)))))))

Moed A 2007

Solution

(define scale-tree (λ (tree factor) (map (λ (sub-tree) (if (list? sub-tree) (scale-tree sub-tree factor) (* sub-tree factor))) tree)))

(scale-tree '(((1 4) 2)) 5)(scale-tree '( ) 2)

Solution

(define scale-tree$ (λ (tree factor c) (map$ (λ (sub-tree c) (if (list? sub-tree) (scale-tree$ sub-tree factor (λ (scale-sub-tree) (c scale-sub-tree))) (c (* sub-tree factor)))) tree c)))