diff options
author | Andy Wingo <wingo@pobox.com> | 2023-11-15 15:17:29 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2023-11-15 15:17:29 +0100 |
commit | 28a428135f6568cd7dac3d8ecba2edeb7ddbd95e (patch) | |
tree | 17cc510983493887a96cf61cacf4a6b1ffaa8b73 /module/language | |
parent | e529db04a4c344ad3903c36fc771721bbda19ac4 (diff) | |
download | guile-28a428135f6568cd7dac3d8ecba2edeb7ddbd95e.tar.gz |
peval: elide effect-free primcalls in effect context
* module/language/tree-il/peval.scm (peval): fix-letrec can residualize
useless primcalls, when a let or letrec-bound var is unused. Fix to
elide these.
Diffstat (limited to 'module/language')
-rw-r--r-- | module/language/tree-il/peval.scm | 10 |
1 files changed, 9 insertions, 1 deletions
diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm index 05a2d7f05..9a5047ce1 100644 --- a/module/language/tree-il/peval.scm +++ b/module/language/tree-il/peval.scm @@ -683,6 +683,11 @@ top-level bindings from ENV and return the resulting expression." ;; mutable data (like `car' or toplevel references). (constant? (compute-effects x))) + (define (can-elide-statement? stmt) + (let ((effects (compute-effects stmt))) + (effect-free? + (exclude-effects effects (logior &allocation &zero-values))))) + (define (prune-bindings ops in-order? body counter ctx build-result) ;; This helper handles both `let' and `letrec'/`fix'. In the latter ;; cases we need to make sure that if referenced binding A needs @@ -1520,7 +1525,10 @@ top-level bindings from ENV and return the resulting expression." (fold-constants src name args ctx)) ((name . args) - (make-primcall src name args)))) + (let ((exp (make-primcall src name args))) + (if (and (eq? ctx 'effect) (can-elide-statement? exp)) + (make-void src) + exp))))) (($ <call> src orig-proc orig-args) ;; todo: augment the global env with specialized functions |