compiler: use effect-free criterion for elimination.

When the result of a function call is not used, the call can
be eliminated if the function has no effects.

Effect-free functions are superset of constant-foldable
functions. Not all effect-free functions are const-foldable
because in some cases, creating an object at run-time is a
documented semantics which cannot be constant-folded. For
instance (list 1) cannot be constant folded, because it may be
relied upon to generate a fresh object each time it is called.
However, bringing a new list to life is not an effect. If
the value is not used, we can safely eliminate it.
The same reasoning applies to (gensym "abc"). It must generate
a unique symbol each time, and so cannot be constant-folded.
But call to gensym whose value is not used can be eliminated.

* share/txr/stdlib/compiler.tl (%effect-free-funs%): List of
side-effect-free functions registered in eval.c.
(%effect-free%): Hash of effect-free functions, incorporating
%const-foldable% also.
* share/txr/stdlib/optimize.tl (basic-blocks peephole-block):
Refer to %effect-free% rather than %const-foldable%.

2 files changed, 25 insertions, 1 deletions

diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index a567eaa9..c3e11d94 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -306,6 +306,30 @@
 
 (defvarl %const-foldable% (hash-list %const-foldable-funs% :eq-based))
 
+(defvarl %effect-free-funs%
+  '(append append* revappend list list* zip interpose copy-list reverse
+   flatten flatten* flatcar flatcar* tuples remq remql remqual
+   keepq keepq keepqual remq* remql* remq* make-sym gensym
+   mkstring copy-str upcase-str downcase-str cat-str split-str spl
+   split-str-set sspl tok-str tok tok-where list-str trim-str
+   get-lines lazy-str length-str-> length-str->= length-str-<
+   length-str-<= vector vec vector-list list-vector list-vec
+   copy-vec sub-vec cat-vec acons acons-new aconsql-new alist-remove
+   copy-cons copy-tree copy-alist plist-to-alist improper-plist-to-alist
+   merge sort shuffle list-seq vec-seq str-seq copy sub seq-begin
+   iter-begin rcons make-like nullify symbol-value symbol-function
+   symbol-macro boundp fboundp mboundp special-operator-p special-var-p
+   copy-fun func-get-form func-get-name func-get-env functionp
+   interp-fun-p vm-fun-p fun-fixparam-count fun-optparam-count
+   fun-variadic sys:ctx-form sys:ctx-name range range* rlist rlist*
+   repeat pad weave promisep rperm perm comb rcomb source-loc
+   source-loc-str macro-ancestor cptr-int cptr-obj cptr-buf
+   int-cptr cptrp cptr-type cptr-size-hint))
+
+(defvarl %effect-free% (hash-uni %const-foldable%
+                                 (hash-list %effect-free-funs% :eq-based)))
+
+
 (defvarl %functional-funs%
   '(chain chand juxt andf orf notf iff iffi dup flipargs if or and
     progn prog1 prog2 retf apf ipf callf mapf tf nilf umethod uslot))
diff --git a/share/txr/stdlib/optimize.tl b/share/txr/stdlib/optimize.tl
index 109dc9b3..5d0b2806 100644
--- a/share/txr/stdlib/optimize.tl
+++ b/share/txr/stdlib/optimize.tl
@@ -368,7 +368,7 @@
         ^((jmp ,jlabel) ,*(cdr insns)))
       (@(require ((@(or gcall gapply) (t @n) @idx . @nil) . @nil)
                  (dead-treg (car insns) n)
-                 [%const-foldable% [bb.symvec idx]])
+                 [%effect-free% [bb.symvec idx]])
         (pushnew bl bb.rescan)
         (set bb.recalc t)
         (cdr insns))