diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-02-20 15:37:57 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-02-20 15:37:57 -0800 |
| commit | 065e8b113305179de0b489bc8d18452ec1aa5e2a (patch) | |
| tree | 46dc279443eb59b2ebdc8391c8f00069276917b0 | |
| parent | 55be1f48b5c3f68bc1883acadbd9ffc3ffddd330 (diff) | |
| download | txr-065e8b113305179de0b489bc8d18452ec1aa5e2a.tar.gz txr-065e8b113305179de0b489bc8d18452ec1aa5e2a.tar.bz2 txr-065e8b113305179de0b489bc8d18452ec1aa5e2a.zip | |
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.
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 14 |
1 files 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))) |