From 7cd3d92e972b10c4fb5d67079cb911c0aef8e5b4 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Fri, 19 Feb 2021 21:26:50 -0800 Subject: 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. --- share/txr/stdlib/compiler.tl | 21 +++++++++++++++------ 1 file 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))) -- cgit v1.2.3