wingo pushed a commit to branch main
in repository guile.
commit 28a428135f6568cd7dac3d8ecba2edeb7ddbd95e
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Wed Nov 15 15:17:29 2023 +0100
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.
---
module/language/tree-il/peval.scm | 10 +++++++++-
1 file changed, 9 insertions(+), 1 deletion(-)
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
