Scheme continuation 之 amb

Question

1. ;;;  amb
2. ;;;  Example:
3. ;;;    > (if (amb #f #t)
4. ;;;          1
5. ;;;          (amb))
6. ;;;    1
7. ;;;    > (let ((x (list (amb 1 4 5)
8. ;;;                     (amb 2 6 7))))
9. ;;;        (let ((x1 (car x))
10. ;;;              (x2 (cadr x)))
11. ;;;          (amb:assert (and (even? x1)
12. ;;;                           (even? x2)))
13. ;;;          (amb:assert (< x1 x2)))
14. ;;;        x)
15. ;;;    (4 6)
17. (define amb:fail #f)
19. (define (amb:init-fail)
20.   (set! amb:fail
21.         (lambda () (error "amb tree exhausted"))))
22. (amb:init-fail)
24. (define-syntax amb
25.   (syntax-rules ()
26.     ((amb alt ...)
27.      (let ((amb:prev-fail amb:fail))
28.        (call/cc
29.         (lambda (choose)
30.          
31.           (call/cc
32.            (lambda (jump)
33.              (set! amb:fail
34.                    (lambda()
35.                      (set! amb:fail amb:prev-fail)
36.                      (jump 'next)))            
37.              (choose alt))) ...
38.          
39.           (amb:prev-fail)))))))
41. (define (amb:assert pred)
42.   (when (not pred)
43.       (amb)))

复制代码

Answer 1

本帖最后由 KanonInD 于 2011-02-05 22:01 编辑

网上还有另一个版本：

1. (define fail #f)
3. (define (choice . ls)
4.   (if (null? ls)
5.       (fail)
6.       (let ((fail0 fail))
7.         (call/cc (lambda (return)
8.                    (set! fail (lambda ()
9.                                 (set! fail fail0)
10.                                 (return (apply choice (cdr ls)))))
11.                    (return (car ls)))))))
13. (call/cc (lambda (return)
14.            (set! fail (lambda ()
15.                         (return 'no-choice)))))

复制代码