A Simplifier for all Expressions

simplifier.clj

;; A Simplifier for all Expressions

;; Example:
;; (simplify '(* 1 (+ x (- y y)))) ;=> x
;; (simplify '(and a (and (and) b))) ;=> (and a b)

;; See section 4.4, "Syntactic Abstraction" of Norvig and Pitman's
;; "Tutorial on Good Lisp Programming Style":
;; http://norvig.com/luv-slides.ps

(use '[clojure.walk :only (postwalk)])

(defn bind [cols]
  (reduce (fn [m [p e]] (update-in m [p] (fnil conj #{}) e)) {} cols))

(defn match1 [rule expr]
  {:pre [(= 2 (count rule))
         (list? expr)]}
  (let [[[op & args] result] rule
        [expr-op & expr-args] expr]
    (when (and
           (= op expr-op)
           (= (count args) (count expr-args)))
      (let [cols (map vector args expr-args)
            matches (bind cols)]
        (when (and
               (every? #(apply = %) (filter (comp (complement symbol?) first) cols))
               (apply = 1 (map count (vals matches))))
          (if (symbol? result)
            (first (matches result))
            result))))))

(defn matchn [rules expr]
  {:pre [(even? (count rules))]}
  (if (list? expr)
    (or (first (keep #(match1 % expr) (partition 2 rules))) expr)
    expr))

(def ^:dynamic rules
  '[(+ x 0) x
    (+ 0 x) x
    (- x 0) x
    (- x x) 0
    (* 1 x) x
    (if x y y) y
    (if x y y) y
    (and) true
    (and x) x
    (and true x) x
    (and x x) x])

(defn simplify [expr]
  (postwalk (partial matchn rules) expr))

(comment
  (simplify '(* 1 (+ x (- y y))))
  (simplify '(and a (and (and) b)))
  )