prolog.clj

(ns prolog
  (:use clojure.contrib.def
        clojure.contrib.str-utils
	clojure.set
	clojure.test))

(defvar facts (ref {:forward {} :back {}}) "Hashmap of clauses (forward and back references)")

(defn passmap
  "Applies f to items only when (pred item) returns true."
  [pred f coll]
  (map #(if (pred %) (f %) %) coll))

(defn add-fact
  "Adds a clause of kind between from and to."
  ([kind from to]
     (dosync (commute facts
		      (fn [{f :forward b :back}]
			{:forward
			 (assoc f
			   kind
			   (assoc (get f kind {})
			     from (conj (get (f kind) from #{}) to)))
			:back
			(assoc b
			  kind
			  (assoc (get b kind {})
			    to (conj (get (b kind) to #{}) from)))}))))
  ([[kind from to]]
     (add-fact kind from to)))

(defn wildcard?
  "Whether the keyword is prefixed with a question mark."
  [word]
  (when (keyword? word)
    (= \? (nth (str word) 1))))

(defn query
  "Queries the named relation kind."
  ([kind from to]
     (let [facts @facts]
       (cond
	(wildcard? from)
	  ((-> facts :back kind) to)
	(wildcard? to)
	  ((-> facts :forward kind) from))))
  ([[kind from to]]
     (query kind from to)))

(defn <-
  ([head]
     (if (some wildcard? head)
       (query head)
       (add-fact head)))
  ([head & body]
     (reduce intersection (map <- body))))

(defn hallo []
  (<- [:likes :Kim :Robin])
  (<- [:likes :Sandy :Lee])
  (<- [:likes :Sandy :Kim])
  (<- [:likes :Robin :cats])
  (<- [:likes :Kim :?x] [:likes :?x :Lee] [:likes :?x :Kim]))