fix the peval merge and a test

* module/language/tree-il/peval.scm (peval): Accessor primitives applied
  to constants are pure if the call type-checks.  Also, fold constants
  in accessor primcalls.

* test-suite/tests/tree-il.test ("partial evaluation"): Fix the "yo"
  test.

diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm
index 09ed8ea..fd3526c 100644 (file)
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -542,9 +542,10 @@ top-level bindings from ENV and return the resulting expression."
         (($ <primcall> _ name args)
          (and (effect-free-primitive? name)
               (not (constructor-primitive? name))
-              (not (accessor-primitive? name))
               (types-check? name args)
-              (every loop args)))
+              (if (accessor-primitive? name)
+                  (every const? args)
+                  (every loop args))))
         (($ <call> _ ($ <lambda> _ _ body) args)
          (and (loop body) (every loop args)))
         (($ <seq> _ head tail)
@@ -1003,7 +1004,7 @@ top-level bindings from ENV and return the resulting expression."
               (else
                (make-primcall src name (list k (make-const #f elts))))))))
          ((name . args)
-          (make-primcall src name args))))
+          (fold-constants src name args ctx))))
 
       (($ <primcall> src (? effect-free-primitive? name) args)
        (fold-constants src name (map for-value args) ctx))

diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 84c6c2c..88317e8 100644 (file)
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -785,7 +785,7 @@
                         (loop (1+ i)))
                   '())))))
      (string->chars "yo"))
-   (apply (primitive list) (const #\y) (const #\o)))
+   (primcall list (const #\y) (const #\o)))
 
   (pass-if-peval
     ;; Primitives in module-refs are resolved (the expansion of `pmatch'