Added datalog

15 files changed, 2171 insertions, 0 deletions

diff --git a/src/clojure/contrib/datalog.clj b/src/clojure/contrib/datalog.clj
new file mode 100644
index 00000000..b72381b7
--- /dev/null
+++ b/src/clojure/contrib/datalog.clj
@@ -0,0 +1,61 @@
+;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
+;;  distribution terms for this software are covered by the Eclipse Public
+;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
+;;  be found in the file epl-v10.html at the root of this distribution.  By
+;;  using this software in any fashion, you are agreeing to be bound by the
+;;  terms of this license.  You must not remove this notice, or any other,
+;;  from this software.
+;;
+;;  datalog.clj
+;;
+;;  A Clojure implementation of Datalog
+;;
+;;  straszheimjeffrey (gmail)
+;;  Created 2 March 2009
+
+
+;;; Please see the example.clj file in the datalog folder
+
+
+(ns clojure.contrib.datalog
+  (:use clojure.contrib.datalog.rules
+        clojure.contrib.datalog.softstrat
+        clojure.contrib.datalog.database)
+  (:use [clojure.set :only (intersection)]
+        [clojure.contrib.except :only (throwf)]))
+
+(defstruct work-plan
+  :work-plan        ; The underlying structure
+  :rules            ; The original rules
+  :query            ; The original query
+  :work-plan-type)  ; The type of plan
+
+(defn- validate-work-plan
+  "Ensure any top level semantics are not violated"
+  [work-plan database]
+  (let [common-relations (-> work-plan :rules (intersection (-> database keys set)))]
+    (when (-> common-relations
+              empty?
+              not)
+      (throwf "The rules and database define the same relation(s): %s" common-relations))))
+  ; More will follow
+
+(defn build-work-plan
+  "Given a list of rules and a query, build a work plan that can be
+   used to execute the query."
+  [rules query]
+  (struct-map work-plan
+    :work-plan (build-soft-strat-work-plan rules query)
+    :rules rules
+    :query query
+    :work-plan-type ::soft-stratified))
+
+(defn run-work-plan
+  "Given a work plan, a database, and some query bindings, run the
+   work plan and return the results."
+  [work-plan database query-bindings]
+  (validate-work-plan work-plan database)
+  (evaluate-soft-work-set (:work-plan work-plan) database query-bindings))
+
+
+;; End of file
diff --git a/src/clojure/contrib/datalog/database.clj b/src/clojure/contrib/datalog/database.clj
new file mode 100644
index 00000000..8fef6524
--- /dev/null
+++ b/src/clojure/contrib/datalog/database.clj
@@ -0,0 +1,253 @@
+;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
+;;  distribution terms for this software are covered by the Eclipse Public
+;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
+;;  be found in the file epl-v10.html at the root of this distribution.  By
+;;  using this software in any fashion, you are agreeing to be bound by the
+;;  terms of this license.  You must not remove this notice, or any other,
+;;  from this software.
+;;
+;;  database.clj
+;;
+;;  A Clojure implementation of Datalog -- Support for in-memory database
+;;
+;;  straszheimjeffrey (gmail)
+;;  Created 21 Feburary 2009
+
+
+(ns clojure.contrib.datalog.database
+  (:use clojure.contrib.datalog.util)
+  (:use clojure.contrib.def)
+  (:use [clojure.set :only (union intersection difference)])
+  (:use [clojure.contrib.except :only (throwf)]))
+
+
+(defstruct relation
+  :schema           ; A set of key names
+  :data             ; A set of tuples
+  :indexes)         ; A map key names to indexes (in turn a map of value to tuples)
+
+
+;;; DDL
+
+(defmethod print-method ::datalog-database
+  [db #^Writer writer]
+  (binding [*out* writer]
+    (do
+      (println "(datalog-database")
+      (println "{")
+      (doseq [key (keys db)]
+        (println)
+        (println key)
+        (print-method (db key) writer))
+      (println "})"))))
+
+(defn datalog-database
+  [rels]
+  (with-meta rels {:type ::datalog-database}))
+
+(def empty-database (datalog-database {}))
+
+(defmethod print-method ::datalog-relation
+  [rel #^Writer writer]
+  (binding [*out* writer]
+    (do
+      (println "(datalog-relation")
+      (println " ;; Schema")
+      (println " " (:schema rel))
+      (println)
+      (println " ;; Data")
+      (println " #{")
+      (doseq [tuple (:data rel)]
+        (println "  " tuple))
+      (println " }")
+      (println)
+      (println " ;; Indexes")
+      (println "  {")
+      (doseq [key (-> rel :indexes keys)]
+        (println "  " key)
+        (println "    {")
+        (doseq [val (keys ((:indexes rel) key))]
+          (println "      " val)
+          (println "        " (get-in rel [:indexes key val])))
+        (println "    }"))
+      (println "  })"))))
+
+(defn datalog-relation
+  "Creates a relation"
+  [schema data indexes]
+  (with-meta (struct relation schema data indexes) {:type ::datalog-relation}))
+
+(defn add-relation
+  "Adds a relation to the database"
+  [db name keys]
+  (assoc db name (datalog-relation (set keys) #{} {})))
+
+(defn add-index
+  "Adds an index to an empty relation named name"
+  [db name key]
+  (assert (empty? (:data (db name))))
+  (let [rel (db name)
+        inx (assoc (:indexes rel) key {})]
+    (assoc db name (datalog-relation (:schema rel)
+                                     (:data rel)
+                                     inx))))
+
+(defn ensure-relation
+  "If the database lacks the named relation, add it"
+  [db name keys indexes]
+  (if-let [rel (db name)]
+    (do
+      (assert (= (:schema rel) (set keys)))
+      db)
+    (let [db1 (add-relation db name keys)]
+      (reduce (fn [db key] (add-index db name key))
+              db1
+              indexes))))
+    
+
+(defmacro make-database
+  "Makes a database, like this
+   (make-database
+     (relation :fred [:mary :sue])
+     (index :fred :mary)
+     (relation :sally [:jen :becky])
+     (index :sally :jen)
+     (index :sally :becky))"
+  [& commands]
+  (let [wrapper (fn [cur new]
+                  (let [cmd (first new)
+                        body (next new)]
+                    (assert (= 2 (count body)))
+                    (cond
+                     (= cmd 'relation)
+                       `(add-relation ~cur ~(first body) ~(fnext body))
+                     (= cmd 'index)
+                       `(add-index ~cur ~(first body) ~(fnext body))
+                     :otherwise (throwf "%s not recognized" new))))]
+    (reduce wrapper `empty-database commands)))
+
+(defn get-relation
+  "Get a relation object by name"
+  [db rel-name]
+  (db rel-name))
+
+(defn replace-relation
+  "Add or replace a fully constructed relation object to the database."
+  [db rel-name rel]
+  (assoc db rel-name rel))
+
+
+;;; DML
+
+
+(defn database-counts
+  "Returns a map with the count of elements in each relation."
+  [db]
+  (map-values #(-> % :data count) db))
+
+(defn- add-to-indexes
+  "Adds the tuple to the appropriate keys in the index map"
+  [idxs tuple]
+  (into {} (for [ik (keys idxs)]
+             (let [im (idxs ik)
+                   iv (tuple ik)
+                   os (get im iv #{})]
+               [ik (assoc im iv (conj os tuple))]))))
+
+(defn add-tuple
+  "Two forms:
+
+   [db relation-name tuple] adds tuple to the named relation.  Returns
+   the new database.
+
+   [rel tuple] adds to the relation object.  Returns the new relation."
+  ([db rel-name tuple]
+     (assert (= (-> tuple keys set) (-> rel-name db :schema)))
+     (assoc db rel-name (add-tuple (db rel-name) tuple)))
+  ([rel tuple]
+     (let [data (:data rel)
+           new-data (conj data tuple)]
+       (if (identical? data new-data) ; optimization hack!
+         rel
+         (let [idxs (add-to-indexes (:indexes rel) tuple)]
+           (assoc rel :data (conj (:data rel) tuple) :indexes idxs))))))
+
+(defn add-tuples
+  "Adds a collection of tuples to the db, as
+   (add-tuples db
+      [:rel-name :key-1 1 :key-2 2]
+      [:rel-name :key-1 2 :key-2 3])"
+  [db & tupls]
+  (reduce #(add-tuple %1 (first %2) (apply hash-map (next %2))) db tupls))
+
+(defn- find-indexes
+  "Given a map of indexes and a partial tuple, return the sets of full tuples"
+  [idxs pt]
+  (if (empty? idxs)
+    nil
+    (filter identity (for [key (keys pt)]
+                       (if-let [idx-map (idxs key)]
+                         (idx-map (pt key))
+                         nil)))))
+
+(defn- match?
+  "Is m2 contained in m1?"
+  [m1 m2]
+  (let [compare (fn [key]
+                  (and (contains? m1 key)
+                       (= (m1 key) (m2 key))))]
+  (every? compare (keys m2))))
+
+(defn- scan-space
+  "Computes a stream of tuples from relation rn matching partial tuple (pt)
+   and applies fun to each"
+  [fun db rn pt]
+  (let [rel (db rn)
+        idxs (find-indexes (:indexes rel) pt)
+        space (if (empty? idxs)
+                (:data rel) ; table scan :(
+                (reduce intersection idxs))]
+    (fun #(match? % pt) space)))
+    
+(defn select
+  "finds all matching tuples to the partial tuple (pt) in the relation named (rn)"
+  [db rn pt]
+;  (println "  DB Lookup: " rn pt)
+  (scan-space filter db rn pt))
+
+(defn any-match?
+  "Finds if there are any matching records for the partial tuple"
+  [db rn pt]
+  (if (= (-> pt keys set) (:schema (db rn)))
+    (contains? (:data (db rn)) pt)
+    (scan-space some db rn pt)))
+
+
+;;; Merge
+
+(defn merge-indexes
+  [idx1 idx2]
+  (merge-with (fn [h1 h2] (merge-with union h1 h2)) idx1 idx2))
+  
+(defn merge-relations
+  "Merges two relations"
+  [r1 r2]
+  (assert (= (:schema r1) (:schema r2)))
+  (let [merged-indexes (merge-indexes (:indexes r1)
+                                      (:indexes r2))
+        merged-data (union (:data r1)
+                           (:data r2))]
+    (assoc r1 :data merged-data :indexes merged-indexes)))
+    
+(defn database-merge
+  "Merges databases together"
+  [dbs]
+  (apply merge-with merge-relations dbs))
+
+(defn database-merge-parallel
+  "Merges databases together in parallel"
+  [dbs]
+  (preduce merge-relations dbs))
+
+
+;; End of file
diff --git a/src/clojure/contrib/datalog/example.clj b/src/clojure/contrib/datalog/example.clj
new file mode 100644
index 00000000..afc37bb4
--- /dev/null
+++ b/src/clojure/contrib/datalog/example.clj
@@ -0,0 +1,112 @@
+;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
+;;  distribution terms for this software are covered by the Eclipse Public
+;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
+;;  be found in the file epl-v10.html at the root of this distribution.  By
+;;  using this software in any fashion, you are agreeing to be bound by the
+;;  terms of this license.  You must not remove this notice, or any other,
+;;  from this software.
+;;
+;;  example.clj
+;;
+;;  A Clojure implementation of Datalog - Example
+;;
+;;  straszheimjeffrey (gmail)
+;;  Created 2 March 2009
+
+
+(ns clojure.contrib.datalog.example
+  (:use [clojure.contrib.datalog :only (build-work-plan run-work-plan)]
+        [clojure.contrib.datalog.rules :only (<- ?- rules-set)]
+        [clojure.contrib.datalog.database :only (make-database add-tuples)]
+        [clojure.contrib.datalog.util :only (*trace-datalog*)]))
+
+
+
+
+(def db-base
+     (make-database
+      (relation :employee [:id :name :position])
+      (index :employee :name)
+
+      (relation :boss [:employee-id :boss-id])
+      (index :boss :employee-id)
+
+      (relation :can-do-job [:position :job])
+      (index :can-do-job :position)
+
+      (relation :job-replacement [:job :can-be-done-by])
+
+      (relation :job-exceptions [:id :job])))
+
+(def db
+     (add-tuples db-base
+           [:employee :id 1  :name "Bob"    :position :boss]
+           [:employee :id 2  :name "Mary"   :position :chief-accountant]
+           [:employee :id 3  :name "John"   :position :accountant]
+           [:employee :id 4  :name "Sameer" :position :chief-programmer]
+           [:employee :id 5  :name "Lilian" :position :programmer]
+           [:employee :id 6  :name "Li"     :position :technician]
+           [:employee :id 7  :name "Fred"   :position :sales]
+           [:employee :id 8  :name "Brenda" :position :sales]
+           [:employee :id 9  :name "Miki"   :position :project-management]
+           [:employee :id 10 :name "Albert" :position :technician]
+           
+           [:boss :employee-id 2  :boss-id 1]
+           [:boss :employee-id 3  :boss-id 2]
+           [:boss :employee-id 4  :boss-id 1]
+           [:boss :employee-id 5  :boss-id 4]
+           [:boss :employee-id 6  :boss-id 4]
+           [:boss :employee-id 7  :boss-id 1]
+           [:boss :employee-id 8  :boss-id 7]
+           [:boss :employee-id 9  :boss-id 1]
+           [:boss :employee-id 10 :boss-id 6]
+
+           [:can-do-job :position :boss               :job :management]
+           [:can-do-job :position :accountant         :job :accounting]
+           [:can-do-job :position :chief-accountant   :job :accounting]
+           [:can-do-job :position :programmer         :job :programming]
+           [:can-do-job :position :chief-programmer   :job :programming]           
+           [:can-do-job :position :technician         :job :server-support]
+           [:can-do-job :position :sales              :job :sales]
+           [:can-do-job :position :project-management :job :project-management]
+
+           [:job-replacement :job :pc-support :can-be-done-by :server-support]
+           [:job-replacement :job :pc-support :can-be-done-by :programming]
+           [:job-replacement :job :payroll    :can-be-done-by :accounting]
+
+           [:job-exceptions :id 4 :job :pc-support]))
+
+(def rules
+     (rules-set
+        (<- (:works-for :employee ?x :boss ?y) (:boss :employee-id ?e-id :boss-id ?b-id)
+                                               (:employee :id ?e-id :name ?x)
+                                               (:employee :id ?b-id :name ?y))
+        (<- (:works-for :employee ?x :boss ?y) (:works-for :employee ?x :boss ?z)
+                                               (:works-for :employee ?z :boss ?y))
+        (<- (:employee-job* :employee ?x :job ?y) (:employee :name ?x :position ?pos)
+                                                  (:can-do-job :position ?pos :job ?y))
+        (<- (:employee-job* :employee ?x :job ?y) (:job-replacement :job ?y :can-be-done-by ?z)
+                                                  (:employee-job* :employee ?x  :job ?z))
+        (<- (:employee-job* :employee ?x :job ?y) (:can-do-job :job ?y)
+                                                  (:employee :name ?x :position ?z)
+                                                  (if = ?z :boss))
+        (<- (:employee-job :employee ?x :job ?y) (:employee-job* :employee ?x :job ?y)
+                                                 (:employee :id ?id :name ?x)
+                                                 (not! :job-exceptions :id ?id :job ?y))
+        (<- (:bj :name ?x :boss ?y) (:works-for :employee ?x :boss ?y)
+                                    (not! :employee-job :employee ?y :job :pc-support))))
+
+
+
+(def wp-1 (build-work-plan rules (?- :works-for :employee '??name :boss ?x)))
+(run-work-plan wp-1 db {'??name "Albert"})
+
+(def wp-2 (build-work-plan rules (?- :employee-job :employee '??name :job ?x)))
+(binding [*trace-datalog* true]
+  (run-work-plan wp-2 db {'??name "Li"}))
+
+(def wp-3 (build-work-plan rules (?- :bj :name '??name :boss ?x)))
+(run-work-plan wp-3 db {'??name "Albert"})
+
+
+;; End of file
diff --git a/src/clojure/contrib/datalog/literals.clj b/src/clojure/contrib/datalog/literals.clj
new file mode 100644
index 00000000..337106aa
--- /dev/null
+++ b/src/clojure/contrib/datalog/literals.clj
@@ -0,0 +1,400 @@
+;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
+;;  distribution terms for this software are covered by the Eclipse Public
+;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
+;;  be found in the file epl-v10.html at the root of this distribution.  By
+;;  using this software in any fashion, you are agreeing to be bound by the
+;;  terms of this license.  You must not remove this notice, or any other,
+;;  from this software.
+;;
+;;  literals.clj
+;;
+;;  A Clojure implementation of Datalog -- Literals
+;;
+;;  straszheimjeffrey (gmail)
+;;  Created 25 Feburary 2009
+
+
+(ns clojure.contrib.datalog.literals
+  (:use clojure.contrib.datalog.util)
+  (:use clojure.contrib.datalog.database)
+  (:use [clojure.set :only (intersection)])
+  (:use [clojure.contrib.set :only (subset?)])
+  (:use [clojure.contrib.seq-utils :only (flatten)]))
+
+
+;;; Type Definitions
+
+(defstruct atomic-literal
+  :predicate              ; The predicate name
+  :term-bindings          ; A map of column names to bindings
+  :literal-type)          ; ::literal or ::negated
+
+(derive ::negated ::literal)
+
+(defstruct conditional-literal
+  :fun                    ; The fun to call
+  :symbol                 ; The fun symbol (for display)
+  :terms                  ; The formal arguments
+  :literal-type)          ; ::conditional
+
+
+;;; Basics
+
+
+(defmulti literal-predicate
+  "Return the predicate/relation this conditional operates over"
+  :literal-type)
+
+(defmulti literal-columns
+  "Return the column names this applies to"
+  :literal-type)
+
+(defmulti literal-vars
+  "Returns the logic vars used by this literal"
+  :literal-type)
+
+(defmulti positive-vars
+  "Returns the logic vars used in a positive position"
+  :literal-type)
+
+(defmulti negative-vars
+  "Returns the logic vars used in a negative position"
+  :literal-type)
+
+(defmethod literal-predicate ::literal
+  [l]
+  (:predicate l))
+
+(defmethod literal-predicate ::conditional
+  [l]
+  nil)
+
+(defmethod literal-columns ::literal
+  [l]
+  (-> l :term-bindings keys set))
+
+(defmethod literal-columns ::conditional
+  [l]
+  nil)
+
+(defmethod literal-vars ::literal
+  [l]
+  (set (filter is-var? (-> l :term-bindings vals))))
+
+(defmethod literal-vars ::conditional
+  [l]
+  (set (filter is-var? (:terms l))))
+
+(defmethod positive-vars ::literal
+  [l]
+  (literal-vars l))
+
+(defmethod positive-vars ::negated
+  [l]
+  nil)
+
+(defmethod positive-vars ::conditional
+  [l]
+  nil)
+
+(defmethod negative-vars ::literal
+  [l]
+  nil)
+
+(defmethod negative-vars ::negated
+  [l]
+  (literal-vars l))
+
+(defmethod negative-vars ::conditional
+  [l]
+  (literal-vars l))
+
+(defn negated?
+  "Is this literal a negated literal?"
+  [l]
+  (= (:literal-type l) ::negated))
+
+(defn positive?
+  "Is this a positive literal?"
+  [l]
+  (= (:literal-type l) ::literal))
+
+
+;;; Building Literals
+
+(def negation-symbol 'not!)
+(def conditional-symbol 'if)
+
+(defmulti build-literal
+  "(Returns an unevaluated expression (to be used in macros) of a
+   literal."
+  first)
+
+(defn build-atom
+  "Returns an unevaluated expression (to be used in a macro) of an
+   atom."
+  [f type]
+  (let [p (first f)
+        ts (map #(if (is-var? %) `(quote ~%) %) (next f))
+        b (if (seq ts) (apply assoc {} ts) nil)]
+    `(struct atomic-literal ~p ~b ~type)))
+
+(defmethod build-literal :default
+  [f]
+  (build-atom f ::literal))
+
+(defmethod build-literal negation-symbol
+  [f]
+  (build-atom (rest f) ::negated))
+
+(defmethod build-literal conditional-symbol
+  [f]
+  (let [symbol (fnext f)
+        terms (nnext f)
+        fun `(fn [binds#] (apply ~symbol binds#))]
+    `(struct conditional-literal
+             ~fun
+             '~symbol
+             '~terms
+             ::conditional)))
+
+
+;;; Display
+
+(defmulti display-literal
+  "Converts a struct representing a literal to a normal list"
+  :literal-type)
+
+(defn- display
+  [l]
+  (conj (-> l :term-bindings list* flatten) (literal-predicate l)))
+
+(defmethod display-literal ::literal
+  [l]
+  (display l))
+
+(defmethod display-literal ::negated
+  [l]
+  (conj (display l) negation-symbol))
+
+(defmethod display-literal ::conditional
+  [l]
+  (list* conditional-symbol (:symbol l) (:terms l)))
+
+
+;;; Sip computation
+
+(defmulti get-vs-from-cs
+  "From a set of columns, return the vars"
+  :literal-type)
+
+(defmethod get-vs-from-cs ::literal
+  [l bound]
+  (set (filter is-var?
+               (vals (select-keys (:term-bindings l)
+                                  bound)))))
+
+(defmethod get-vs-from-cs ::conditional
+  [l bound]
+  nil)
+
+
+(defmulti get-cs-from-vs
+  "From a set of vars, get the columns"
+  :literal-type)
+
+(defmethod get-cs-from-vs ::literal
+  [l bound]
+  (reduce conj
+          #{}
+          (remove nil? 
+                  (map (fn [[k v]] (if (bound v) k nil))
+                       (:term-bindings l)))))
+
+(defmethod get-cs-from-vs ::conditional
+  [l bound]
+  nil)
+
+
+(defmulti get-self-bound-cs
+  "Get the columns that are bound withing the literal."
+  :literal-type)
+
+(defmethod get-self-bound-cs ::literal
+  [l]
+  (reduce conj
+          #{}
+          (remove nil?
+                  (map (fn [[k v]] (if (not (is-var? v)) k nil))
+                       (:term-bindings l)))))
+
+(defmethod get-self-bound-cs ::conditional
+  [l]
+  nil)
+
+
+(defmulti literal-appropriate?
+  "When passed a set of bound vars, determines if this literal can be
+   used during this point of a SIP computation."
+  (fn [b l] (:literal-type l)))
+
+(defmethod literal-appropriate? ::literal
+  [bound l]
+  (not (empty? (intersection (literal-vars l) bound))))
+
+(defmethod literal-appropriate? ::negated
+  [bound l]
+  (subset? (literal-vars l) bound))
+
+(defmethod literal-appropriate? ::conditional
+  [bound l]
+  (subset? (literal-vars l) bound))
+
+
+(defmulti adorned-literal
+  "When passed a set of bound columns, returns the adorned literal"
+  (fn [l b] (:literal-type l)))
+
+(defmethod adorned-literal ::literal
+  [l bound]
+  (let [pred (literal-predicate l)
+        bnds (intersection (literal-columns l) bound)]
+    (if (empty? bound)
+      l
+      (assoc l :predicate [pred bnds]))))
+
+(defmethod adorned-literal ::conditional
+  [l bound]
+  l)
+
+
+(defn get-adorned-bindings
+  "Get the bindings from this adorned literal."
+  [pred]
+  (if (vector? pred)
+    (last pred)
+    nil))
+
+(defn get-base-predicate
+  "Get the base predicate from this predicate."
+  [pred]
+  (if (vector? pred)
+    (first pred)
+    pred))
+
+
+;;; Magic Stuff
+
+(defn magic-literal
+  "Create a magic version of this adorned predicate."
+  [l]
+  (assert (-> l :literal-type (isa? ::literal)))
+  (let [pred (literal-predicate l)
+        base-pred (get-base-predicate 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)))
+
+(defn literal-magic?
+  "Is this literal magic?"
+  [lit]
+  (let [pred (literal-predicate lit)]
+    (when (and (vector? pred)
+               (> (count pred) 1))
+      (= (pred 1) :magic))))
+      
+(defn build-seed-bindings
+  "Given a seed literal, already adorned and in magic form, convert
+   its bound constants to new variables."
+  [s]
+  (assert (-> s :literal-type (isa? ::literal)))
+  (let [ntbs (map-values (fn [_] (gensym '?_gen_)) (:term-bindings s))]
+    (assoc s :term-bindings ntbs)))
+        
+;;; Database operations
+
+(defn- build-partial-tuple
+  [lit binds]
+  (let [tbs (:term-bindings lit)
+        each (fn [[key val :as pair]]
+               (if (is-var? val)
+                 (if-let [n (binds val)]
+                   [key n]
+                   nil)
+                 pair))]
+    (into {} (remove nil? (map each tbs)))))
+
+(defn- project-onto-literal
+  "Given a literal, and a materialized tuple, return a set of variable
+   bindings."
+  [lit tuple]
+  (let [step (fn [binds [key val]]
+               (if (and (is-var? val)
+                        (contains? tuple key))
+                 (assoc binds val (tuple key))
+                 binds))]
+    (reduce step {} (:term-bindings lit))))
+  
+
+(defn- join-literal*
+  [db lit bs fun]
+  (let [each (fn [binds]
+               (let [pt (build-partial-tuple lit binds)]
+                 (fun binds pt)))]
+    (when (contains? db (literal-predicate lit))
+      (apply concat (map each bs)))))
+
+(defmulti join-literal
+  "Given a database (db), a literal (lit) and a seq of bindings (bs),
+   return a new seq of bindings by joining this literal."
+  (fn [db lit bs] (:literal-type lit)))
+
+(defmethod join-literal ::literal
+  [db lit bs]
+  (join-literal* db lit bs (fn [binds pt]
+                             (map #(merge binds %)
+                                  (map (partial project-onto-literal lit)
+                                       (select db (literal-predicate lit) pt))))))
+
+(defmethod join-literal ::negated
+  [db lit bs]
+  (join-literal* db lit bs (fn [binds pt]
+                             (if (any-match? db (literal-predicate lit) pt)
+                               nil
+                               [binds]))))
+
+(defmethod join-literal ::conditional
+  [db lit bs]
+  (let [each (fn [binds]
+               (let [resolve (fn [term]
+                               (if (is-var? term)
+                                 (binds term)
+                                 term))
+                     args (map resolve (:terms lit))]
+                 (if ((:fun lit) args)
+                   binds
+                   nil)))]
+    (remove nil? (map each bs))))
+                 
+(defn project-literal
+  "Project a stream of bindings onto a literal/relation. Returns a new
+   db."
+  ([db lit bs] (project-literal db lit bs is-var?))
+  ([db lit bs var?]
+     (assert (= (:literal-type lit) ::literal))
+     (let [rel-name (literal-predicate lit)
+           columns (-> lit :term-bindings keys)
+           idxs (vec (get-adorned-bindings (literal-predicate lit)))
+           db1 (ensure-relation db rel-name columns idxs)
+           rel (get-relation db1 rel-name)
+           step (fn [rel bindings]
+                  (let [step (fn [t [k v]]
+                               (if (var? v)
+                                 (assoc t k (bindings v))
+                                 (assoc t k v)))
+                        tuple (reduce step {} (:term-bindings lit))]
+                    (add-tuple rel tuple)))]
+       (replace-relation db rel-name (reduce step rel bs)))))
+
+
+;; End of file
diff --git a/src/clojure/contrib/datalog/magic.clj b/src/clojure/contrib/datalog/magic.clj
new file mode 100644
index 00000000..f4d75588
--- /dev/null
+++ b/src/clojure/contrib/datalog/magic.clj
@@ -0,0 +1,115 @@
+;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
+;;  distribution terms for this software are covered by the Eclipse Public
+;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
+;;  be found in the file epl-v10.html at the root of this distribution.  By
+;;  using this software in any fashion, you are agreeing to be bound by the
+;;  terms of this license.  You must not remove this notice, or any other,
+;;  from this software.
+;;
+;;  magic.clj
+;;
+;;  A Clojure implementation of Datalog -- Magic Sets
+;;
+;;  straszheimjeffrey (gmail)
+;;  Created 18 Feburary 2009
+
+
+(ns clojure.contrib.datalog.magic
+  (:use clojure.contrib.datalog.util
+        clojure.contrib.datalog.literals
+        clojure.contrib.datalog.rules)
+  (:use [clojure.set :only (union intersection difference)]))
+
+
+;;; Adornment
+
+(defn adorn-query
+  "Adorn a query"
+  [q]
+  (adorned-literal q (get-self-bound-cs q)))
+
+(defn adorn-rules-set
+  "Adorns the given rules-set for the given query.  (rs) is a
+   rules-set, (q) is an adorned query."
+  [rs q]
+  (let [i-preds (all-predicates rs)
+        p-map (predicate-map rs)]
+    (loop [nrs empty-rules-set ; The rules set being built
+           needed #{(literal-predicate q)}]
+      (if (empty? needed)
+          nrs
+          (let [pred (first needed)
+                remaining (disj needed pred)
+                base-pred (get-base-predicate pred)
+                bindings (get-adorned-bindings pred)
+                new-rules (p-map base-pred)
+                new-adorned-rules (map (partial compute-sip bindings i-preds)
+                                       new-rules)
+                new-nrs (reduce conj nrs new-adorned-rules)
+                current-preds (all-predicates new-nrs)
+                not-needed? (fn [pred]
+                              (or (current-preds pred)
+                                  (-> pred get-base-predicate i-preds not)))
+                add-pred (fn [np pred]
+                           (if (not-needed? pred) np (conj np pred)))
+                add-preds (fn [np rule]
+                            (reduce add-pred np (map literal-predicate (:body rule))))
+                new-needed (reduce add-preds remaining new-adorned-rules)]
+            (recur new-nrs new-needed))))))
+
+;;; Magic !
+
+(defn seed-relation
+  "Given a magic form of a query, give back the literal form of its seed
+   relation"
+  [q]
+  (let [pred (-> q literal-predicate get-base-predicate)
+        bnds (-> q literal-predicate get-adorned-bindings)]
+    (with-meta (assoc q :predicate [pred :magic-seed bnds]) {})))
+
+(defn seed-rule
+  "Given an adorned query, give back its seed rule"
+  [q]
+  (let [mq (build-seed-bindings (magic-literal q))
+        sr (seed-relation mq)]
+    (build-rule mq [sr])))
+
+(defn seed-predicate-for-insertion
+  "Given a query, return the predicate to use for database insertion."
+  [q]
+  (let [seed (-> q seed-rule :body first)
+        columns (-> seed :term-bindings keys)
+        new-term-bindings (-> q :term-bindings (select-keys columns))]
+    (assoc seed :term-bindings new-term-bindings)))
+    
+(defn magic-transform
+  "Return a magic transformation of an adorned rules-set (rs).  The
+   (i-preds) are the predicates of the intension database.  These
+   default to the predicates within the rules-set."
+  ([rs]
+     (magic-transform rs (all-predicates rs)))
+  ([rs i-preds]
+     (let [not-duplicate? (fn [l mh bd]
+                            (or (not (empty? bd))
+                                (not (= (magic-literal l)
+                                        mh))))
+           xr (fn [rs rule]
+                (let [head (:head rule)
+                      body (:body rule)
+                      mh (magic-literal head)
+                      answer-rule (build-rule head
+                                              (concat [mh] body))
+                      step (fn [[rs bd] l]
+                             (if (and (i-preds (literal-predicate l))
+                                      (not-duplicate? l mh bd))
+                               (let [nr (build-rule (magic-literal l)
+                                                    (concat [mh] bd))]
+                                 [(conj rs nr) (conj bd l)])
+                               [rs (conj bd l)]))
+                      [nrs _] (reduce step [rs []] body)]
+                  (conj nrs answer-rule)))]
+     (reduce xr empty-rules-set rs))))
+             
+         
+
+;; End of file
diff --git a/src/clojure/contrib/datalog/rules.clj b/src/clojure/contrib/datalog/rules.clj
new file mode 100644
index 00000000..9e58115d
--- /dev/null
+++ b/src/clojure/contrib/datalog/rules.clj
@@ -0,0 +1,202 @@
+;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
+;;  distribution terms for this software are covered by the Eclipse Public
+;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
+;;  be found in the file epl-v10.html at the root of this distribution.  By
+;;  using this software in any fashion, you are agreeing to be bound by the
+;;  terms of this license.  You must not remove this notice, or any other,
+;;  from this software.
+;;
+;;  rules.clj
+;;
+;;  A Clojure implementation of Datalog -- Rules Engine
+;;
+;;  straszheimjeffrey (gmail)
+;;  Created 2 Feburary 2009
+
+
+(ns clojure.contrib.datalog.rules
+  (use clojure.contrib.datalog.util)
+  (use clojure.contrib.datalog.literals
+       clojure.contrib.datalog.database)
+  (use [clojure.set :only (union intersection difference)])
+  (use [clojure.contrib.set :only (subset?)])
+  (use [clojure.contrib.except :only (throwf)]))
+
+
+(defstruct datalog-rule
+  :head
+  :body)
+
+(defn display-rule
+  "Return the rule in a readable format."
+  [rule]
+  (list* '<-
+         (-> rule :head display-literal)
+         (map display-literal (:body rule))))
+
+(defn display-query
+  "Return a query in a readable format."
+  [query]
+  (list* '?- (display-literal query)))
+
+
+;;; Check rule safety
+
+(defn is-safe?
+  "Is the rule safe according to the datalog protocol?"
+  [rule]
+  (let [hv (literal-vars (:head rule))
+        bpv (apply union (map positive-vars (:body rule)))
+        bnv (apply union (map negative-vars (:body rule)))
+        ehv (difference hv bpv)
+        env (difference bnv bpv)]
+    (when-not (empty? ehv)
+      (throwf "Head vars %s not bound in body in rule %s" ehv rule))
+    (when-not (empty? env)
+      (throwf "Body vars %s not bound in negative positions in rule %s" env rule))
+    rule))
+
+
+;;; Rule creation and printing
+
+(defn build-rule
+  [hd bd]
+  (with-meta (struct datalog-rule hd bd) {:type ::datalog-rule}))
+
+(defmacro <-
+  "Build a datalog rule.  Like this:
+
+   (<- (:head :x ?x :y ?y) (:body-1 :x ?x :y ?y) (:body-2 :z ?z) (not! :body-3 :x ?x) (if > ?y ?z))"
+  [hd & body]
+  (let [head (build-atom hd :clojure.contrib.datalog.literals/literal)
+        body (map build-literal body)]
+    `(is-safe? (build-rule ~head [~@body]))))
+
+(defmethod print-method ::datalog-rule
+  [rule #^Writer writer]
+  (print-method (display-rule rule) writer))
+
+(defn return-rule-data
+  "Returns an untypted rule that will be fully printed"
+  [rule]
+  (with-meta rule {}))
+
+(defmacro ?-
+  "Define a datalog query"
+  [& q]
+  (let [qq (build-atom q :clojure.contrib.datalog.literals/literal)]
+  `(with-meta ~qq {:type ::datalog-query})))
+
+(defmethod print-method ::datalog-query
+  [query #^Writer writer]
+  (print-method (display-query query) writer))
+
+
+
+;;; SIP
+
+(defn compute-sip
+  "Given a set of bound column names, return an adorned sip for this
+   rule.  A set of intensional predicates should be provided to
+   determine what should be adorned."
+  [bindings i-preds rule]
+  (let [next-lit (fn [bv body]
+                   (or (first (drop-while
+                               #(not (literal-appropriate? bv %))
+                               body))
+                       (first (drop-while (complement positive?) body))))
+        adorn (fn [lit bvs]
+                (if (i-preds (literal-predicate lit))
+                  (let [bnds (union (get-cs-from-vs lit bvs)
+                                    (get-self-bound-cs lit))]
+                    (adorned-literal lit bnds))
+                  lit))
+        new-h (adorned-literal (:head rule) bindings)]
+    (loop [bound-vars (get-vs-from-cs (:head rule) bindings)
+           body (:body rule)
+           sip []]
+      (if-let [next (next-lit bound-vars body)]
+        (recur (union bound-vars (literal-vars next))
+               (remove #(= % next) body)
+               (conj sip (adorn next bound-vars)))
+        (build-rule new-h (concat sip body))))))
+
+
+;;; Rule sets
+
+(defn make-rules-set
+  "Given an existing set of rules, make it a 'rules-set' for
+   printing."
+  [rs]
+  (with-meta rs {:type ::datalog-rules-set}))
+    
+(def empty-rules-set (make-rules-set #{}))
+
+(defn rules-set
+  "Given a collection of rules return a rules set"
+  [& rules]
+  (reduce conj empty-rules-set rules))
+  
+(defmethod print-method ::datalog-rules-set
+  [rules #^Writer writer]
+  (binding [*out* writer]
+    (do
+      (print "(rules-set")
+      (doseq [rule rules]
+        (println)
+        (print "   ")
+        (print rule))
+      (println ")"))))
+
+(defn predicate-map
+  "Given a rules-set, return a map of rules keyed by their predicates.
+   Each value will be a set of rules."
+  [rs]
+  (let [add-rule (fn [m r]
+                   (let [pred (-> r :head literal-predicate)
+                         os (get m pred #{})]
+                     (assoc m pred (conj os r))))]
+    (reduce add-rule {} rs)))
+
+(defn all-predicates
+  "Given a rules-set, return all defined predicates"
+  [rs]
+  (set (map literal-predicate (map :head rs))))
+
+(defn non-base-rules
+  "Return a collection of rules that depend, somehow, on other rules"
+  [rs]
+  (let [pred (all-predicates rs)
+        non-base (fn [r]
+                   (if (some #(pred %)
+                             (map literal-predicate (:body r)))
+                     r
+                     nil))]
+    (remove nil? (map non-base rs))))
+
+
+;;; Database operations
+
+(def empty-bindings [{}])
+
+(defn apply-rule
+  "Apply the rule against db-1, adding the results to the appropriate
+   relation in db-2.  The relation will be created if needed."
+  ([db rule] (apply-rule db db rule))
+  ([db-1 db-2 rule]
+     (trace-datalog (println)
+                    (println)
+                    (println "--------------- Begin Rule ---------------")
+                    (println rule))
+     (let [head (:head rule)
+           body (:body rule)
+           step (fn [bs lit]
+                  (trace-datalog (println bs)
+                                 (println lit))
+                  (join-literal db-1 lit bs))
+           bs (reduce step empty-bindings body)]
+       (do (trace-datalog (println bs))
+           (project-literal db-2 head bs)))))
+
+
+;; End of file
\ No newline at end of file
diff --git a/src/clojure/contrib/datalog/softstrat.clj b/src/clojure/contrib/datalog/softstrat.clj
new file mode 100644
index 00000000..f23bf50f
--- /dev/null
+++ b/src/clojure/contrib/datalog/softstrat.clj
@@ -0,0 +1,174 @@
+;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
+;;  distribution terms for this software are covered by the Eclipse Public
+;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
+;;  be found in the file epl-v10.html at the root of this distribution.  By
+;;  using this software in any fashion, you are agreeing to be bound by the
+;;  terms of this license.  You must not remove this notice, or any other,
+;;  from this software.
+;;
+;;  softstrat.clj
+;;
+;;  A Clojure implementation of Datalog -- Soft Stratification
+;;
+;;  straszheimjeffrey (gmail)
+;;  Created 28 Feburary 2009
+
+
+(ns clojure.contrib.datalog.softstrat
+  (:use clojure.contrib.datalog.util
+        clojure.contrib.datalog.database
+        clojure.contrib.datalog.literals
+        clojure.contrib.datalog.rules
+        clojure.contrib.datalog.magic)
+  (:use [clojure.set :only (union intersection difference)])
+  (:use [clojure.contrib.seq-utils :only (indexed)])
+  (:require [clojure.contrib.graph :as graph]))
+
+
+;;; Dependency graph
+
+(defn- build-rules-graph
+  "Given a rules-set (rs), build a graph where each predicate symbol in rs,
+   there is a node n, and for each rule (<- h b-1 b-2 ...), there are edges
+   from the (literal-predicate h) -> (literal-predicate b-*), one for each
+   b-*."
+  [rs]
+  (let [preds (all-predicates rs)
+        pred-map (predicate-map rs)
+        step (fn [nbs pred]
+               (let [rules (pred-map pred)
+                     preds (reduce (fn [pds lits]
+                                     (reduce (fn [pds lit]
+                                               (conj pds (literal-predicate lit)))
+                                               pds
+                                               lits))
+                                   #{}
+                                   (map :body rules))]
+                 (assoc nbs pred preds)))
+        neighbors (reduce step {} preds)]
+    (struct graph/directed-graph preds neighbors)))
+
+(defn- build-def
+  "Given a rules-set, build its def function"
+  [rs]
+  (let [pred-map (predicate-map rs)
+        graph (-> rs
+                  build-rules-graph
+                  graph/transitive-closure
+                  graph/add-loops)]
+    (fn [pred]
+      (apply union (map set (map pred-map (graph/get-neighbors graph pred)))))))
+
+
+;;; Soft Stratificattion REQ Graph                 
+
+(defn- req
+  "Returns a rules-set that is a superset of req(lit) for the lit at
+  index lit-index"
+  [rs soft-def rule lit-index]
+  (let [head (:head rule)
+        body (:body rule)
+        lit (nth body lit-index)
+        pre (subvec (vec body) 0 lit-index)]
+    (conj (-> lit literal-predicate soft-def (magic-transform (all-predicates rs)))
+          (build-rule (magic-literal lit) pre))))
+
+(defn- rule-dep
+  "Given a rule, return the set of rules it depends on."
+  [rs mrs soft-def rule]
+  (let [step (fn [nrs [idx lit]]
+               (if (negated? lit)
+                 (union nrs (req rs soft-def rule idx))
+                 nrs))]
+    (intersection mrs
+                  (reduce step empty-rules-set (-> rule :body indexed)))))
+
+(defn- soft-strat-graph
+  "The dependency graph for soft stratification."
+  [rs mrs]
+  (let [soft-def (build-def rs)
+        step (fn [nbrs rule]
+               (assoc nbrs rule (rule-dep rs mrs soft-def rule)))
+        nbrs (reduce step {} mrs)]
+    (struct graph/directed-graph mrs nbrs)))
+
+(defn- build-soft-strat
+  "Given a rules-set (unadorned) and an adorned query, return the soft
+   stratified list.  The rules will be magic transformed, and the
+   magic seed will be appended."
+  [rs q]
+  (let [ars (adorn-rules-set rs q)
+        mrs (conj (magic-transform ars)
+                  (seed-rule q))
+        gr (soft-strat-graph ars mrs)]
+    (map make-rules-set (graph/dependency-list gr))))
+        
+
+;;; Work plan
+
+(defstruct soft-strat-work-plan
+  :query
+  :stratification)
+
+(defn build-soft-strat-work-plan
+  "Return a work plan for the given rules-set and query"
+  [rs q]
+  (let [aq (adorn-query q)]
+    (struct soft-strat-work-plan aq (build-soft-strat rs aq))))
+
+(defn get-all-relations
+  "Return a set of all relation names defined in this workplan"
+  [ws]
+  (apply union (map all-predicates (:stratification ws))))
+
+
+;;; Evaluate
+
+(defn- apply-rules-set
+  [db rs]
+  (reduce (fn [rdb rule]
+            (apply-rule db rdb rule)) db rs))
+
+(defn- weak-consq-operator
+  [db strat]
+  (trace-datalog (println)
+                 (println)
+                 (println "=============== Begin iteration ==============="))
+  (let [counts (database-counts db)]
+    (loop [strat strat]
+      (let [rs (first strat)]
+        (if rs
+          (let [new-db (apply-rules-set db rs)]
+            (if (= counts (database-counts new-db))
+              (recur (next strat))
+              new-db))
+          db)))))
+
+(defn- build-partial-tuple
+  [q bindings]
+  (into {} (remove nil? (map (fn [[k v :as pair]]
+                               (if (is-var? v)
+                                 nil
+                                 (if (is-query-var? v)
+                                   [k (bindings v)]
+                                   pair)))
+                             (:term-bindings q)))))
+
+(defn evaluate-soft-work-set
+  ([ws db] (evaluate-soft-work-set ws db {}))
+  ([ws db bindings]
+     (let [query (:query ws)
+           strat (:stratification ws)
+           seed (seed-predicate-for-insertion query)
+           seeded-db (project-literal db seed [bindings] is-query-var?)
+           fun (fn [data]
+                 (weak-consq-operator data strat))
+           equal (fn [db1 db2]
+                   (= (database-counts db1) (database-counts db2)))
+           new-db (graph/fixed-point seeded-db fun nil equal)
+           pt (build-partial-tuple query bindings)]
+       (select new-db (literal-predicate query) pt))))
+
+
+
+;; End of file
diff --git a/src/clojure/contrib/datalog/tests/test.clj b/src/clojure/contrib/datalog/tests/test.clj
new file mode 100644
index 00000000..101ce098
--- /dev/null
+++ b/src/clojure/contrib/datalog/tests/test.clj
@@ -0,0 +1,37 @@
+;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
+;;  distribution terms for this software are covered by the Eclipse Public
+;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
+;;  be found in the file epl-v10.html at the root of this distribution.  By
+;;  using this software in any fashion, you are agreeing to be bound by the
+;;  terms of this license.  You must not remove this notice, or any other,
+;;  from this software.
+;;
+;;  test.clj
+;;
+;;  A Clojure implementation of Datalog -- Tests
+;;
+;;  straszheimjeffrey (gmail)
+;;  Created 11 Feburary 2009
+
+(ns clojure.contrib.datalog.tests.test.clj
+  (:use clojure.contrib.test-is))
+
+(def tests [:test-util
+            :test-database
+            :test-literals
+            :test-rules
+            :test-magic
+            :test-softstrat])
+
+(defn test-name
+  [test]
+  (symbol (str "clojure.contrib.datalog.tests." (name test))))
+
+(doseq [test tests]
+  (require (test-name test)))
+
+(apply run-tests (map test-name tests))
+
+
+
+;; End of file
diff --git a/src/clojure/contrib/datalog/tests/test_database.clj b/src/clojure/contrib/datalog/tests/test_database.clj
new file mode 100644
index 00000000..527c8fae
--- /dev/null
+++ b/src/clojure/contrib/datalog/tests/test_database.clj
@@ -0,0 +1,75 @@
+;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
+;;  distribution terms for this software are covered by the Eclipse Public
+;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
+;;  be found in the file epl-v10.html at the root of this distribution.  By
+;;  using this software in any fashion, you are agreeing to be bound by the
+;;  terms of this license.  You must not remove this notice, or any other,
+;;  from this software.
+;;
+;;  test-database.clj
+;;
+;;  A Clojure implementation of Datalog -- Database
+;;
+;;  straszheimjeffrey (gmail)
+;;  Created 12 Feburary 2009
+
+
+(ns clojure.contrib.datalog.tests.test-database
+  (:use clojure.contrib.test-is
+	clojure.contrib.datalog.database))
+
+
+(def test-db
+     (make-database
+      (relation :fred [:mary :sue])
+      (index :fred :mary)
+      (relation :sally [:jen :becky :joan])
+      (index :sally :jen)
+      (index :sally :becky)))
+
+(deftest test-make-database
+  (is (= (-> test-db :fred :schema) #{:mary :sue}))
+  (is (= (-> test-db :sally :schema) #{:jen :becky :joan})))
+
+(deftest test-ensure-relation
+  (is (contains? (ensure-relation test-db :bob [:sam :george] [:sam]) :bob))
+  (is (contains? (ensure-relation test-db :fred [:mary :sue] [:mary]) :fred))
+  (is (thrown? Exception (ensure-relation test-db :fred [:bob :joe] []))))
+
+(deftest test-add-tuple
+  (let [new-db (add-tuple test-db :fred {:mary 1 :sue 2})]
+    (is (= (select new-db :fred {:mary 1}) [{:mary 1 :sue 2}])))
+  (is (thrown? Exception (add-tuple test-db :fred {:mary 1}))))
+
+
+(def test-db-1
+     (add-tuples test-db
+                 [:fred :mary 1 :sue 2]
+                 [:fred :mary 2 :sue 3]
+                 [:sally :jen 1 :becky 2 :joan 0]
+                 [:sally :jen 1 :becky 4 :joan 3]
+                 [:sally :jen 1 :becky 3 :joan 0]
+                 [:sally :jen 1 :becky 2 :joan 3]
+                 [:fred :mary 1 :sue 1]
+                 [:fred :mary 3 :sue 1]))
+
+(deftest test-select
+  (is (= (set (select test-db-1 :sally {:jen 1 :becky 2}))
+         #{{:jen 1 :joan 0 :becky 2} {:jen 1 :joan 3 :becky 2}}))
+  (is (= (set (select test-db-1 :fred {:sue 1})))
+      #{{:mary 3 :sue 1} {:mary 1 :sue 1}})
+  (is (empty? (select test-db-1 :sally {:joan 5 :jen 1}))))
+         
+(deftest test-any-match?
+  (is (any-match? test-db-1 :fred {:mary 3}))
+  (is (any-match? test-db-1 :sally {:jen 1 :becky 2 :joan 3}))
+  (is (not (any-match? test-db-1 :sally {:jen 5})))
+  (is (not (any-match? test-db-1 :fred {:mary 1 :sue 5}))))
+
+
+(comment
+  (run-tests)
+)
+
+;; End of file
+
diff --git a/src/clojure/contrib/datalog/tests/test_literals.clj b/src/clojure/contrib/datalog/tests/test_literals.clj
new file mode 100644
index 00000000..3ce64279
--- /dev/null
+++ b/src/clojure/contrib/datalog/tests/test_literals.clj
@@ -0,0 +1,182 @@
+;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
+;;  distribution terms for this software are covered by the Eclipse Public
+;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
+;;  be found in the file epl-v10.html at the root of this distribution.  By
+;;  using this software in any fashion, you are agreeing to be bound by the
+;;  terms of this license.  You must not remove this notice, or any other,
+;;  from this software.
+;;
+;;  test-literals.clj
+;;
+;;  A Clojure implementation of Datalog -- Literals tests
+;;
+;;  straszheimjeffrey (gmail)
+;;  Created 25 Feburary 2009
+
+
+(ns clojure.contrib.datalog.tests.test-literals
+  (:use clojure.contrib.test-is)
+  (:use clojure.contrib.datalog.literals
+        clojure.contrib.datalog.database))
+
+
+(def pl (eval (build-literal '(:fred :x ?x :y ?y :z 3))))
+(def nl (eval (build-literal '(not! :fred :x ?x :y ?y :z 3))))
+(def cl (eval (build-literal '(if > ?x 3))))
+
+(def bl (eval (build-literal '(:fred))))
+
+(def bns {:x '?x :y '?y :z 3})
+
+(deftest test-build-literal
+  (is (= (:predicate pl) :fred))
+  (is (= (:term-bindings pl) bns))
+  (is (= (:predicate nl) :fred))
+  (is (= (:term-bindings nl) bns))
+  (is (= (:symbol cl) '>))
+  (is (= (:terms cl) '(?x 3)))
+  (is ((:fun cl) [4 3]))
+  (is (not ((:fun cl) [2 4])))
+  (is (= (:predicate bl) :fred)))
+
+(deftest test-literal-predicate
+  (is (= (literal-predicate pl) :fred))
+  (is (= (literal-predicate nl) :fred))
+  (is (nil? (literal-predicate cl)))
+  (is (= (literal-predicate bl) :fred)))
+
+(deftest test-literal-columns
+  (is (= (literal-columns pl) #{:x :y :z}))
+  (is (= (literal-columns nl) #{:x :y :z}))
+  (is (nil? (literal-columns cl)))
+  (is (empty? (literal-columns bl))))
+
+(deftest test-literal-vars
+  (is (= (literal-vars pl) #{'?x '?y}))
+  (is (= (literal-vars nl) #{'?x '?y}))
+  (is (= (literal-vars cl) #{'?x}))
+  (is (empty? (literal-vars bl))))
+
+(deftest test-positive-vars
+  (is (= (positive-vars pl) (literal-vars pl)))
+  (is (nil? (positive-vars nl)))
+  (is (nil? (positive-vars cl)))
+  (is (empty? (positive-vars bl))))
+
+(deftest test-negative-vars
+  (is (nil? (negative-vars pl)))
+  (is (= (negative-vars nl) (literal-vars nl)))
+  (is (= (negative-vars cl) (literal-vars cl)))
+  (is (empty? (negative-vars bl))))
+
+(deftest test-negated?
+  (is (not (negated? pl)))
+  (is (negated? nl))
+  (is (not (negated? cl))))
+
+(deftest test-vs-from-cs
+  (is (= (get-vs-from-cs pl #{:x}) #{'?x}))
+  (is (empty? (get-vs-from-cs pl #{:z})))
+  (is (= (get-vs-from-cs pl #{:x :r}) #{'?x}))
+  (is (empty? (get-vs-from-cs pl #{}))))
+
+(deftest test-cs-from-vs
+  (is (= (get-cs-from-vs pl #{'?x}) #{:x}))
+  (is (= (get-cs-from-vs pl #{'?x '?r}) #{:x}))
+  (is (empty? (get-cs-from-vs pl #{}))))
+
+(deftest test-literal-appropriate?
+  (is (not (literal-appropriate? #{} pl)))
+  (is (literal-appropriate? #{'?x} pl))
+  (is (not (literal-appropriate? #{'?x} nl)))
+  (is (literal-appropriate? #{'?x '?y} nl))
+  (is (not (literal-appropriate? #{'?z} cl)))
+  (is (literal-appropriate? #{'?x} cl)))
+
+(deftest test-adorned-literal
+  (is (= (literal-predicate (adorned-literal pl #{:x}))
+         [:fred #{:x}]))
+  (is (= (literal-predicate (adorned-literal nl #{:x :y :q}))
+         [:fred #{:x :y}]))
+  (is (= (:term-bindings (adorned-literal nl #{:x}))
+         {:x '?x :y '?y :z 3}))
+  (is (= (adorned-literal cl #{})
+         cl)))
+
+(deftest test-get-adorned-bindings
+  (is (= (get-adorned-bindings (literal-predicate (adorned-literal pl #{:x})))
+         #{:x}))
+  (is (= (get-adorned-bindings (literal-predicate pl))
+         nil)))
+
+(deftest test-get-base-predicate
+  (is (= (get-base-predicate (literal-predicate (adorned-literal pl #{:x})))
+         :fred))
+  (is (= (get-base-predicate (literal-predicate pl))
+         :fred)))
+
+(deftest test-magic-literal
+  (is (= (magic-literal pl)
+         {:predicate [:fred :magic nil], :term-bindings {}, :literal-type :clojure.contrib.datalog.literals/literal}))
+  (is (= (magic-literal (adorned-literal pl #{:x}))
+         {:predicate [:fred :magic #{:x}],
+          :term-bindings {:x '?x},
+          :literal-type :clojure.contrib.datalog.literals/literal})))
+
+
+(def db1 (make-database
+           (relation :fred [:x :y])
+           (index :fred :x)
+           (relation :sally [:x])))
+
+(def db2 (add-tuples db1
+             [:fred :x 1 :y :mary]
+             [:fred :x 1 :y :becky]
+             [:fred :x 3 :y :sally]
+             [:fred :x 4 :y :joe]
+             [:sally :x 1]
+             [:sally :x 2]))
+
+(def lit1 (eval (build-literal '(:fred :x ?x :y ?y))))
+(def lit2 (eval (build-literal '(not! :fred :x ?x))))
+(def lit3 (eval (build-literal '(if > ?x ?y))))
+(def lit4 (adorned-literal (eval (build-literal '(:joan :x ?x :y ?y))) #{:x}))
+
+(deftest test-join-literal
+  (is (= (set (join-literal db2 lit1 [{'?x 1} {'?x 2} {'?x 3}]))
+         #{{'?x 1, '?y :mary} {'?x 1, '?y :becky} {'?x 3, '?y :sally}}))
+  (is (= (join-literal db2 lit2 [{'?x 1} {'?x 2} {'?x 3}])
+         [{'?x 2}]))
+  (is (= (join-literal db2 lit3 [{'?x 1 '?y 2} {'?x 3 '?y 1}])
+         [{'?x 3 '?y 1}])))
+         
+(deftest test-project-literal
+  (is (= ((project-literal db2 lit4 [{'?x 1 '?y 3}{'?x 4 '?y 2}]) [:joan #{:x}])
+         (datalog-relation
+          ;; Schema
+          #{:y :x}
+
+          ;; Data
+          #{
+            {:x 1, :y 3}
+            {:x 4, :y 2}
+            }
+          
+          ;; Indexes
+          {
+           :x
+           {
+            4
+            #{{:x 4, :y 2}}
+            1
+            #{{:x 1, :y 3}}
+            }
+           }))))
+
+
+
+(comment
+  (run-tests)
+)
+
+;; End of file
diff --git a/src/clojure/contrib/datalog/tests/test_magic.clj b/src/clojure/contrib/datalog/tests/test_magic.clj
new file mode 100644
index 00000000..9fbbf741
--- /dev/null
+++ b/src/clojure/contrib/datalog/tests/test_magic.clj
@@ -0,0 +1,62 @@
+;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
+;;  distribution terms for this software are covered by the Eclipse Public
+;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
+;;  be found in the file epl-v10.html at the root of this distribution.  By
+;;  using this software in any fashion, you are agreeing to be bound by the
+;;  terms of this license.  You must not remove this notice, or any other,
+;;  from this software.
+;;
+;;  test-magic.clj
+;;
+;;  A Clojure implementation of Datalog -- Magic Tests
+;;
+;;  straszheimjeffrey (gmail)
+;;  Created 18 Feburary 2009
+
+(ns clojure.contrib.datalog.tests.test-magic
+  (:use clojure.contrib.test-is)
+  (:use clojure.contrib.datalog.magic
+        clojure.contrib.datalog.rules))
+
+
+
+(def rs (rules-set
+             (<- (:p :x ?x :y ?y) (:e :x ?x :y ?y))
+             (<- (:p :x ?x :y ?y) (:e :x ?x :y ?z) (:p :x ?z :y ?y))
+             (<- (:e :x ?x :y ?y) (:b :x ?x :y ?y))
+             (<- (:e :x ?y :y ?y) (:c :x ?x :y ?y))))
+
+(def q (adorn-query (?- :p :x 1 :y ?y)))
+
+(def ars (adorn-rules-set rs q))
+
+(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))))))
+
+
+(def m (magic-transform ars))
+
+(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))))))
+
+
+
+
+(comment
+  (run-tests)
+)
+
+;; End of file
+
diff --git a/src/clojure/contrib/datalog/tests/test_rules.clj b/src/clojure/contrib/datalog/tests/test_rules.clj
new file mode 100644
index 00000000..96e83d22
--- /dev/null
+++ b/src/clojure/contrib/datalog/tests/test_rules.clj
@@ -0,0 +1,128 @@
+;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
+;;  distribution terms for this software are covered by the Eclipse Public
+;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
+;;  be found in the file epl-v10.html at the root of this distribution.  By
+;;  using this software in any fashion, you are agreeing to be bound by the
+;;  terms of this license.  You must not remove this notice, or any other,
+;;  from this software.
+;;
+;;  test-rules.clj
+;;
+;;  A Clojure implementation of Datalog -- Rule Tests
+;;
+;;  straszheimjeffrey (gmail)
+;;  Created 12 Feburary 2009
+
+
+(ns clojure.contrib.datalog.tests.test-rules
+  (:use clojure.contrib.test-is
+        clojure.contrib.datalog.rules
+        clojure.contrib.datalog.literals
+        clojure.contrib.datalog.database))
+
+
+(def tr-1 (<- (:fred :x ?x :y ?y) (:mary :x ?x :z ?z) (:sally :z ?z :y ?y)))
+(def tr-2 (<- (:fred) (not! :mary :x 3)))
+(def tr-3 (<- (:fred :x ?x :y ?y) (if > ?x ?y) (:mary :x ?x) (:sally :y ?y)))
+
+
+
+(deftest test-rule-safety
+  (is (thrown-with-msg? Exception #".*Head vars.*not bound.*"
+         (<- (:fred :x ?x) (:sally :y ?y))))
+  (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*"
+         (<- (:fred :x ?x) (:becky :x ?x) (not! :sally :y ?y))))
+  (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*"
+         (<- (:fred :x ?x) (:becky :x ?x) (if > ?x ?y)))))
+
+
+(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))))
+
+  (is (= (compute-sip #{} #{:mary :sally} tr-1)
+         (<- (:fred :y ?y :x ?x) (:mary :z ?z :x ?x) ([:sally #{:z}] :y ?y :z ?z))))
+
+  (is (= (compute-sip #{} #{:mary} tr-2)
+         (<- (:fred) (not! [:mary #{: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)
+                               (:sally :y ?y)
+                               (if > ?x ?y))))))
+                   ; Display rule is used because = does not work on
+                   ; (if > ?x ?y) because it contains a closure
+
+
+(def rs
+     (rules-set
+        (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y))
+        (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))
+        (<- (:edge :a ?x :b ?y) (:route :a ?x :b ?y) (if not= ?x ?y))))
+
+(deftest test-rules-set
+  (is (= (count rs) 3))
+  (is (contains? rs (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y)))))
+  
+(deftest test-predicate-map
+  (let [pm (predicate-map rs)]
+    (is (= (pm :path)
+           #{(<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y))
+             (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))}))
+    (is (= (-> :edge pm count) 1))))
+
+
+(def db1 (make-database
+           (relation :fred [:x :y])
+           (index :fred :x)
+           (relation :sally [:x])
+           (relation :ben [:y])))
+
+(def db2 (add-tuples db1
+             [:fred :x 1 :y :mary]
+             [:fred :x 1 :y :becky]
+             [:fred :x 3 :y :sally]
+             [:fred :x 4 :y :joe]
+             [:fred :x 4 :y :bob]
+             [:sally :x 1]
+             [:sally :x 2]
+             [:sally :x 3]
+             [:sally :x 4]
+             [:ben :y :bob]))
+
+
+(deftest test-apply-rule
+  (is (= (apply-rule db2 empty-database (<- (:becky :y ?y) (:sally :x ?x)
+                                                           (:fred :x ?x :y ?y)
+                                                           (not! :ben :y ?y)
+                                                           (if not= ?x 3)))
+         (datalog-database
+          {
+           :becky
+           (datalog-relation
+            ;; Schema
+            #{:y}
+            ;; Data
+            #{
+              {:y :joe}
+              {:y :mary}
+              {:y :becky}
+              }
+            ;; Indexes
+            {
+             })
+           }))))
+
+
+
+
+(comment
+  (run-tests)
+)
+
+;; End of file
+
diff --git a/src/clojure/contrib/datalog/tests/test_softstrat.clj b/src/clojure/contrib/datalog/tests/test_softstrat.clj
new file mode 100644
index 00000000..512d7718
--- /dev/null
+++ b/src/clojure/contrib/datalog/tests/test_softstrat.clj
@@ -0,0 +1,212 @@
+;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
+;;  distribution terms for this software are covered by the Eclipse Public
+;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
+;;  be found in the file epl-v10.html at the root of this distribution.  By
+;;  using this software in any fashion, you are agreeing to be bound by the
+;;  terms of this license.  You must not remove this notice, or any other,
+;;  from this software.
+;;
+;;  test-softstrat.clj
+;;
+;;  A Clojure implementation of Datalog -- Soft Stratification Tests
+;;
+;;  straszheimjeffrey (gmail)
+;;  Created 28 Feburary 2009
+
+(ns clojure.contrib.datalog.tests.test-softstrat
+  (:use clojure.contrib.test-is)
+  (:use clojure.contrib.datalog.softstrat
+        clojure.contrib.datalog.magic
+        clojure.contrib.datalog.rules
+        clojure.contrib.datalog.database)
+  (:use [clojure.contrib.set :only (subset?)]))
+
+
+
+(def rs1 (rules-set
+            (<- (:p :x ?x) (:b :x ?x :y ?y :z ?z) (not! :q :x ?x) (not! :q :x ?y) (not! :q :x ?z))
+            (<- (:q :x ?x) (:d :x ?x))))
+
+(def q1 (?- :p :x 1))
+
+(def ws (build-soft-strat-work-plan rs1 q1))
+
+(deftest test-soft-stratification
+  (let [soft (:stratification ws)
+        q (:query ws)]
+    (is (= q (?- [:p #{: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)))
+                 (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)))))
+    (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)))))
+    (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)))))))
+
+
+(def tdb-1
+     (make-database
+       (relation :b [:x :y :z])
+       (relation :d [:x])))
+
+(def tdb-2
+     (add-tuples tdb-1
+                 [:b :x 1 :y 2 :z 3]))
+
+(deftest test-tdb-2
+  (is (= (evaluate-soft-work-set ws tdb-2 {})
+         [{:x 1}])))
+
+
+
+(def tdb-3
+     (add-tuples tdb-2
+                 [:d :x 2]
+                 [:d :x 3]))
+
+(deftest test-tdb-3
+  (is (empty? (evaluate-soft-work-set ws tdb-3 {}))))
+         
+
+
+;;;;;;;;;;;
+
+
+
+(def db-base
+     (make-database
+      (relation :employee [:id :name :position])
+      (index :employee :name)
+
+      (relation :boss [:employee-id :boss-id])
+      (index :boss :employee-id)
+
+      (relation :can-do-job [:position :job])
+      (index :can-do-job :position)
+
+      (relation :job-replacement [:job :can-be-done-by])
+
+      (relation :job-exceptions [:id :job])))
+
+(def db
+     (add-tuples db-base
+           [:employee :id 1  :name "Bob"    :position :boss]
+           [:employee :id 2  :name "Mary"   :position :chief-accountant]
+           [:employee :id 3  :name "John"   :position :accountant]
+           [:employee :id 4  :name "Sameer" :position :chief-programmer]
+           [:employee :id 5  :name "Lilian" :position :programmer]
+           [:employee :id 6  :name "Li"     :position :technician]
+           [:employee :id 7  :name "Fred"   :position :sales]
+           [:employee :id 8  :name "Brenda" :position :sales]
+           [:employee :id 9  :name "Miki"   :position :project-management]
+           [:employee :id 10 :name "Albert" :position :technician]
+           
+           [:boss :employee-id 2  :boss-id 1]
+           [:boss :employee-id 3  :boss-id 2]
+           [:boss :employee-id 4  :boss-id 1]
+           [:boss :employee-id 5  :boss-id 4]
+           [:boss :employee-id 6  :boss-id 4]
+           [:boss :employee-id 7  :boss-id 1]
+           [:boss :employee-id 8  :boss-id 7]
+           [:boss :employee-id 9  :boss-id 1]
+           [:boss :employee-id 10 :boss-id 6]
+
+           [:can-do-job :position :boss               :job :management]
+           [:can-do-job :position :accountant         :job :accounting]
+           [:can-do-job :position :chief-accountant   :job :accounting]
+           [:can-do-job :position :programmer         :job :programming]
+           [:can-do-job :position :chief-programmer   :job :programming]           
+           [:can-do-job :position :technician         :job :server-support]
+           [:can-do-job :position :sales              :job :sales]
+           [:can-do-job :position :project-management :job :project-management]
+
+           [:job-replacement :job :pc-support :can-be-done-by :server-support]
+           [:job-replacement :job :pc-support :can-be-done-by :programming]
+           [:job-replacement :job :payroll    :can-be-done-by :accounting]
+
+           [:job-exceptions :id 4 :job :pc-support]))
+
+(def rules
+     (rules-set
+        (<- (:works-for :employee ?x :boss ?y) (:boss :employee-id ?e-id :boss-id ?b-id)
+                                               (:employee :id ?e-id :name ?x)
+                                               (:employee :id ?b-id :name ?y))
+        (<- (:works-for :employee ?x :boss ?y) (:works-for :employee ?x :boss ?z)
+                                               (:works-for :employee ?z :boss ?y))
+        (<- (:employee-job* :employee ?x :job ?y) (:employee :name ?x :position ?pos)
+                                                  (:can-do-job :position ?pos :job ?y))
+        (<- (:employee-job* :employee ?x :job ?y) (:job-replacement :job ?y :can-be-done-by ?z)
+                                                  (:employee-job* :employee ?x  :job ?z))
+        (<- (:employee-job* :employee ?x :job ?y) (:can-do-job :job ?y)
+                                                  (:employee :name ?x :position ?z)
+                                                  (if = ?z :boss))
+        (<- (:employee-job :employee ?x :job ?y) (:employee-job* :employee ?x :job ?y)
+                                                 (:employee :id ?id :name ?x)
+                                                 (not! :job-exceptions :id ?id :job ?y))
+        (<- (:bj :name ?x :boss ?y) (:works-for :employee ?x :boss ?y)
+                                    (not! :employee-job :employee ?y :job :pc-support))))
+
+
+(def ws-1 (build-soft-strat-work-plan rules (?- :works-for :employee '??name :boss ?x)))
+(defn evaluate-1 [name] (set (evaluate-soft-work-set ws-1 db {'??name name})))
+
+(deftest test-ws-1
+  (is (= (evaluate-1 "Albert")
+         #{{:employee "Albert", :boss "Li"}
+           {:employee "Albert", :boss "Sameer"}
+           {:employee "Albert", :boss "Bob"}}))
+  (is (empty? (evaluate-1 "Bob")))
+  (is (= (evaluate-1 "John")
+         #{{:employee "John", :boss "Bob"}
+           {:employee "John", :boss "Mary"}})))
+         
+
+(def ws-2 (build-soft-strat-work-plan rules (?- :employee-job :employee '??name :job ?x)))
+(defn evaluate-2 [name] (set (evaluate-soft-work-set ws-2 db {'??name name})))
+
+(deftest test-ws-2
+  (is (= (evaluate-2 "Albert")
+         #{{:employee "Albert", :job :pc-support}
+           {:employee "Albert", :job :server-support}}))
+  (is (= (evaluate-2 "Sameer")
+         #{{:employee "Sameer", :job :programming}}))
+  (is (= (evaluate-2 "Bob")
+         #{{:employee "Bob", :job :accounting}
+           {:employee "Bob", :job :management}
+           {:employee "Bob", :job :payroll}
+           {:employee "Bob", :job :pc-support}
+           {:employee "Bob", :job :project-management}
+           {:employee "Bob", :job :programming}
+           {:employee "Bob", :job :server-support}
+           {:employee "Bob", :job :sales}})))
+
+(def ws-3 (build-soft-strat-work-plan rules (?- :bj :name '??name :boss ?x)))
+(defn evaluate-3 [name] (set (evaluate-soft-work-set ws-3 db {'??name name})))
+
+(deftest test-ws-3
+  (is (= (evaluate-3 "Albert")
+         #{{:name "Albert", :boss "Sameer"}})))
+
+
+(comment
+  (run-tests)
+)
+
+;; End of file
diff --git a/src/clojure/contrib/datalog/tests/test_util.clj b/src/clojure/contrib/datalog/tests/test_util.clj
new file mode 100644
index 00000000..aac6ace9
--- /dev/null
+++ b/src/clojure/contrib/datalog/tests/test_util.clj
@@ -0,0 +1,69 @@
+;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
+;;  distribution terms for this software are covered by the Eclipse Public
+;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
+;;  be found in the file epl-v10.html at the root of this distribution.  By
+;;  using this software in any fashion, you are agreeing to be bound by the
+;;  terms of this license.  You must not remove this notice, or any other,
+;;  from this software.
+;;
+;;  test-util.clj
+;;
+;;  A Clojure implementation of Datalog -- Utilities Tests
+;;
+;;  straszheimjeffrey (gmail)
+;;  Created 11 Feburary 2009
+
+(ns clojure.contrib.datalog.tests.test-util
+  (:use clojure.contrib.test-is
+	clojure.contrib.datalog.util)
+  (:use [clojure.contrib.except :only (throwf)]))
+
+(deftest test-is-var?
+  (is (is-var? '?x))
+  (is (is-var? '?))
+  (is (not (is-var? '??x)))
+  (is (not (is-var? '??)))
+  (is (not (is-var? 'x)))
+  (is (not (is-var? "fred")))
+  (is (not (is-var? :q))))
+
+(deftest test-map-values
+  (let [map {:fred 1 :sally 2}]
+    (is (= (map-values #(* 2 %) map) {:fred 2 :sally 4}))
+    (is (= (map-values identity {}) {}))))
+
+(deftest test-keys-to-vals
+  (let [map {:fred 1 :sally 2 :joey 3}]
+    (is (= (set (keys-to-vals map [:fred :sally])) #{1 2}))
+    (is (= (set (keys-to-vals map [:fred :sally :becky])) #{1 2}))
+    (is (empty? (keys-to-vals map [])))
+    (is (empty? (keys-to-vals {} [:fred])))))
+
+(deftest test-reverse-map
+  (let [map {:fred 1 :sally 2 :joey 3}
+        map-1 (assoc map :mary 3)]
+    (is (= (reverse-map map) {1 :fred 2 :sally 3 :joey}))
+    (is (or (= (reverse-map map-1) {1 :fred 2 :sally 3 :joey})
+            (= (reverse-map map-1) {1 :fred 2 :sally 3 :mary})))))
+
+(def some-maps
+     [
+      { :a 1 :b 2 }
+      { :c 3 :b 3 }
+      { :d 4 :a 1 }
+      { :g 4 :b 4 }
+      { :a 2 :b 1 }
+      { :e 1 :f 1 }
+      ])
+
+(def reduced (preduce + some-maps))
+(def merged (apply merge-with + some-maps))
+
+(deftest test-preduce
+  (is (= reduced merged)))
+
+(comment
+ (run-tests)
+)
+
+; End of file
diff --git a/src/clojure/contrib/datalog/util.clj b/src/clojure/contrib/datalog/util.clj
new file mode 100644
index 00000000..b887f85c
--- /dev/null
+++ b/src/clojure/contrib/datalog/util.clj
@@ -0,0 +1,89 @@
+;;  Copyright (c) Jeffrey Straszheim. All rights reserved.  The use and
+;;  distribution terms for this software are covered by the Eclipse Public
+;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
+;;  be found in the file epl-v10.html at the root of this distribution.  By
+;;  using this software in any fashion, you are agreeing to be bound by the
+;;  terms of this license.  You must not remove this notice, or any other,
+;;  from this software.
+;;
+;;  util.clj
+;;
+;;  A Clojure implementation of Datalog -- Utilities
+;;
+;;  straszheimjeffrey (gmail)
+;;  Created 3 Feburary 2009
+
+
+(ns clojure.contrib.datalog.util
+  (:use [clojure.contrib.seq-utils :only (separate)]))
+
+
+
+;;; Bindings and logic vars.  A binding in a hash of logic vars to
+;;; bound values.  Logic vars are any symbol prefixed with a \?.
+
+(defn is-var?
+  "Is this a logic variable: e.g. a symbol prefixed with a ?"
+  [sym]
+  (when (symbol? sym)
+    (let [name (name sym)]
+      (and (= \? (first name))
+           (not= \? (fnext name))))))
+
+(defn is-query-var?
+  "Is this a query variable: e.g. a symbol prefixed with ??"
+  [sym]
+  (when (symbol? sym)
+    (let [name (name sym)]
+      (and (= \? (first name))
+           (= \? (fnext name))))))
+
+(defn map-values
+  "Like map, but works over the values of a hash map"
+  [f hash]
+  (let [key-vals (map (fn [[key val]] [key (f val)]) hash)]
+    (if (seq key-vals)
+      (apply conj (empty hash) key-vals)
+      hash)))
+
+(defn keys-to-vals
+  "Given a map and a collection of keys, return the collection of vals"
+  [m ks]
+  (vals (select-keys m ks)))
+
+(defn reverse-map
+  "Reverse the keys/values of a map"
+  [m]
+  (into {} (map (fn [[k v]] [v k]) m)))
+
+
+;;; Preduce -- A parallel reduce over hashes
+  
+(defn preduce
+  "Similar to merge-with, but the contents of each key are merged in
+   parallel using f.
+
+   f - a function of 2 arguments.
+   data - a collection of hashes."
+  [f data]
+  (let [data-1 (map (fn [h] (map-values #(list %) h)) data)
+        merged (doall (apply merge-with concat data-1))
+        ; Groups w/ multiple elements are identified for parallel processing
+        [complex simple] (separate (fn [[key vals]] (> (count vals) 1)) merged)
+        fold-group (fn [[key vals]] {key (reduce f vals)})
+        fix-single (fn [[key [val]]] [key val])]
+    (apply merge (concat (pmap fold-group merged) (map fix-single simple)))))
+  
+
+;;; Debuging and Tracing
+
+(def *trace-datalog* nil)
+
+(defmacro trace-datalog
+  "If *test-datalog* is set to true, run the enclosed commands"
+  [& body]
+  `(when *trace-datalog*
+     ~@body))
+
+ 	
+;; End of file