]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/amb-eli.rkt
Solution to 4.44. A bit too verbose. Can be improved by better
[sicp.git] / src / sicp / amb-eli.rkt
1 #lang racket
2 (provide amb assert collect)
3
4 (define failures null)
5
6 (define (fail)
7   (if (pair? failures)
8       ((first failures))
9       (error "no more choices!")))
10
11 (define (amb/thunks choices)
12   (let/cc k (set! failures (cons k failures)))
13   (if (pair? choices)
14       (let ([choice (first choices)])
15         (set! choices (rest choices))
16         (choice))
17       (begin (set! failures (rest failures))
18              (fail))))
19
20 (define-syntax-rule (amb E ...)
21   (amb/thunks (list (lambda () E) ...)))
22
23 (define (assert condition)
24   (unless condition (fail)))
25
26 (define (collect/thunk n thunk)
27   (define results null)
28   (let/cc too-few
29     (set! failures (list too-few))
30     (define result (thunk))
31     (set! results (cons result results))
32     (set! n (sub1 n))
33     (unless (zero? n) (fail)))
34   (set! failures null)
35   (reverse results))
36
37 (define-syntax collect
38   (syntax-rules ()
39     ;; collect N results
40     [(_ N E) (collect/thunk N (lambda () E))]
41     ;; collect all results
42     [(_ E) (collect/thunk -1 (lambda () E))]))