Created
February 13, 2012 02:02
-
-
Save alandipert/1812741 to your computer and use it in GitHub Desktop.
A Simplifier for all Expressions
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; 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))) | |
) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
I know of one. :-)