application/octet-stream
•
1.22 KB
•
34 lines
;; Contains an optimization pass that does constant folding
[defn pure? [expr]
[and [not [pair? expr]]
[not [symbol? expr]]
#t]]
[defn constant-foldable? [fun]
[meta fun :pure]]
[defn constant-fold/resolve [sym]
[when-not [symbol? sym] [return sym]]
[resolve sym]]
[defn constant-fold/args [expr]
[when-not expr [return expr]]
[if [pair? [car expr]]
[cons [constant-fold [car expr]]
[constant-fold/args [cdr expr]]]
[cons [car expr]
[constant-fold/args [cdr expr]]]]]
[defn constant-fold [expr]
"Will try and evaluate as many constant as possible to make the expression simpler."
[if-not [pair? expr] expr
[do
[def folded-fun [car expr]]
[when [= 'quote folded-fun] [return expr]]
[def folded-args [constant-fold/args [cdr expr]]]
[if [and [constant-foldable? folded-fun]
[every? folded-args pure?]]
[try [fn [] [cons folded-fun folded-args]]
[apply [constant-fold/resolve folded-fun] folded-args]]
[cons folded-fun folded-args]]]]]
