source: project/release/3/amb/amb.scm @ 18200

Last change on this file since 18200 was 112, checked in by Thomas Chust, 15 years ago

v1.2.0: Non-determinism now optional, better controllability of scope

  • amb is now called amb/random
  • amb does the same as before except it doesn't shuffle the list of expressions any more
  • an amb-find macro has been added
File size: 1.7 KB
Line 
1;;;; amb.scm
2;;;; The fundamental non-deterministic backtracking operator
3
4(use extras)
5
6(cond-expand
7 (hygienic-macros
8  (define-syntax amb
9    (syntax-rules ()
10      ((amb)
11       ((amb-failure-continuation)))
12      ((amb x ...)
13       (amb-thunks (list (lambda () x) ...)))))
14  (define-syntax amb/random
15    (syntax-rules ()
16      ((amb)
17       ((amb-failure-continuation)))
18      ((amb x ...)
19       (amb-thunks (shuffle (list (lambda () x) ...))))))
20  (define-syntax amb-find
21    (syntax-rules ()
22      ((amb-find x)
23       (amb-find-thunk (lambda () x)))
24      ((amb-find x f)
25       (amb-find-thunk (lambda () x) (lambda () f)))))
26  (define-syntax amb-collect
27    (syntax-rules ()
28      ((amb-collect x)
29       (amb-collect-thunk (lambda () x)))))
30  (define-syntax amb-assert
31    (syntax-rules ()
32      ((amb-assert ok?)
33       (if (not ok?) ((amb-failure-continuation)))))))
34 (else
35  (define-macro (amb . xx)
36    (if (null? xx)
37        '((amb-failure-continuation))
38        `(amb-thunks (list ,@(map (cut list 'lambda '() <>) xx)))))
39  (define-macro (amb/random . xx)
40    (if (null? xx)
41        '((amb-failure-continuation))
42        `(amb-thunks (shuffle (list ,@(map (cut list 'lambda '() <>) xx))))))
43  (define-macro (amb-find x . f)
44    (cond
45     ((null? f)
46      `(amb-find-thunk (lambda () ,x)))
47     ((null? (cdr f))
48      `(amb-find-thunk (lambda () ,x) (lambda () ,(car f))))
49     (else
50      (signal
51       (make-composite-condition
52        (make-property-condition
53         'exn
54         'message "during expansion of (amb-find ...) - bad argument count - received more than 2 but expected 1 or 2"
55         'location #f
56         'arguments (cons x f)))))))
57  (define-macro (amb-collect x)
58    `(amb-collect-thunk (lambda () ,x)))
59  (define-macro (amb-assert ok?)
60    `(if (not ,ok?) ((amb-failure-continuation))))))
Note: See TracBrowser for help on using the repository browser.