add seasoned schemer exercises to cps

Signed-off-by: Jim Pryor <profjim@jimpryor.net>

diff --git a/cps_and_continuation_operators.mdwn b/cps_and_continuation_operators.mdwn
index e61eb70..0b0f25d 100644 (file)
--- a/cps_and_continuation_operators.mdwn
+++ b/cps_and_continuation_operators.mdwn
@@ -184,8 +184,8 @@ So too will examples. We'll give some examples, and show you how to try them out
                (let/cc k ...)
 
 
                (let/cc k ...)
 
 

-Callcc examples
----------------
+Callcc/letcc examples
+---------------------

 
 First, here are two examples in Scheme:
 
 
 First, here are two examples in Scheme:
 


@@ -276,6 +276,119 @@ The third example is more difficult to make work with the monadic library, becau
 
 <!-- FIXME -->
 
 
 <!-- FIXME -->
 

+Here are a series of examples from *The Seasoned Schemer*, which we recommended at the start of term. It's not necessary to have the book to follow the exercises, though if you do have it, its walkthroughs will give you useful assistance.
+
+For reminders about Scheme syntax, see [here](/assignment8/) and [here](/week1/) and [here](/translating_between_ocaml_scheme_and_haskell). Other resources are on our [[Learning Scheme]] page.
+
+All of the examples assume the following preface:
+
+       #lang racket
+
+       (define (atom? x)
+         (and (not (pair? x)) (not (null? x))))
+
+Now try to figure out what this function does:
+
+       (define alpha
+         (lambda (a lst)
+           (let/cc k ; now what will happen when k is called?
+             (letrec ([aux (lambda (l)
+                             (cond
+                               [(null? l) '()]
+                               [(eq? (car l) a) (k (aux (cdr l)))]
+                               [else (cons (car l) (aux (cdr l)))]))])
+               (aux lst)))))
+       
+Here is [the answer](/hints/cps_hint_1), but try to figure it out for yourself.
+
+Next, try to figure out what this function does:
+
+       (define beta
+         (lambda (lst)
+           (let/cc k ; now what will happen when k is called?
+             (letrec ([aux (lambda (l)
+                             (cond
+                               [(null? l) '()]
+                               [(atom? (car l)) (k (car l))]
+                               [else (begin
+                                       ; what will the value of the next line be? why is it ignored?
+                                       (aux (car l))
+                                       (aux (cdr l)))]))])
+               (aux lst)))))
+
+Here is [the answer](/hints/cps_hint_2), but try to figure it out for yourself.
+
+Next, try to figure out what this function does:
+
+       (define gamma
+         (lambda (a lst)
+           (letrec ([aux (lambda (l k)
+                           (cond
+                             [(null? l) (k 'notfound)]
+                             [(eq? (car l) a) (cdr l)]
+                             [(atom? (car l)) (cons (car l) (aux (cdr l) k))]
+                             ; what happens when (car l) exists but isn't an atom?
+                             [else (let ([car2 (let/cc k2 ; now what will happen when k2 is called?
+                                                 (aux (car l) k2))])
+                                     (cond
+                                       ; when will the following condition be met? what happens then?
+                                       [(eq? car2 'notfound) (cons (car l) (aux (cdr l) k))]
+                                       [else (cons car2 (cdr l))]))]))]
+                    [lst2 (let/cc k1 ; now what will happen when k1 is called?
+                            (aux lst k1))])
+             (cond
+               ; when will the following condition be met?
+               [(eq? lst2 'notfound) lst]
+               [else lst2]))))
+
+
+Here is [the answer](/hints/cps_hint_3), but try to figure it out for yourself.
+
+Here is the hardest example. Try to figure out what this function does:
+
+       (define delta
+         (letrec ([yield (lambda (x) x)]
+                  [resume (lambda (x) x)]
+                  [walk (lambda (l)
+                          (cond
+                            ; is this the only case where walk returns a non-atom?
+                            [(null? l) '()]
+                            [(atom? (car l)) (begin
+                                               (let/cc k2
+                                                 (set! resume k2) ; now what will happen when resume is called?
+                                                 ; when the next line is executed, what will yield be bound to?
+                                                 (yield (car l)))
+                                               ; when will the next line be executed?
+                                               (walk (cdr l)))]
+                            [else (begin
+                                    ; what will the value of the next line be? why is it ignored?
+                                    (walk (car l))
+                                    (walk (cdr l)))]))]
+                  [next (lambda () ; next is a thunk
+                          (let/cc k3
+                            (set! yield k3) ; now what will happen when yield is called?
+                            ; when the next line is executed, what will resume be bound to?
+                            (resume 'blah)))]
+                  [check (lambda (prev)
+                           (let ([n (next)])
+                             (cond
+                               [(eq? n prev) #t]
+                               [(atom? n) (check n)]
+                               ; when will n fail to be an atom?
+                               [else #f])))])
+           (lambda (lst)
+             (let ([fst (let/cc k1
+                          (set! yield k1) ; now what will happen when yield is called?
+                          (walk lst)
+                          ; when will the next line be executed?
+                          (yield '()))])
+               (cond
+                 [(atom? fst) (check fst)]
+                 ; when will fst fail to be an atom?
+                 [else #f])
+               ))))
+
+Here is [the answer](/hints/cps_hint_4), but again, first try to figure it out for yourself.

 
 
 Delimited control operators
 
 
 Delimited control operators

diff --git a/hints/cps_hint_1 b/hints/cps_hint_1
new file mode 100644 (file)
index 0000000..985ba18
--- /dev/null
+++ b/hints/cps_hint_1
@@ -0,0 +1,27 @@
+This function is developed in *The Seasoned Schemer* pp. 55-60. It accepts an atom `a` and a list of atoms `lst`, and returns the part of `lst` following the last occurrence of `a`. If `a` is not in `lst`, it returns `lst` unaltered.
+
+       #lang racket
+       
+       (define (atom? x)
+         (and (not (pair? x)) (not (null? x))))
+       
+       (define alpha
+         (lambda (a lst)
+           (let/cc k ; calling k with val will immediately return val from the call to alpha
+             (letrec ([aux (lambda (l)
+                             (cond
+                               [(null? l) '()]
+                               [(eq? (car l) a)
+                                ; we abandon any waiting recursive (aux ...) calls, and instead immediately return (aux (cdr l))
+                                ; ...since Scheme is call-by-value, (aux (cdr l)) will be evaluated first, and
+                                ; any calls to k therein will come first (and the pending (k ...) here will be abandoned)
+                                (k (aux (cdr l)))]
+                               [else (cons (car l) (aux (cdr l)))]))])
+               (aux lst)))))
+       
+       
+       (alpha 'a '(a b c a d e f)) ; ~~> '(d e f)
+       (alpha 'x '(a b c a d e f)) ; ~~> '(a b c a d e f)
+       (alpha 'f '(a b c a d e f)) ; ~~> '()
+       (alpha 'a '(a b c x d e f)) ; ~~> '(b c x d e f)
+

diff --git a/hints/cps_hint_2 b/hints/cps_hint_2
new file mode 100644 (file)
index 0000000..2cdc49a
--- /dev/null
+++ b/hints/cps_hint_2
@@ -0,0 +1,43 @@
+This function is developed in *The Seasoned Schemer* pp. 76-83. It accepts a list `lst` and returns the leftmost atom in it, even if that atom is embedded several levels deep. Any empty lists preceding the leftmost atom are ignored.
+
+
+       #lang racket
+       
+       (define (atom? x)
+         (and (not (pair? x)) (not (null? x))))
+       
+       (define beta
+         (lambda (lst)
+           (let/cc k ; calling k with val will immediately return val from the call to beta
+             (letrec ([aux (lambda (l)
+                             (cond
+                               [(null? l) '()]
+                               [(atom? (car l)) (k (car l))]
+                               [else (begin
+                                       ; each of the following lines will evaluate to '() iff no atom was found in the specified part of l
+                                       (aux (car l))
+                                       (aux (cdr l)))]))])
+               (aux lst)))))
+       
+       (beta '(((a b) ()) (c (d ())))) ; ~~> 'a
+       (beta '((() (a b) ()) (c (d ())))) ; ~~> 'a
+       (beta '(() (() (a b) ()) (c (d ())))) ; ~~> 'a
+       (beta '(() (() ()))) ; no leftmost atom, returns '()
+
+This function could also be written like this:
+
+       (define leftmost
+         (lambda (l)
+           (cond
+             [(null? l) '()]
+             [(atom? (car l)) (car l)]
+             [else (let ([found (leftmost (car l))])
+                     (cond
+                       ; here we check whether the recursive call found an atom in (car l)
+                       [(atom? found) found]
+                       ; if not, we search for an atom in (cdr l)
+                       [else (leftmost (cdr l))]))])))
+
+But in this version, when an atom is found, it is returned back the chain of recursive calls, one by one. The previous version, on the other hand, uses a captured continuation `k` to return the atom immediately upon finding it.
+
+

diff --git a/hints/cps_hint_3 b/hints/cps_hint_3
new file mode 100644 (file)
index 0000000..845f556
--- /dev/null
+++ b/hints/cps_hint_3
@@ -0,0 +1,40 @@
+This function is developed in *The Seasoned Schemer* pp. 84-89. It accepts an atom `a` and a list `lst` and returns `lst` with the leftmost occurrence of `a`, if any, removed. Occurrences of `a` will be found no matter how deeply embedded.
+
+       #lang racket
+       
+       (define (atom? x)
+         (and (not (pair? x)) (not (null? x))))
+       
+       (define gamma
+         (lambda (a lst)
+           (letrec ([aux (lambda (l k)
+                           (cond
+                             [(null? l) (k 'notfound)]
+                             [(eq? (car l) a) (cdr l)]
+                             [(atom? (car l)) (cons (car l) (aux (cdr l) k))]
+                             ; when (car l) exists but isn't an atom, we try to remove a from (car l)
+                             ; if we succeed we prepend the result to (cdr l) and stop
+                             [else (let ([car2 (let/cc k2
+                                                 ; calling k2 with val will bind car2 to val and continue with the (cond ...) block below
+                                                 (aux (car l) k2))])
+                                     (cond
+                                       ; if a wasn't found in (car l) then prepend (car l) to the result of removing a from (cdr l)
+                                       [(eq? car2 'notfound) (cons (car l) (aux (cdr l) k))]
+                                       ; else a was found in (car l)
+                                       [else (cons car2 (cdr l))]))]))]
+                    [lst2 (let/cc k1
+                            ; calling k1 with val will bind lst2 to val and continue with the (cond ...) block below
+                            (aux lst k1))])
+             (cond
+               ; was no atom found in lst?
+               [(eq? lst2 'notfound) lst]
+               [else lst2]))))
+       
+       (gamma 'a '(((a b) ()) (c (d ())))) ; ~~> '(((b) ()) (c (d ())))
+       (gamma 'a '((() (a b) ()) (c (d ())))) ; ~~> '((() (b) ()) (c (d ())))
+       (gamma 'a '(() (() (a b) ()) (c (d ())))) ; ~~> '(() (() (b) ()) (c (d ())))
+       (gamma 'c '((() (a b) ()) (c (d ())))) ; ~~> '((() (a b) ()) ((d ())))
+       (gamma 'c '(() (() (a b) ()) (c (d ())))) ; ~~> '(() (() (a b) ()) ((d ())))
+       (gamma 'x '((() (a b) ()) (c (d ())))) ; ~~> '((() (a b) ()) (c (d ())))
+       (gamma 'x '(() (() (a b) ()) (c (d ())))) ; ~~> '(() (() (a b) ()) (c (d ())))
+

diff --git a/hints/cps_hint_4 b/hints/cps_hint_4
new file mode 100644 (file)
index 0000000..2dc984d
--- /dev/null
+++ b/hints/cps_hint_4
@@ -0,0 +1,55 @@
+This function is developed in *The Seasoned Schemer* pp. 165-177. It accepts a list `lst` and returns `#t` or `#f` depending on whether any atom appears in `lst` twice in a row. The list is interpreted as though it were flattened: all embedded lists are collapsed into the topmost level, and empty list elements are ignored. However, no flattened copy of the list is ever constructed.
+
+       #lang racket
+       
+       (define (atom? x)
+         (and (not (pair? x)) (not (null? x))))
+       
+       (define delta
+         (letrec ([yield (lambda (x) x)]
+                  [resume (lambda (x) x)]
+                  [walk (lambda (l)
+                          (cond
+                            ; this is the only case where walk terminates naturally
+                            [(null? l) '()]
+                            [(atom? (car l)) (begin
+                                               (let/cc k2
+                                                 (set! resume k2) ; now calling resume with val will ignore val
+                                                                  ; and continue with the second line of (begin ... (walk (cdr l)))
+                                                 ; when the next line is executed, yield will be bound to k1 or k3
+                                                 (yield (car l)))
+                                               ; the previous yield line will never return, but the following line will be executed when resume is called
+                                               (walk (cdr l)))]
+                            [else (begin
+                                    ; walk will only ever return when a '() is reached, and will in that case return a '()
+                                    (walk (car l))
+                                    (walk (cdr l)))]))]
+                  [next (lambda () ; next is a thunk
+                          (let/cc k3
+                            (set! yield k3) ; now calling yield with val will return val from the call to next
+                            ; when the next line is executed, resume will be bound to k2
+                            (resume 'blah)))]
+                  [check (lambda (prev)
+                           (let ([n (next)])
+                             (cond
+                               [(eq? n prev) #t]
+                               [(atom? n) (check n)]
+                               ; n will fail to be an atom iff we've walked to the end of the list, and (resume 'blah) returned naturally
+                               [else #f])))])
+           (lambda (lst)
+             (let ([fst (let/cc k1
+                          (set! yield k1) ; now calling yield with val will bind fst to val and continue with the (cond ...) block below
+                          (walk lst)
+                          ; the next line will be executed only when lst contains no atoms
+                          (yield '()))])
+               (cond
+                 [(atom? fst) (check fst)]
+                 [else #f])
+               ))))
+       
+       (delta '(((a b) ()) (c (d ())))) ; ~~> #f
+       (delta '(((a b) ()) (b (d ())))) ; ~~> #t
+       (delta '(((a b) ()) (c (d (d))))) ; ~~> #t
+       (delta '(((a b c) ()) (c (d ())))) ; ~~> #t
+       (delta '(((a b) ()) (c (d ()) c))) ; ~~> #f
+