Scheme continuation 之 amb

Lispor

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)
    
16. 
    
17. (define amb:fail #f)
    
18. 
    
19. (define (amb:init-fail)
    
20.   (set! amb:fail
    
21.         (lambda () (error "amb tree exhausted"))))
    
22. (amb:init-fail)
    
23. 
    
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)))))))
    
40. 
    
41. (define (amb:assert pred)
    
42.   (when (not pred)
    
43.       (amb)))

复制代码

KanonInD

网上还有另一个版本：

1. (define fail #f)
   
2. 
   
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)))))))
    
12. 
    
13. (call/cc (lambda (return)
    
14.            (set! fail (lambda ()
    
15.                         (return 'no-choice)))))

复制代码