Fixed lousy representation for adorned predicates

7 files changed, 89 insertions, 53 deletions

diff --git a/src/clojure/contrib/datalog/literals.clj b/src/clojure/contrib/datalog/literals.clj
index 337106aa..0da3f2bc 100644
--- a/src/clojure/contrib/datalog/literals.clj
+++ b/src/clojure/contrib/datalog/literals.clj
@@ -261,7 +261,7 @@
         bnds (intersection (literal-columns l) bound)]
     (if (empty? bound)
       l
-      (assoc l :predicate [pred bnds]))))
+      (assoc l :predicate {:pred pred :bound bnds}))))
 
 (defmethod adorned-literal ::conditional
   [l bound]
@@ -271,15 +271,13 @@
 (defn get-adorned-bindings
   "Get the bindings from this adorned literal."
   [pred]
-  (if (vector? pred)
-    (last pred)
-    nil))
+  (:bound pred))
 
 (defn get-base-predicate
   "Get the base predicate from this predicate."
   [pred]
-  (if (vector? pred)
-    (first pred)
+  (if (map? pred)
+    (:pred pred)
     pred))
 
 
@@ -290,18 +288,17 @@
   [l]
   (assert (-> l :literal-type (isa? ::literal)))
   (let [pred (literal-predicate l)
-        base-pred (get-base-predicate pred)
+        pred-map (if (map? pred) pred {:pred pred})
         bound (get-adorned-bindings pred)
         ntb (select-keys (:term-bindings l) bound)]
-    (assoc l :predicate [base-pred :magic bound]  :term-bindings ntb :literal-type ::literal)))
+    (assoc l :predicate (assoc pred-map :magic true) :term-bindings ntb :literal-type ::literal)))
 
 (defn literal-magic?
   "Is this literal magic?"
   [lit]
   (let [pred (literal-predicate lit)]
-    (when (and (vector? pred)
-               (> (count pred) 1))
-      (= (pred 1) :magic))))
+    (when (map? pred)
+      (:magic pred))))
       
 (defn build-seed-bindings
   "Given a seed literal, already adorned and in magic form, convert
@@ -310,6 +307,24 @@
   (assert (-> s :literal-type (isa? ::literal)))
   (let [ntbs (map-values (fn [_] (gensym '?_gen_)) (:term-bindings s))]
     (assoc s :term-bindings ntbs)))
+
+
+;;; Semi-naive support
+
+(defn negated-literal
+  "Given a literal l, return a negated version"
+  [l]
+  (assert (-> l :literal-type (= ::literal)))
+  (conj l :literal-type ::negated))
+
+;(defn delta-literal
+;  "Given a literal l, return a delta version"
+;  [l]
+;  (let [pred (:predicate l)]
+;    (if (vector? pred)
+;      (assoc l :predicate (
+    
+
         
 ;;; Database operations
 
diff --git a/src/clojure/contrib/datalog/magic.clj b/src/clojure/contrib/datalog/magic.clj
index f4d75588..72d8865b 100644
--- a/src/clojure/contrib/datalog/magic.clj
+++ b/src/clojure/contrib/datalog/magic.clj
@@ -57,6 +57,7 @@
                 new-needed (reduce add-preds remaining new-adorned-rules)]
             (recur new-nrs new-needed))))))
 
+
 ;;; Magic !
 
 (defn seed-relation
diff --git a/src/clojure/contrib/datalog/seminaive.clj b/src/clojure/contrib/datalog/seminaive.clj
index 9c8d69e8..3b23d7d4 100644
--- a/src/clojure/contrib/datalog/seminaive.clj
+++ b/src/clojure/contrib/datalog/seminaive.clj
@@ -38,6 +38,12 @@
         head-negated (negated-literal head)
         delta-head (delta-literal head)
         body (:body r)
+        build-body (fn [left lit right]
+                     (assoc r :head delta-head
+                              :body (concat left
+                                            [(delta-literal lit)]
+                                            right
+                                            [head-negated])))
         new-rules (loop [lit (first body)
                         left []
                         right (next body)
@@ -45,12 +51,7 @@
                    (if (nil? lit)
                      results
                      (let [new-results (if (i-preds lit)
-                                         (conj results
-                                               (assoc r :head delta-head
-                                                      :body (concat left
-                                                                    [(delta-literal lit)]
-                                                                    right
-                                                                    [head-negated])))
+                                         (conj results (build-body left lit right))
                                          results)]
                        (recur (first right)
                               (conj left lit)
diff --git a/src/clojure/contrib/datalog/tests/test_literals.clj b/src/clojure/contrib/datalog/tests/test_literals.clj
index 3ce64279..107a4dc6 100644
--- a/src/clojure/contrib/datalog/tests/test_literals.clj
+++ b/src/clojure/contrib/datalog/tests/test_literals.clj
@@ -95,9 +95,9 @@
 
 (deftest test-adorned-literal
   (is (= (literal-predicate (adorned-literal pl #{:x}))
-         [:fred #{:x}]))
+         {:pred :fred :bound #{:x}}))
   (is (= (literal-predicate (adorned-literal nl #{:x :y :q}))
-         [:fred #{:x :y}]))
+         {:pred :fred :bound #{:x :y}}))
   (is (= (:term-bindings (adorned-literal nl #{:x}))
          {:x '?x :y '?y :z 3}))
   (is (= (adorned-literal cl #{})
@@ -117,12 +117,17 @@
 
 (deftest test-magic-literal
   (is (= (magic-literal pl)
-         {:predicate [:fred :magic nil], :term-bindings {}, :literal-type :clojure.contrib.datalog.literals/literal}))
+         {:predicate {:pred :fred :magic true}, :term-bindings {}, :literal-type :clojure.contrib.datalog.literals/literal}))
   (is (= (magic-literal (adorned-literal pl #{:x}))
-         {:predicate [:fred :magic #{:x}],
+         {:predicate {:pred :fred :magic true :bound #{:x}},
           :term-bindings {:x '?x},
           :literal-type :clojure.contrib.datalog.literals/literal})))
 
+(comment
+  (use 'clojure.contrib.stacktrace) (e)
+  (use :reload 'clojure.contrib.datalog.literals)
+)
+
 
 (def db1 (make-database
            (relation :fred [:x :y])
@@ -151,7 +156,7 @@
          [{'?x 3 '?y 1}])))
          
 (deftest test-project-literal
-  (is (= ((project-literal db2 lit4 [{'?x 1 '?y 3}{'?x 4 '?y 2}]) [:joan #{:x}])
+  (is (= ((project-literal db2 lit4 [{'?x 1 '?y 3}{'?x 4 '?y 2}]) {:pred :joan :bound #{:x}})
          (datalog-relation
           ;; Schema
           #{:y :x}
diff --git a/src/clojure/contrib/datalog/tests/test_magic.clj b/src/clojure/contrib/datalog/tests/test_magic.clj
index 9fbbf741..b790475f 100644
--- a/src/clojure/contrib/datalog/tests/test_magic.clj
+++ b/src/clojure/contrib/datalog/tests/test_magic.clj
@@ -33,10 +33,11 @@
 (deftest test-adorn-rules-set
   (is (= ars
          (rules-set
-          (<- ([:p #{:x}] :y ?y :x ?x) ([:e #{:x}] :y ?y :x ?x))
-          (<- ([:p #{:x}] :y ?y :x ?x) ([:e #{:x}] :y ?z :x ?x) ([:p #{:x}] :y ?y :x ?z))
-          (<- ([:e #{:x}] :y ?y :x ?y) (:c :y ?y :x ?x))
-          (<- ([:e #{:x}] :y ?y :x ?x) (:b :y ?y :x ?x))))))
+          (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :e :bound #{:x}} :y ?y :x ?x))
+          (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :e :bound #{:x}} :y ?z :x ?x)
+                                                    ({:pred :p :bound #{:x}} :y ?y :x ?z))
+          (<- ({:pred :e :bound #{:x}} :y ?y :x ?y) (:c :y ?y :x ?x))
+          (<- ({:pred :e :bound #{:x}} :y ?y :x ?x) (:b :y ?y :x ?x))))))
 
 
 (def m (magic-transform ars))
@@ -44,12 +45,21 @@
 (deftest test-magic-transform
   (is (= m
          (rules-set
-          (<- ([:e #{:x}] :y ?y :x ?y) ([:e :magic #{:x}] :x ?y) (:c :y ?y :x ?x))
-          (<- ([:e #{:x}] :y ?y :x ?x) ([:e :magic #{:x}] :x ?x) (:b :y ?y :x ?x))
-          (<- ([:p :magic #{:x}] :x ?z) ([:p :magic #{:x}] :x ?x) ([:e #{:x}] :y ?z :x ?x))
-          (<- ([:p #{:x}] :y ?y :x ?x) ([:p :magic #{:x}] :x ?x) ([:e #{:x}] :y ?z :x ?x) ([:p #{:x}] :y ?y :x ?z))
-          (<- ([:e :magic #{:x}] :x ?x) ([:p :magic #{:x}] :x ?x))
-          (<- ([:p #{:x}] :y ?y :x ?x) ([:p :magic #{:x}] :x ?x) ([:e #{:x}] :y ?y :x ?x))))))
+          (<- ({:pred :e :bound #{:x}} :y ?y :x ?y) ({:pred :e :magic true :bound #{:x}} :x ?y) (:c :y ?y :x ?x))
+
+          (<- ({:pred :e :bound #{:x}} :y ?y :x ?x) ({:pred :e :magic true :bound #{:x}} :x ?x) (:b :y ?y :x ?x))
+
+          (<- ({:pred :p :magic true :bound #{:x}} :x ?z) ({:pred :p :magic true :bound #{:x}} :x ?x)
+                                                          ({:pred :e :bound #{:x}} :y ?z :x ?x))
+
+          (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)
+                                                    ({:pred :e :bound #{:x}} :y ?z :x ?x)
+                                                    ({:pred :p :bound #{:x}} :y ?y :x ?z))
+
+          (<- ({:pred :e :magic true :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x))
+
+          (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)
+                                                    ({:pred :e :bound #{:x}} :y ?y :x ?x))))))
 
 
 
diff --git a/src/clojure/contrib/datalog/tests/test_rules.clj b/src/clojure/contrib/datalog/tests/test_rules.clj
index 96e83d22..a42ad757 100644
--- a/src/clojure/contrib/datalog/tests/test_rules.clj
+++ b/src/clojure/contrib/datalog/tests/test_rules.clj
@@ -38,20 +38,22 @@
 
 (deftest test-sip
   (is (= (compute-sip #{:x} #{:mary :sally} tr-1)
-         (<- ([:fred #{:x}] :x ?x :y ?y) ([:mary #{:x}] :z ?z :x ?x) ([:sally #{:z}] :y ?y :z ?z))))
+         (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y)
+                      ({:pred :mary :bound #{:x}} :z ?z :x ?x)
+                      ({:pred :sally :bound #{:z}} :y ?y :z ?z))))
 
   (is (= (compute-sip #{} #{:mary :sally} tr-1)
-         (<- (:fred :y ?y :x ?x) (:mary :z ?z :x ?x) ([:sally #{:z}] :y ?y :z ?z))))
+         (<- (:fred :y ?y :x ?x) (:mary :z ?z :x ?x) ({:pred :sally :bound #{:z}} :y ?y :z ?z))))
 
   (is (= (compute-sip #{} #{:mary} tr-2)
-         (<- (:fred) (not! [:mary #{:x}] :x 3))))
+         (<- (:fred) (not! {:pred :mary :bound #{:x}} :x 3))))
   
   (is (= (compute-sip #{} #{} tr-2)
          tr-2))
 
   (is (= (display-rule (compute-sip #{:x} #{:mary :sally} tr-3))
-         (display-rule (<- ([:fred #{:x}] :x ?x :y ?y)
-                               ([:mary #{:x}] :x ?x)
+         (display-rule (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y)
+                               ({:pred :mary :bound #{:x}} :x ?x)
                                (:sally :y ?y)
                                (if > ?x ?y))))))
                    ; Display rule is used because = does not work on
diff --git a/src/clojure/contrib/datalog/tests/test_softstrat.clj b/src/clojure/contrib/datalog/tests/test_softstrat.clj
index 512d7718..4132c102 100644
--- a/src/clojure/contrib/datalog/tests/test_softstrat.clj
+++ b/src/clojure/contrib/datalog/tests/test_softstrat.clj
@@ -34,31 +34,33 @@
 (deftest test-soft-stratification
   (let [soft (:stratification ws)
         q (:query ws)]
-    (is (= q (?- [:p #{:x}] :x 1)))
+    (is (= q (?- {:pred :p :bound #{:x}} :x 1)))
     (is (= (count soft) 4))
     (is (subset? (rules-set
-                  (<- ([:q #{:x}] :x ?x) ([:q :magic #{:x}] :x ?x) (:d :x ?x))
-                  (<- ([:q :magic #{:x}] :x ?x) ([:p :magic #{:x}] :x ?x)
-                                                (:b :z ?z :y ?y :x ?x)))
+                  (<- ({:pred :q :bound #{:x}} :x ?x) ({:pred :q :magic true :bound #{:x}} :x ?x)
+                                                      (:d :x ?x))
+
+                  (<- ({:pred :q :magic true :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)
+                                                                  (:b :z ?z :y ?y :x ?x)))
                  (nth soft 0)))
     (is (= (nth soft 1)
            (rules-set
-            (<- ([:q :magic #{:x}] :x ?y) ([:p :magic #{:x}] :x ?x)
-                                          (:b :z ?z :y ?y :x ?x)
-                                          (not! [:q #{:x}] :x ?x)))))
+            (<- ({:pred :q :magic true :bound #{:x}} :x ?y) ({:pred :p :magic true :bound #{:x}} :x ?x)
+                                                            (:b :z ?z :y ?y :x ?x)
+                                                            (not! {:pred :q :bound #{:x}} :x ?x)))))
     (is (= (nth soft 2)
            (rules-set
-            (<- ([:q :magic #{:x}] :x ?z) ([:p :magic #{:x}] :x ?x)
-                                          (:b :z ?z :y ?y :x ?x)
-                                          (not! [:q #{:x}] :x ?x)
-                                          (not! [:q #{:x}] :x ?y)))))
+            (<- ({:pred :q :magic true :bound #{:x}} :x ?z) ({:pred :p :magic true :bound #{:x}} :x ?x)
+                                                            (:b :z ?z :y ?y :x ?x)
+                                                            (not! {:pred :q :bound #{:x}} :x ?x)
+                                                            (not! {:pred :q :bound #{:x}} :x ?y)))))
     (is (= (nth soft 3)
            (rules-set
-            (<- ([:p #{:x}] :x ?x) ([:p :magic #{:x}] :x ?x)
-                                   (:b :z ?z :y ?y :x ?x)
-                                   (not! [:q #{:x}] :x ?x)
-                                   (not! [:q #{:x}] :x ?y)
-                                   (not! [:q #{:x}] :x ?z)))))))
+            (<- ({:pred :p :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)
+                                                (:b :z ?z :y ?y :x ?x)
+                                                (not! {:pred :q :bound #{:x}} :x ?x)
+                                                (not! {:pred :q :bound #{:x}} :x ?y)
+                                                (not! {:pred :q :bound #{:x}} :x ?z)))))))
 
 
 (def tdb-1