source: project/release/3/amb/amb-demo.scm @ 7753

Last change on this file since 7753 was 10, checked in by felix winkelmann, 15 years ago

more eggs, some fixes

File size: 1.0 KB
Line 
1;;;; amb-demo.scm
2;;;; A solution for the Kalotan puzzle using amb
3
4(require-extension amb)
5
6(define (xor a? b?)
7  (if (and a? b?) #f (or a? b?)))
8
9(define (solve-kalotan-puzzle)
10  (let ((parent1 (amb 'm 'f))
11        (parent2 (amb 'm 'f))
12        (kibi (amb 'm 'f))
13        (kibi-self-desc (amb 'm 'f))
14        (kibi-lied? (amb #t #f)))
15    (amb-assert
16     (not (eq? parent1 parent2)))
17    (if kibi-lied?
18        (amb-assert
19         (xor
20          (and (eqv? kibi-self-desc 'm)
21               (eqv? kibi 'f))
22          (and (eqv? kibi-self-desc 'f)
23               (eqv? kibi 'm)))))
24    (if (not kibi-lied?)
25        (amb-assert
26         (xor
27          (and (eqv? kibi-self-desc 'm)
28               (eqv? kibi 'm))
29          (and (eqv? kibi-self-desc 'f)
30               (eqv? kibi 'f)))))
31    (if (eqv? parent1 'm)
32        (amb-assert
33         (and
34          (eqv? kibi-self-desc 'm)
35          (xor
36           (and (eqv? kibi 'f)
37                (eqv? kibi-lied? #f))
38           (and (eqv? kibi 'm)
39                (eqv? kibi-lied? #t))))))
40    (if (eqv? parent1 'f)
41        (amb-assert
42         (and
43          (eqv? kibi 'f)
44          (eqv? kibi-lied? #t))))
45    (list parent1 parent2 kibi)))
46
47(write (amb-collect (solve-kalotan-puzzle)))
48(newline)
Note: See TracBrowser for help on using the repository browser.