From 065e8b113305179de0b489bc8d18452ec1aa5e2a Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sat, 20 Feb 2021 15:37:57 -0800 Subject: compiler: constant folding: avoid shadowed funs. * share/txr/stdlib/compiler.tl (compiler comp-arith-form): Pass env to reduce-constant. (compiler comp-fun-form): Likewise, and don't bother checking %const-foldable% because reduce-constant does that again. (compiler comp-apply-call): Pass env to reduce-constant. (reduce-constant): Take env argument. If the function is constant foldable, check that there is no lexical function call binding shadowing it. If so, it's not the function we think it is, and we must not constant-fold it. --- share/txr/stdlib/compiler.tl | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index dedd1a7a..77e4119a 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -1193,7 +1193,7 @@ me.(compile oreg env (expand qexp)))) (defmeth compiler comp-arith-form (me oreg env form) - (let ((rform (reduce-constant form))) + (let ((rform (reduce-constant env form))) (tree-case rform ((op . args) (let* ((pargs [partition-by constantp args]) @@ -1242,8 +1242,7 @@ (tree-case form ((sym . args) - (if [%const-foldable% sym] - (set form (reduce-constant form))))) + (set form (reduce-constant env form)))) (when (or (atom form) (special-operator-p (car form))) (return-from comp-fun-form me.(compile oreg env form))) @@ -1258,7 +1257,7 @@ (defmeth compiler comp-apply-call (me oreg env form) (tree-bind (sym . oargs) form - (let ((args [mapcar reduce-constant oargs])) + (let ((args [mapcar (op reduce-constant env) oargs])) (let ((gopcode [%gcall-op% sym]) (opcode [%call-op% sym])) (cond @@ -1579,11 +1578,12 @@ ^(,op ,a ,*args)) (@else else)))) -(defun reduce-constant (form) +(defun reduce-constant (env form) (if (consp form) (tree-bind (op . args) form - (if [%const-foldable% op] - (let ((cargs [mapcar reduce-constant args])) + (if (and [%const-foldable% op] + (not env.(lookup-fun op))) + (let ((cargs [mapcar (op reduce-constant env) args])) (if [all cargs constantp] ^(quote ,(eval ^(,op ,*cargs))) ^(,op ,*cargs))) -- cgit v1.2.3