(defn make-analyzer
"Make-analyzer takes an analyzer `backend` (which implements [[ICanonicalize]])
and returns a dictionary with the apparatus necessary to prepare expressions
for analysis by replacing subexpressions formed from operations unknown to the
analyzer with generated symbols, and backsubstituting after analysis is
complete.
For example, in the case of polynomial canonical form, we would replace a
subexpression like `(sin x)` with a gensym, before entry, since the `sin`
operation is not available to the polynomial canonicalizer, and restore it
afterwards."
([backend]
(make-analyzer backend (monotonic-symbol-generator 16 "-g-")))
([backend symbol-generator]
(let [ref #?(:clj ref :cljs atom)
alter #?(:clj alter :cljs swap!)
ref-set #?(:clj ref-set :cljs reset!)
expr->var (ref {})
var->expr (ref {})
compare-fn (atom compare)]
(letfn [(v-compare [v1 v2]
(@compare-fn v1 v2))
(unquoted-list? [expr]
(and (sequential? expr)
(not (= (first expr) 'quote))))
(new-analysis! []
(reset! compare-fn compare)
(#?(:clj dosync :cljs do)
(ref-set expr->var {})
(ref-set var->expr {}))
nil)
(ianalyze [expr]
(if (unquoted-list? expr)
(let [analyzed-expr (doall (map ianalyze expr))]
(if (and (known-operation? backend (sym/operator analyzed-expr))
(not (and *inhibit-expt-simplify*
(sym/expt? analyzed-expr)
(not (v/integral?
(second
(sym/operands analyzed-expr)))))))
analyzed-expr
(if-let [existing-expr (@expr->var analyzed-expr)]
existing-expr
(new-kernels analyzed-expr))))
expr))
(analyze [expr]
(let [vcompare (make-vcompare (x/variables-in expr))]
(reset! compare-fn vcompare))
(ianalyze expr))
(new-kernels [expr]
(let [simplified-expr (doall (map base-simplify expr))
op (sym/operator simplified-expr)]
(if-let [v (sym/symbolic-operator op)]
(let [w (apply v (sym/operands simplified-expr))]
(if (and (sequential? w)
(= (sym/operator w) op))
(add-symbols! w)
(ianalyze w)))
(add-symbols! simplified-expr))))
(add-symbol! [expr]
(if (unquoted-list? expr)
(let [expr-k (g/freeze expr)]
(#?(:clj dosync :cljs identity)
(if-let [existing-expr (@expr->var expr-k)]
existing-expr
(let [var (symbol-generator)]
(alter expr->var assoc expr-k var)
(alter var->expr assoc var expr)
var))))
expr))
(add-symbols! [expr]
(let [new (doall (map add-symbol! expr))]
(add-symbol! new)))
(backsubstitute [expr]
(cond (sequential? expr) (doall
(map backsubstitute expr))
(symbol? expr) (if-let [w (@var->expr expr)]
(backsubstitute w)
expr)
:else expr))
(base-simplify [expr]
(if (unquoted-list? expr)
(expression-> backend
expr
#(->expression backend %1 %2)
v-compare)
expr))
(analyze-expression [expr]
(binding [sym/*incremental-simplifier* false]
(base-simplify
(analyze expr))))
(simplify-expression [expr]
(backsubstitute
(analyze-expression expr)))
(simplify [expr]
(new-analysis!)
(simplify-expression
(x/expression-of expr)))]
{:simplify
(fn [expr]
(if (x/literal? expr)
(x/fmap simplify expr)
(simplify expr)))
:simplify-expression
(fn [expr]
(if (x/literal? expr)
(x/fmap simplify-expression expr)
(simplify-expression expr)))
:initializer new-analysis!
:analyze-expression analyze-expression
:get-var->expr (fn [] @var->expr)
:get-expr->var (fn [] @expr->var)}))))