peval: better primcall folding in effect contexts

* module/language/tree-il/peval.scm (peval): If a primcall is
effect-free, don't require that its args are too: just revisit args as a
sequence in effect context.
* module/language/tree-il/effects.scm (effect-free-primcall?): New
exported function.

module/language/tree-il/effects.scm

@@ -36,7 +36,8 @@
             constant?
             depends-on-effects?
             causes-effects?
-            add-primcall-effect-analyzer!))
+            add-primcall-effect-analyzer!
+            effect-free-primcall?))
 
 ;;;
 ;;; Hey, it's some effects analysis!  If you invoke
@@ -238,6 +239,31 @@
 (define (primcall-effect-analyzer name)
   (hashq-ref *primcall-effect-analyzers* name))
 
+(define (effect-free-primcall? name args)
+  "Return #f unless a primcall of @var{name} with @var{args} can be
+replaced with @code{(begin . @var{args})} in an effect context."
+  (match (cons name args)
+    ((or ('values . _)
+         ('list . _)
+         ('vector . _)
+         ('eq? _ _)
+         ('eqv? _ _)
+         ('cons* _ . _)
+         ('acons _ _ _)
+         ((or 'not
+              'pair? 'null? 'nil? 'list?
+              'symbol? 'variable? 'vector? 'struct? 'string?
+              'number? 'char? 'eof-object? 'exact-integer?
+              'bytevector? 'keyword? 'bitvector?
+              'procedure? 'thunk? 'atomic-box?
+              'vector 'make-variable)
+          _))
+     #t)
+    (_
+     (match (primcall-effect-analyzer name)
+       (#f #f)
+       (effect-free? (effect-free? args))))))
+
 (define (make-effects-analyzer assigned-lexical?)
   "Returns a procedure of type EXP -> EFFECTS that analyzes the effects
 of an expression."

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