1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
; Equivalent to example/zebra.adb
; Place contents of mk.scm from simple-miniKanren here.
; An equivalent microKanren implementation such as from the 2013 paper will also work.
; Place contents of mkdefs.scm from simple-miniKanren here.
; Be sure to leave out the (load "mk.scm") line.
(define (on-right l r li)
(conde
((fresh (z)
(caro li l)
(cdro li z)
(caro z r)))
((fresh (z)
(cdro li z)
(on-right l r z)))))
(define (next-to l r li)
(conde
((on-right l r li))
((on-right r l li))))
(define (zebra h)
(fresh (a b c d e)
(== h `(,a ,b ,c ,d ,e))
(fresh (w x y z) (== a `(norwegian ,w ,x ,y ,z)))
(fresh (w x y z) (== c `(,w ,x milk ,y ,z)))
(fresh (x y z) (membero `(englishman ,x ,y ,z red) h))
(fresh (x y z) (membero `(,x kools ,y ,z yellow) h))
(fresh (x y z) (membero `(spaniard ,x ,y dog ,z) h))
(fresh (x y z) (membero `(,x ,y coffee ,z green) h))
(fresh (x y z) (membero `(ukrainian ,x tea ,y ,z) h))
(fresh (x y z) (membero `(,x luckystrikes oj ,y ,z) h))
(fresh (x y z) (membero `(japanese parliaments ,x ,y ,z) h))
(fresh (x y z) (membero `(,x oldgolds ,y snails ,z) h))
(fresh (s t u v w x y z) (on-right `(,s ,t ,u ,v ivory) `(,w ,x ,y ,z green) h))
(fresh (s t u v w x y z) (next-to `(norwegian ,s ,t ,u ,v) `(,w ,x ,y ,z blue) h))
(fresh (s t u v w x y z) (next-to `(,s ,t ,u horse ,v) `(,w kools ,x ,y ,z) h))
(fresh (s t u v w x y z) (next-to `(,s ,t ,u fox ,v) `(,w chesterfields ,x ,y ,z) h))
(fresh (w x y z) (membero `(,w ,x water ,y ,z) h))
(fresh (w x y z) (membero `(,w ,x ,y zebra ,z) h))))
; Main program
(let* ((s (run 1 (h) (zebra h))))
(for-each
(lambda (x)
(begin (display x) (newline)))
(car s)))
|
