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 a