X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=hints%2Fcps_hint_4;fp=hints%2Fcps_hint_4;h=2dc984d3a2c3a31131ec6722d521e883b739f794;hp=0000000000000000000000000000000000000000;hb=150b1f14a167dded18d22b026ccea69b299d250a;hpb=a0e217406bed06e9d774d83fb31b4e648da2c8ec

diff --git a/hints/cps_hint_4 b/hints/cps_hint_4
new file mode 100644
index 00000000..2dc984d3
--- /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
+