(define apply-continuation (lambda (k . list-of-values) (apply k list-of-values))) (define fact-acc (lambda (n acc) (if (zero? n) acc (fact-acc (- n 1) (* acc n))))) (fact-acc 5 1) (define fact-cps (lambda (n k) (fact-cps 5 list) (define list-copy-cps (lambda (L k) (list-copy-cps '(1 2 3) reverse) (define memq-cps (lambda (sym ls k) (memq-cps 'a '(b c a d) list) (memq-cps 'a '( b c d) not) (define intersection ; convert this to CPS (lambda (los1 los2) (cond [(null? los1) '()] [(memq (car los1) los2) (cons (car los1) (intersection (cdr los1) los2))] [else (intersection (cdr los1) los2)]))) (define intersection-cps (lambda (los1 los2 k) (intersection-cps '(a d e g h) '(s f c h b r a) list) (define 1st car) (define 2nd cadr) (define 3rd caddr) (define free-vars ; convert to CPS (lambda (exp) (cond [(symbol? exp) (list exp)] [(eq? (1st exp) 'lambda) (remove (car (2nd exp)) (free-vars (3rd exp)))] [else (union (free-vars (1st exp)) (free-vars (2nd exp)))]))) (define free-vars-cps ; convert to CPS (lambda (exp k) (free-vars-cps '(a (b ((lambda (x) (c (d (lambda (y) ((x y) e))))) f))) (lambda (v) v)) (define union-cps (lambda (s1 s2 k) (union-cps '(3 1 11 6 8 4) '5 1 8 9 2) list) (define remove-cps (lambda (element ls k) (if (null? ls) (remove-cps 'a '(b c e a d a a ) list) (define substitute-leftmost (lambda (new old slist) (subst-left-cps new old slist (lambda (v) v) ; succeed continuation (called "changed" in cps code) (lambda () slist) ; fail continuation (called "unchanged" in cps code) ))) (define subst-left-cps (lambda (new old slist changed unchanged) (let loop ([slist slist] [changed changed] [unchanged unchanged]) (cond [(null? slist) (apply-continuation unchanged)] (substitute-leftmost 'b 'a '((a c a) (((a (((b a))))))))