►C311/  H311/  A596/  B521 Fall 2024 – Programming Languages
▼Assignments
•6 Assignment 6:   Continuation-Passing Style
    contents  ← prev  up  next → 

6 Assignment 6: Continuation-Passing Style

Say you’re in the kitchen in front of the refrigerator, thinking about a sandwich. You take a continuation right there and stick it in your pocket. Then you get some turkey and bread out of the refrigerator and make yourself a sandwich, which is now sitting on the counter. You invoke the continuation in your pocket, and you find yourself standing in front of the refrigerator again, thinking about a sandwich. But fortunately, there’s a sandwich on the counter, and all the materials used to make it are gone. So you eat it.

——Luke Palmer

Note

In addition to your notes from class, you may find the following resources helpful as you work through this assignment

Assignment

For this assignment, you will convert several short programs to continuation-passing style. Please observe the following guidelines:

(define empty-k
  (lambda ()
    (let ((once-only #f))
      (lambda (v)
        (if once-only
        (error 'empty-k "You can only invoke the empty continuation once")
        (begin (set! once-only #t) v))))))

You may have seen empty-k defined as the following.

(define empty-k
  (lambda ()
    (lambda (v) v)))

However, the one above is much better, in that it will help you better detect if you have made a mistake in CPSing.

  1. Define and test a procedure binary-to-decimal-cps that is a CPSed version of the following binary-to-decimal procedure:

    (define binary-to-decimal
      (lambda (n)
        (cond
          [(null? n) 0]
          [else (+ (car n) (* 2 (binary-to-decimal (cdr n))))])))

    binary-to-decimal uses little-endian binary numbers; you should consider binary sequences with one or more trailing 0s to be ill-formed binary numbers (bad data). Here are a few sample calls to make the meaning clear.

    > (binary-to-decimal '())
    0
    > (binary-to-decimal '(1))
    1
    > (binary-to-decimal '(0 1))
    2
    > (binary-to-decimal '(1 1 0 1))
    11

  2. Define and test a procedure star-cps that is a CPSed version of the following star procedure:

    (define star
      (lambda (m)
        (lambda (n)
          (* m n))))

    Here are some examples of calls to star:
    > ((star 2) 3)
    6
    > ((star ((star 2) 3)) 5)
    30

  3. Define and test a procedure times-cps that is a CPSed version of the following times procedure.

    (define times
      (lambda (ls)
        (cond
          [(null? ls) 1]
          [(zero? (car ls)) 0]
          [else (* (car ls) (times (cdr ls)))])))

    Here are some examples of calls to times:

    > (times '(1 2 3 4 5))
    120
    > (times '(1 2 3 0 3))
    0

  4. Define a modified version of your times-cps above, called times-cps-shortcut that doesn’t apply k in the zero case. Instead, maintain the behavior of the zero? case in times - simply returning the 0 and not performing further computation. While this certainly violates the standard rules of CPSing the program, it provides an interesting look at optimizations CPSing allows us.

  5. Define and test a procedure remv-first-9*-cps that is a CPSed version of the following remv-first-9* procedure, which removes the first 9 in a preorder walk of the arbitrarily nested list ls:

    (define remv-first-9*
      (lambda (ls)
        (cond
          [(null? ls) '()]
          [(pair? (car ls))
           (cond
             [(equal? (car ls) (remv-first-9* (car ls)))
              (cons (car ls) (remv-first-9* (cdr ls)))]
             [else (cons (remv-first-9* (car ls)) (cdr ls))])]
          [(eqv? (car ls) '9) (cdr ls)]
          [else (cons (car ls) (remv-first-9* (cdr ls)))])))

    Here are some example calls to remv-first-9*:

    > (remv-first-9* '((1 2 (3) 9)))
    ((1 2 (3)))
    > (remv-first-9* '(9 (9 (9 (9)))))
    ((9 (9 (9))))
    > (remv-first-9* '(((((9) 9) 9) 9) 9))
    ((((() 9) 9) 9) 9)

  6. Define and test a procedure cons-cell-count-cps that is a CPSed version of the following cons-cell-count procedure:

    (define cons-cell-count
      (lambda (ls)
        (cond
          [(pair? ls)
           (add1 (+ (cons-cell-count (car ls)) (cons-cell-count (cdr ls))))]
          [else 0])))
    > (cons-cell-count '(1 2 3 4))
    4
    > (cons-cell-count '(1 2 (3 (4) 5) 4 ()))
    9

  7. Define and test a procedure find-cps that is a CPSed version of the following find procedure:

    (define find
      (lambda (u s)
        (let ((pr (assv u s)))
          (if pr (find (cdr pr) s) u))))

    Here are some sample calls to find:

    > (find 5 '((5 . a) (6 . b) (7 . c)))
    a
    > (find 7 '((5 . a) (6 . 5) (7 . 6)))
    a
    > (find 5 '((5 . 6) (9 . 6) (2 . 9)))
    6

  8. Define and test a procedure ack-cps that is a CPSed version of the following ack procedure:

    ;; ack: computes the Ackermann function
    ;; (http://en.wikipedia.org/wiki/Ackermann_function).  Warning: if you
    ;; run this program with m >= 4 and n >= 2, you'll be in for a long
    ;; wait.
    (define ack
      (lambda (m n)
        (cond
          [(zero? m) (add1 n)]
          [(zero? n) (ack (sub1 m) 1)]
          [else (ack (sub1 m)
                     (ack m (sub1 n)))])))

  9. Define and test a procedure fib-cps that is a CPSed version of the following fib procedure:

    (define fib
      (lambda (n)
        ((lambda (fib)
           (fib fib n))
         (lambda (fib n)
           (cond
             [(zero? n) 0]
             [(zero? (sub1 n)) 1]
             [else (+ (fib fib (sub1 n)) (fib fib (sub1 (sub1 n))))])))))

  10. Define and test a procedure unfold-cps that is a CPSed version of the following unfold procedure:

    (define unfold
      (lambda (p f g seed)
        ((lambda (h)
           ((h h) seed '()))
         (lambda (h)
           (lambda (seed ans)
             (if (p seed)
                 ans
                 ((h h) (g seed) (cons (f seed) ans))))))))

    An example of its use is demonstrated below:

    > (unfold null? car cdr '(a b c d e))
    (e d c b a)

    When testing your unfold-cps, you should consider its arguments to be serious, so include the following helper definitions when testing your code.

    > (define null?-cps
        (lambda (ls k)
          (k (null? ls))))
    > (define car-cps
        (lambda (pr k)
          (k (car pr))))
    > (define cdr-cps
        (lambda (pr k)
          (k (cdr pr))))
    > (unfold-cps null?-cps car-cps cdr-cps '(a b c d e) (empty-k))
    (e d c b a)

  11. Here is the definition of unify with its helpers. It implements first-order, syntactic unification. The current version uses the version of find given in question 7. Define and test a procedure unify-cps that uses your find-cps from question 7.

    (define empty-s
      (lambda ()
        '()))
     
    (define unify
      (lambda (u v s)
        (cond
          ((eqv? u v) s)
          ((number? u) (cons (cons u v) s))
          ((number? v) (unify v u s))
          ((pair? u)
           (if (pair? v)
               (let ((s (unify (find (car u) s) (find (car v) s) s)))
                 (if s (unify (find (cdr u) s) (find (cdr v) s) s) #f))
               #f))
          (else #f))))

    Here are some example calls to unify:

    > (unify 'x 5 (empty-s))
    ((5 . x))
    > (unify 'x 5 (unify 'y 6 (empty-s)))
    ((5 . x) (6 . y))
    > (unify '(x y) '(5 6) (empty-s))
    ((6 . y) (5 . x))
    > (unify 'x 5 (unify 'x 6 (empty-s)))
    ((5 . x) (6 . x))
    > (unify '(x x) '(5 6) (empty-s))
    ((6 . x) (5 . x))
    > (unify '(1 2 3) '(x 1 2) (empty-s))
    ((3 . x) (2 . x) (1 . x))
    > (unify 'x 'y (empty-s))
    #f

    As you can tell from the recursive call, we would normally invoke unify only after using find on the first two arguments. These tests have been specially chosen to avoid a need to do that.

  12. Define and test a procedure M-cps that is a CPSed version of M, which is a curried version of map. Assume for the CPSed version that any f passed in will also be CPSed.

    (define M
      (lambda (f)
        (lambda (ls)
          (cond
            ((null? ls) '())
            (else (cons (f (car ls)) ((M f) (cdr ls))))))))

  13. Consider the corresponding call to M, called use-of-M. Using your CPSed M-cps, re-write use-of-M to call M-cps, and make all the appropriate changes (including CPSing the argument). Name it use-of-M-cps

    (define use-of-M
      ((M (lambda (n) (add1 n))) '(1 2 3 4 5)))
Brainteaser

  1. CPS the following program, and call it strange-cps:

    (define strange
      (lambda (x)
        ((lambda (g) (lambda (x) (g g)))
         (lambda (g) (lambda (x) (g g))))))

  2. Consider the following use of strange, called use-of-strange. Using your CPSed strange, re-write use-of-strange to call strange-cps, and make all the appropriate changes. Name it use-of-strange-cps.

    (define use-of-strange
      (let ([strange^ (((strange 5) 6) 7)])
        (((strange^ 8) 9) 10)))

  3. CPS the following program, and call it why-cps:

    (define why
      (lambda (f)
        ((lambda (g)
           (f (lambda (x) ((g g) x))))
         (lambda (g)
           (f (lambda (x) ((g g) x)))))))

    To get you started, you may find it useful to see the following-call to why.

    > (define almost-length
        (lambda (f)
          (lambda (ls)
            (if (null? ls)
                0
                (add1 (f (cdr ls)))))))
    > ((why almost-length) '(a b c d e))
    5

  4. CPS why-cps, and call it why-cps-cps.

Just Dessert

No dessert today :(

    contents  ← prev  up  next →