constantp: fully expand; recognize functions.

This patch improves the constantp function dramatically.  It
now performs a full expansion of its argument, and recognizes
all of the constant foldable functions that the compiler
recognizes.

* eval.c (const_foldable_s): New symbol variable.
(const_foldable_hash): New static variable.
(constantp_noex): Look up function in the hash table of const
foldable functions, including in the case when it appears in a
dwim form as in [+ 2 2] which is (dwim + 2 2). In this case,
recursively check the arguments for constantp_noex.
We get the hash table of foldable functions from the
sys:%const-foldable% variable, which comes from an autoloaded
module.
(constantp): Fully expand the input form, not just m
macroexpand.
(eval_init): Register the const_foldable_s variable.

* lisplib.c (constfun_instantiate, constfun_set_entries): New
static functions.
(lisplib_init): Register auto-loading of constfun module
via new static functions.

* stdlib/compiler.tl; Load the constfun module if
%const-foldable% is not defined.
(%const-foldable-funs%, %const-foldable%): Removed from here.

* stdlib/constfun.tl: New file.
(%const-foldable-funs%, %const-foldable%): Moved here.

* txr.1: Documented changes to constantp.

1 files changed, 63 insertions, 0 deletions

diff --git a/stdlib/constfun.tl b/stdlib/constfun.tl
new file mode 100644
index 00000000..76bc0621
--- /dev/null
+++ b/stdlib/constfun.tl
@@ -0,0 +1,63 @@
+;; Copyright 2021
+;; Kaz Kylheku <kaz@kylheku.com>
+;; Vancouver, Canada
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are met:
+;;
+;; 1. Redistributions of source code must retain the above copyright notice, this
+;;    list of conditions and the following disclaimer.
+;;
+;; 2. Redistributions in binary form must reproduce the above copyright notice,
+;;    this list of conditions and the following disclaimer in the documentation
+;;    and/or other materials provided with the distribution.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+(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 caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr
+    caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr
+    cdadar cdaddr cddaar cddadr cdddar cddddr caaaaar caaaadr caaadar caaaddr
+    caadaar caadadr caaddar caadddr cadaaar cadaadr cadadar cadaddr caddaar
+    caddadr cadddar caddddr cdaaaar cdaaadr cdaadar cdaaddr cdadaar cdadadr
+    cdaddar cdadddr cddaaar cddaadr cddadar cddaddr cdddaar cdddadr cddddar
+    cdddddr cons first rest sub-list identity typeof atom null false true have
+    consp listp endp proper-listp length-list second third fourth fifth
+    sixth seventh eighth ninth tenth conses ldiff nthcdr nth tailp
+    memq memql memqual rmemq rmemql rmemqual countq countql countqual
+    posq posql posqual rposq rposql rposqual eq eql equal meq meql mequal
+    neq neql nequal max min clamp bracket take drop uniq if or and progn
+    prog1 prog2 nilf tf tostring tostringp display-width sys:fmt-simple
+    sys:fmt-flex join join-with sys:fmt-join packagep
+    symbolp keywordp bindable stringp length-str
+    coded-length cmp-str string-lt str= str< str> str<= str>= int-str
+    flo-str num-str int-flo flo-int tofloat toint tointz less greater
+    lequal gequal chrp chr-isalnum chr-isalnum chr-isalpha chr-isascii
+    chr-iscntrl chr-isdigit chr-digit chr-isgraph chr-islower chr-isprint
+    chr-ispunct chr-isspace chr-isblank chr-isunisp chr-isupper chr-isxdigit
+    chr-xdigit chr-toupper chr-tolower num-chr int-chr chr-num chr-int
+    chr-str span-str compl-span-str break-str vectorp length-vec size-vec
+    assq assql assoc rassq rassql rassoc prop memp length len empty ref
+    rangep from to in-range in-range* nullify))
+
+(defvarl %const-foldable% (hash-list %const-foldable-funs% :eq-based))