treec should take a constriant which checks every node, not just leaves

clojure · Feb 27, 2013 · 374a8f4 · 374a8f4
1 parent 756771a
commit 374a8f4
Show file tree

Hide file tree

Showing 2 changed files with 21 additions and 14 deletions.
diff --git a/src/main/clojure/clojure/core/logic.clj b/src/main/clojure/clojure/core/logic.clj
@@ -2727,8 +2727,10 @@
   (fixc x
     (fn loop [t a reifier]
       (if (tree-term? t)
-        (constrain-tree t
-          (fn [t a] ((fixc t loop reifier) a)))
+        (composeg*
+          (fc t)
+          (constrain-tree t
+            (fn [t a] ((fixc t loop reifier) a))))
         (fc t)))
     reifier))
 

diff --git a/src/test/clojure/clojure/core/logic/tests.clj b/src/test/clojure/clojure/core/logic/tests.clj
@@ -2861,50 +2861,55 @@
 ;; =============================================================================
 ;; Deep Constraints
 
+(defn is-number? [x]
+  (if-not (tree-term? x)
+    (number? x)
+    true))
+
 (deftest test-treec-1
   (is (= (run* [q]
-           (treec q #(predc % number?) `number?)
+           (treec q #(predc % is-number?) 'is-number?)
            (fresh [x y]
              (== q [x [2 3 y]])
              (== x 1)))
-         '(([1 [2 3 _0]] :- (clojure.core.logic/fixc _0 clojure.core/number?)))))
+         '(([1 [2 3 _0]] :- (clojure.core.logic/fixc _0 is-number?)))))
   (is (= (run* [q]
-           (treec q #(predc % number?) `number?)
+           (treec q #(predc % is-number?) 'is-number?)
            (fresh [x y]
              (== q [x [2 3 y]])
              (== x 1)
              (== y 'foo)))
          ()))
   (is (= (run* [q]
-           (treec q #(predc % number?) `number?)
+           (treec q #(predc % is-number?) 'is-number?)
            (fresh [z]
              (== q {:x {:y z}})))
-         '(({:x {:y _0}} :- (clojure.core.logic/fixc _0 clojure.core/number?)))))
+         '(({:x {:y _0}} :- (clojure.core.logic/fixc _0 is-number?)))))
   (is (= (run* [q]
-           (treec q #(predc % number?) `number?)
+           (treec q #(predc % is-number?) 'is-number?)
            (fresh [z]
              (== q {:x {:y z}})
              (== z 1)))
          '({:x {:y 1}})))
   (is (= (run* [q]
-           (treec q #(predc % number?) `number?)
+           (treec q #(predc % is-number?) 'is-number?)
            (fresh [z]
              (== q {:x {:y z}})
              (== z 'foo)))
          ()))
   (is (= (run* [q]
-           (treec q #(predc % number?) `number?)
+           (treec q #(predc % is-number?) 'is-number?)
            (fresh [x]
              (== q (llist 1 2 x))))
-         [[(llist 1 2 '_0) ':- '(clojure.core.logic/fixc _0 clojure.core/number?)]]))
+         [[(llist 1 2 '_0) ':- '(clojure.core.logic/fixc _0 is-number?)]]))
   (is (= (run* [q]
-           (treec q #(predc % number?) `number?)
+           (treec q #(predc % is-number?) 'is-number?)
            (fresh [x]
              (== q (llist 1 2 x))
              (== x '(3))))
          '((1 2 3))))
   (is (= (run* [q]
-           (treec q #(predc % number?) `number?)
+           (treec q #(predc % is-number?) 'is-number?)
            (fresh [x]
              (== q (llist 1 2 x))
              (== x '(foo))))
@@ -2913,7 +2918,7 @@
 (deftest test-treec-custom-reify-1
   (is (= (run* [q]
            (fresh [x]
-             (treec q #(predc % number?)
+             (treec q #(predc % is-number?)
                (fn [c _ v r a]
                  `(~'hashc ~v ~(-reify a x r))))))
          '((_0 :- (hashc _0 _1))))))