Amb с использованием продолжений

О боже... этот код выглядит так, будто пытается использовать продолжения для правильной обработки ошибок. Что... технически... возможно. Но, честно говоря, поскольку вы сказали, что делаете это в Racket, а не только в схеме, было бы намного лучше просто использовать механизм обработки исключений напрямую.

Но я разобью программу на части.

Во-первых, общий алгоритм:

• Предположим, что a, b и c являются первым элементом в соответствующих списках.

• Если при выполнении кода вы достигаете ошибки assert, вернитесь назад во времени и предположите, что c на самом деле является следующей вещью в списке.

• Если вы вернулись во времени настолько, что у вас закончились c возможности, попробуйте второй пункт для b. Повторяйте, пока не закончатся возможности для b, затем сделайте то же самое для a.

По сути, это просто алгоритм поиска с возвратом, который использует продолжения в попытке выглядеть причудливо.

Функция

(define (current-continuation) 
  (call-with-current-continuation 
   (lambda (cc)
     (cc cc))))

Просто хватает текущего продолжения. По сути, вы можете думать об этом как о снимке во времени, к которому вы можете получить доступ, вызвав его как функцию. Итак, вы можете сделать:

(let ([cc (current-continuation)])
  ...)

Теперь в этом блоке вызов cc вернет вычисление к этой точке, заменив cc тем, что вы в него передали. Итак, если бы вы, скажем, передали в него cc, например:

(let ([cc (current-continuation)])
  (cc cc))

ваша программа зациклится.

(define fail-stack '())

; fail : -> ...
(define (fail)
  (if (not (pair? fail-stack))
      (error "back-tracking stack exhausted!")
      (begin
        (let ((back-track-point (car fail-stack)))
          (set! fail-stack (cdr fail-stack))
          (back-track-point back-track-point)))))

; (assert condition) will cause
; condition to be true, and if there
; is no way to make it true, then
; it signals and error in the program.
(define (assert condition)
  (if (not condition)
      (fail)
      #t))  

Это просто сохраняет стек продолжений для вызова, когда assert терпит неудачу.

; amb : list[a] -> a
(define (amb choices)
  (let ((cc (current-continuation)))
    (cond
      ((null? choices) (fail))
      ((pair? choices)
       (let ((choice (car choices)))
         (set! choices (cdr choices))
         (set! fail-stack (cons cc fail-stack))
         choice)))))

Это создает пространство, которое можно исследовать.

; The following prints (4 3 5)
(let ((a (amb (list 1 2 3 4 5 6 7)))
      (b (amb (list 1 2 3 4 5 6 7)))
      (c (amb (list 1 2 3 4 5 6 7))))

  ; We're looking for dimensions of a legal right
  ; triangle using the Pythagorean theorem:
  (assert (= (* c c) (+ (* a a) (* b b))))

  (display (list a b c))
  (newline)

  ; And, we want the second side to be the shorter one:
  (assert (< b a))

  ; Print out the answer:
  (display (list a b c))
  (newline))

И это делает фактический поиск и распечатывает результаты.