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 (begin
(set! resume k2) ; now calling resume with val will ignore val
; and continue with the final 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 (begin
(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 (begin
(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 when we've walked to the end of lst
(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
(delta '((() ()) ())) ; ~~> #f