35 lines
1.0 KiB
Scheme
35 lines
1.0 KiB
Scheme
(define %fail-stack '())
|
|
|
|
(define (%fail!)
|
|
(if (null? %fail-stack)
|
|
(error 'amb "Backtracking stack exhausted!")
|
|
(let ((backtrack (car %fail-stack)))
|
|
(set! %fail-stack (cdr %fail-stack))
|
|
(backtrack backtrack))))
|
|
|
|
(define (amb choices)
|
|
(let ((cc (call-with-current-continuation values)))
|
|
(if (null? choices)
|
|
(%fail!)
|
|
(let ((choice (car choices)))
|
|
(set! %fail-stack (cons cc %fail-stack))
|
|
(set! choices (cdr choices))
|
|
choice))))
|
|
|
|
(define (assert! condition)
|
|
(unless condition (%fail!)))
|
|
|
|
;;; The list can contain as many lists as desired.
|
|
(define words (list '("the" "that" "a")
|
|
'("frog" "elephant" "thing")
|
|
'("walked" "treaded" "grows")
|
|
'("slowly" "quickly")))
|
|
(define (joins? a b)
|
|
(char=? (string-ref a (sub1 (string-length a))) (string-ref b 0)))
|
|
(let ((sentence (map amb words)))
|
|
(fold (lambda (x y)
|
|
(assert! (joins? x y))
|
|
y)
|
|
(car sentence) (cdr sentence))
|
|
sentence)
|