diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-02-19 21:26:50 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-02-19 21:26:50 -0800 |
| commit | 7cd3d92e972b10c4fb5d67079cb911c0aef8e5b4 (patch) | |
| tree | 6b4f2df84fd16afcd844346380aaa2af5c6ace7a | |
| parent | b935372fce93056240e3fae71c5095fd26fbdb13 (diff) | |
| download | txr-7cd3d92e972b10c4fb5d67079cb911c0aef8e5b4.tar.gz txr-7cd3d92e972b10c4fb5d67079cb911c0aef8e5b4.tar.bz2 txr-7cd3d92e972b10c4fb5d67079cb911c0aef8e5b4.zip | |
compiler: constant-fold most arithmetic functions
* share/txr/stdlib/compiler.tl (%const-foldable-funs%): Add
most functions from arith module.
(%const-foldable%): New variable, hash built from list.
(compiler comp-fun-form, reduce-constant): Refer to
%const-foldable% hash instead of %const-foldable-funs% list.
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 21 |
1 files changed, 15 insertions, 6 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index f7ed530e..f1bbf594 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -258,10 +258,19 @@ (defvarl %bin-op% (relate %nary-ops% %bin-ops% nil)) -(defvarl %const-foldable-funs% '(+ - * / b- b+ b* b/ - pred ppred ppred pppred - succ ssucc ssucc sssucc - car cdr cadr caddr first second)) +(defvarl %const-foldable-funs% + '(+ - * / sum prod abs trunc mod zerop nzerop plusp minusp evenp oddp + > < >= <= = /= wrap wrap* expt exptmod isqrt square gcd lcm floor ceil + round trunc-rem floor-rem ceil-rem round-rem sin cos tan asin acos atan + atan2 sinh cosh tanh asinh acosh atanh log log10 log2 exp sqrt + logand logior logxor logtest lognot logtrunc sign-extend ash bit mask + width logcount bitset cum-norm-dist inv-cum-norm n-choose-k n-perm-k + fixnump bignump floatp integerp numberp signum bignum-len divides sys:bits + digpow digits poly rpoly b< b> b<= b=> b= b+ b- b* b/ neg + pred ppred ppred pppred succ ssucc ssucc sssucc + car cdr cadr caddr first second)) + +(defvarl %const-foldable% (hash-list %const-foldable-funs% :eq-based)) (defvarl assumed-fun) @@ -1211,7 +1220,7 @@ (tree-case form ((sym . args) - (if (member sym %const-foldable-funs%) + (if [%const-foldable% sym] (set form (reduce-constant form))))) (when (or (atom form) (special-operator-p (car form))) @@ -1546,7 +1555,7 @@ (defun reduce-constant (form) (if (consp form) (tree-bind (op . args) form - (if (member op %const-foldable-funs%) + (if [%const-foldable% op] (let ((cargs [mapcar reduce-constant args])) (if [all cargs constantp] ^(quote ,(eval ^(,op ,*cargs))) |