application/octet-stream
•
2.38 KB
•
47 lines
;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
;;; Contains an optimization pass that does some simple constant folding
;;;
;;; To accomplish this we walk an expression tree, searching for pure functions
;;; with constant arguments, since these should be safe to replace with their
;;; respective results.
;;;
;;; Pure functions are those whose :pure meta value is #t, meaning we trust
;;; the developer to determine which functions are safe to constant fold, in
;;; future versions we might be able to infer if a given fn is pure.
(def constant-fold (let*
(defn constant-fold/constant? (expr)
(and (not (pair? expr))
(not (symbol? expr))
#t))
(defn constant-fold/pure? (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 env)
"Will try and evaluate as many constant as possible to make the expression simpler."
:cat :compiler
:internal
(when-not (pair? expr) (return expr))
(def folded-fun (car expr))
(when (= 'quote folded-fun) (return expr))
(def folded-args (constant-fold/args (cdr expr)))
(if (and (constant-fold/pure? folded-fun)
(every? folded-args constant-fold/constant?))
(try (fn () (cons folded-fun folded-args))
(apply (constant-fold/resolve folded-fun) folded-args))
(cons folded-fun folded-args)))))
