summaryrefslogtreecommitdiff
path: root/module/language
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2023-11-15 15:17:29 +0100
committerAndy Wingo <wingo@pobox.com>2023-11-15 15:17:29 +0100
commit28a428135f6568cd7dac3d8ecba2edeb7ddbd95e (patch)
tree17cc510983493887a96cf61cacf4a6b1ffaa8b73 /module/language
parente529db04a4c344ad3903c36fc771721bbda19ac4 (diff)
downloadguile-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.scm10
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