Skip to content

Instantly share code, notes, and snippets.

@alandipert
Created February 13, 2012 02:02
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 2 You must be signed in to fork a gist
  • Save alandipert/1812741 to your computer and use it in GitHub Desktop.
Save alandipert/1812741 to your computer and use it in GitHub Desktop.
A Simplifier for all Expressions
;; 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)))
)
@alandipert
Copy link
Author

TODO: Use a unifier

@fogus
Copy link

fogus commented Feb 13, 2012

I know of one. :-)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment