(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)