(Slightly less) crude (monotonic) datalog interpreter

gistfile1.clj

(ns mist.logic.datalog
  (:use clojure.core.logic
        [clojure.set :only [union, difference]])
  (:require clojure.walk))

(defn- all-o [goal args]
  (conde
   [(emptyo args)]
   [(fresh [arg rest]
           (conso arg rest args)
           (goal arg)
           (all-o goal rest))]))

(defn- var? [thing]
  (and (symbol? thing) (= \? (first (str thing)))))

(defn- vars [form]
  (let [vars (atom #{})]
    (letfn [(add-var [form]
              (prn "var?" form)
              (when (var? form)
                (prn "var!" form)
                (swap! vars #(conj % form))))]
      (clojure.walk/postwalk add-var form)
      @vars)))

(defn- lvarise [form]
  (let [vars (vars form)
        binding (zipmap vars (map lvar vars))]
    (clojure.walk/postwalk-replace binding form)))

(defn- is-rule-o [rule-var rules]
  (fn [substitutions]
    (to-stream
     (->> (for [rule rules]
            (unify substitutions rule-var (lvarise rule)))
          (remove not)))))

(defn compile [facts rules]
  (let [derived-fact (atom nil)]
    (compare-and-set!
     derived-fact
     nil
     (tabled [postulate]
             (conde
              [(membero postulate facts)]
              [(fresh [rule rule-body]
                      (is-rule-o rule rules)
                      (conso postulate rule-body rule)
                      (all-o @derived-fact rule-body))])))
    @derived-fact))

(defn query [compiled query]
  (let [query (lvarise query)]
    (run* [q] (== q query) (compiled query))))

(def eg-facts
  '((edge a b) (edge a c) (edge b d) (edge c d) (edge d e)))

(def eg-rules
  '(((vertex ?a) (edge ?a ?b))
    ((vertex ?b) (edge ?a ?b))
    ((path ?a ?a) (vertex ?a))
    ((path ?a ?b) (edge ?a ?b))
    ((path ?a ?c) (path ?a ?b) (edge ?b ?c))))

(def eg-db (compile eg-facts eg-rules))

;; (query eg-db '(path b ?x))
;; => ((path b b) (path b d) (path b e))

;; (query eg-db '(path ?x ?x))
;; ((path a a) (path b b) (path c c) (path d d) (path e e))