1 files changed, 54 insertions, 0 deletions
diff --git a/scheme/zebra.scm b/scheme/zebra.scm
new file mode 100644
index 0000000..9ba0fea
--- /dev/null
+++ b/scheme/zebra.scm
@@ -0,0 +1,54 @@
+
+; Equivalent to example/zebra.adb
+
+
+(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))))
+
+
+(define (run-zebra args)
+  (let* ((s (run 1 (h) (zebra h))))
+    (for-each
+      (lambda (x)
+        (begin (display x) (newline)))
+      (car s))))
+
+