(ns src.unify-matcher)

(use '[clojure.set :only (union)])

(defn var? [s]
  (and (symbol? s)
       (= (nth (str s) 0) \?)))

(defn wild-card? [s]
  (and (symbol? s)
       (>= (.length (str s)) 2)
       (= (take 2 (str s))
          (seq "?*"))))

(defn cons? [x]
  (and (coll? x) (not (empty? x))))

(def fail (gensym "fail__"))
(defn fail? [s] (identical? s fail))

(declare unify-variable)

(defn unify
  "See if x and y match with given bindings."
  ([x y] (unify x y {}))
  ([x y bind]
   (cond (fail? bind) fail
         (= x y) bind
         (var? x) (unify-variable x y bind)
         (var? y) (unify-variable y x bind)
         (and (cons? x)
              (wild-card? (first x))) (recur (first x) y bind)
         (and (cons? y)
              (wild-card? (first y))) (recur x (first y) bind)
         (and (cons? x) (cons? y)) (recur (rest x) (rest y)
                                          (unify (first x) (first y) bind))
         :else fail)))

(defn unify-variable
  "Unify var with x, using (and maybe extending) bindings."
  [var x bind]
  (if (contains? bind var)
    (unify (bind var) x bind)
    (assoc bind var x)))

(defn subst
  "Substitute the value of variables in bindings into x,
  taking recursively bound variables into account."
  [bind x]
  (cond (fail? bind) fail
        (empty? bind) x
        (var? x) (if (contains? bind x)
                   (recur bind (bind x))
                   x)
        (not (cons? x)) x
        :else (cons (subst bind (first x))
                    (subst bind (rest x)))
        ))

(defn subst-tree [bind sexp]
  (if (cons? sexp)
    ((if (wild-card? (first sexp)) concat cons)
     (subst-tree bind (first sexp))
     (subst-tree bind (rest sexp)))
    (subst bind sexp)))

(defn vars-in
  ([sexp] (vars-in sexp (complement cons?)))
  ([sexp atom?]
   (if (atom? sexp)
     (if (var? sexp) #{sexp} #{})
     (union (vars-in (first sexp) atom?)
            (vars-in (rest sexp) atom?)
            ))))

(defmacro if-match
  ([pat seq then] `(if-match ~pat ~seq ~then nil))
  ([pat seq then else]
   (let [gb (gensym "gb__")]
     `(let [~gb (unify ~pat ~seq)]
        (if (fail? ~gb)
          ~else
          (let [~@(apply concat
                         (map (fn [v] `(~v (subst ~gb '~v)))
                              (sort (vars-in then))
                              ))]
            ~then))))))