hints/cps_hint_4.mdwn

   1 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.
   2
   3         #lang racket
   4
   5         (define (atom? x)
   6           (and (not (pair? x)) (not (null? x))))
   7
   8         (define delta
   9           (letrec ([yield (lambda (x) x)]
  10                    [resume (lambda (x) x)]
  11                    [walk (lambda (l)
  12                            (cond
  13                              ; this is the only case where walk terminates naturally
  14                              [(null? l) '()]
  15                              [(atom? (car l)) (begin
  16                                                 (let/cc k2 (begin
  17                                                   (set! resume k2) ; now calling resume with val will ignore val
  18                                                                    ; and continue with the final line of (begin ... (walk (cdr l)))
  19                                                   ; when the next line is executed, yield will be bound to k1 or k3
  20                                                   (yield (car l))))
  21                                                 ; the previous yield line will never return, but the following line will be executed when resume is called
  22                                                 (walk (cdr l)))]
  23                              [else (begin
  24                                      ; walk will only ever return when a '() is reached, and will in that case return a '()
  25                                      (walk (car l))
  26                                      (walk (cdr l)))]))]
  27                    [next (lambda () ; next is a thunk
  28                            (let/cc k3 (begin
  29                              (set! yield k3) ; now calling yield with val will return val from the call to next
  30                              ; when the next line is executed, resume will be bound to k2
  31                              (resume 'blah))))]
  32                    [check (lambda (prev)
  33                             (let ([n (next)])
  34                               (cond
  35                                 [(eq? n prev) #t]
  36                                 [(atom? n) (check n)]
  37                                 ; n will fail to be an atom iff we've walked to the end of the list, and (resume 'blah) returned naturally
  38                                 [else #f])))])
  39             (lambda (lst)
  40               (let ([fst (let/cc k1 (begin
  41                            (set! yield k1) ; now calling yield with val will bind fst to val and continue with the (cond ...) block below
  42                            (walk lst)
  43                            ; the next line will be executed only when lst contains no atoms
  44                            (yield '())))])
  45                 (cond
  46                   [(atom? fst) (check fst)]
  47                   [else #f])
  48                 ))))
  49
  50         (delta '(((a b) ()) (c (d ()))))   ; ~~> #f
  51         (delta '(((a b) ()) (b (d ()))))   ; ~~> #t
  52         (delta '(((a b) ()) (c (d (d)))))  ; ~~> #t
  53         (delta '(((a b c) ()) (c (d ())))) ; ~~> #t
  54         (delta '(((a b) ()) (c (d ()) c))) ; ~~> #f
  55