Permalink
Browse files

* src/main/clojure/clj/core/logic/macros.clj: zebrao runs!

  • Loading branch information...
1 parent bdf6ba0 commit a516fd632499c9797a745b9ff2696633904cc782 David Nolen committed Mar 25, 2012
Showing with 35 additions and 3 deletions.
  1. +2 −2 src/main/clojure/clj/core/logic/macros.clj
  2. +33 −1 src/test/cljs/cljs/core/logic/tests.cljs
@@ -8,7 +8,7 @@
"Constructs a sequence from 2 or more arguments, with the last argument as the tail.
The tail is improper if the last argument is a logic variable."
([f s] `(cljs.core.logic/lcons ~f ~s))
- ([f s & rest] `(cljs.core.logic/lcons ~f (cljs.core.logic/llist ~s ~@rest))))
+ ([f s & rest] `(cljs.core.logic/lcons ~f (llist ~s ~@rest))))
(defn bind-conde-clause [a]
(fn [g-rest]
@@ -239,7 +239,7 @@
(defn p->term [p]
(cond
- (= p '_) `(lvar)
+ (= p '_) `(cljs.core.logic/lvar)
(lcons-p? p) (p->llist p)
(and (coll? p)
(not= (first p) 'quote)) (cond
@@ -653,7 +653,7 @@
(fresh []
(conde
[f2 (conde
- [f2]
+ [f2]
[(m/== false false)])]
[(m/== false false)])))
@@ -795,4 +795,36 @@
(m/== p [a b c d])))
()))
+;; =============================================================================
+;; zebrao
+
+(defne righto [x y l]
+ ([_ _ [x y . r]])
+ ([_ _ [_ . r]] (righto x y r)))
+
+(defn nexto [x y l]
+ (conde
+ [(righto x y l)]
+ [(righto y x l)]))
+
+(defn zebrao [hs]
+ (all
+ (m/== [(lvar) (lvar) [(lvar) (lvar) 'milk (lvar) (lvar)] (lvar) (lvar)] hs)
+ (firsto hs ['norwegian (lvar) (lvar) (lvar) (lvar)])
+ (nexto ['norwegian (lvar) (lvar) (lvar) (lvar)] [(lvar) (lvar) (lvar) (lvar) 'blue] hs)
+ (righto [(lvar) (lvar) (lvar) (lvar) 'ivory] [(lvar) (lvar) (lvar) (lvar) 'green] hs)
+ (membero ['englishman (lvar) (lvar) (lvar) 'red] hs)
+ (membero [(lvar) 'kools (lvar) (lvar) 'yellow] hs)
+ (membero ['spaniard (lvar) (lvar) 'dog (lvar)] hs)
+ (membero [(lvar) (lvar) 'coffee (lvar) 'green] hs)
+ (membero ['ukrainian (lvar) 'tea (lvar) (lvar)] hs)
+ (membero [(lvar) 'lucky-strikes 'oj (lvar) (lvar)] hs)
+ (membero ['japanese 'parliaments (lvar) (lvar) (lvar)] hs)
+ (membero [(lvar) 'oldgolds (lvar) 'snails (lvar)] hs)
+ (nexto [(lvar) (lvar) (lvar) 'horse (lvar)] [(lvar) 'kools (lvar) (lvar) (lvar)] hs)
+ (nexto [(lvar) (lvar) (lvar) 'fox (lvar)] [(lvar) 'chesterfields (lvar) (lvar) (lvar)] hs)))
+
+(println (pr-str (run 1 [q] (zebrao q))))
+(time (run 1 [q] (zebrao q)))
+
(println "ok")

0 comments on commit a516fd6

Please sign in to comment.