summaryrefslogtreecommitdiff
path: root/module/language/tree-il/peval.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/language/tree-il/peval.scm')
-rw-r--r--module/language/tree-il/peval.scm14
1 files changed, 5 insertions, 9 deletions
diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm
index 9a5047ce1..1abb0f08d 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -683,11 +683,6 @@ 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
@@ -1525,10 +1520,11 @@ top-level bindings from ENV and return the resulting expression."
(fold-constants src name args ctx))
((name . args)
- (let ((exp (make-primcall src name args)))
- (if (and (eq? ctx 'effect) (can-elide-statement? exp))
- (make-void src)
- exp)))))
+ (if (and (eq? ctx 'effect) (effect-free-primcall? name args))
+ (if (null? args)
+ (make-void src)
+ (for-tail (list->seq src args)))
+ (make-primcall src name args)))))
(($ <call> src orig-proc orig-args)
;; todo: augment the global env with specialized functions