X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/739941679c2c7dc36c29c30aff7d4c1b436ba773..9b977c836bf147d386944c401113aba32776fa68:/test-suite/tests/peval.test

diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test
index 923b0d16a..ecc5dd187 100644
--- a/test-suite/tests/peval.test
+++ b/test-suite/tests/peval.test
@@ -33,11 +33,8 @@
   (@@ (language tree-il optimize) peval))
 
 (define-syntax pass-if-peval
-  (syntax-rules (resolve-primitives)
+  (syntax-rules ()
     ((_ in pat)
-     (pass-if-peval in pat
-                    (compile 'in #:from 'scheme #:to 'tree-il)))
-    ((_ resolve-primitives in pat)
      (pass-if-peval in pat
                     (expand-primitives!
                      (resolve-primitives!
@@ -75,7 +72,7 @@
         (f)))
     (const 3))
 
-  (pass-if-peval resolve-primitives
+  (pass-if-peval
     ;; First order, let-values (requires primitive expansion for
     ;; `call-with-values'.)
     (let ((x 0))
@@ -85,19 +82,19 @@
           (+ a b))))
     (const 3))
 
-  (pass-if-peval resolve-primitives
+  (pass-if-peval
     ;; First order, multiple values.
     (let ((x 1) (y 2))
       (values x y))
-    (apply (primitive values) (const 1) (const 2)))
+    (primcall values (const 1) (const 2)))
 
-  (pass-if-peval resolve-primitives
+  (pass-if-peval
     ;; First order, multiple values truncated.
     (let ((x (values 1 'a)) (y 2))
       (values x y))
-    (apply (primitive values) (const 1) (const 2)))
+    (primcall values (const 1) (const 2)))
 
-  (pass-if-peval resolve-primitives
+  (pass-if-peval
     ;; First order, multiple values truncated.
     (or (values 1 2) 3)
     (const 1))
@@ -105,16 +102,16 @@
   (pass-if-peval
     ;; First order, coalesced, mutability preserved.
     (cons 0 (cons 1 (cons 2 (list 3 4 5))))
-    (apply (primitive list)
-           (const 0) (const 1) (const 2) (const 3) (const 4) (const 5)))
+    (primcall list
+              (const 0) (const 1) (const 2) (const 3) (const 4) (const 5)))
 
   (pass-if-peval
     ;; First order, coalesced, immutability preserved.
     (cons 0 (cons 1 (cons 2 '(3 4 5))))
-    (apply (primitive cons) (const 0)
-           (apply (primitive cons) (const 1)
-                  (apply (primitive cons) (const 2)
-                         (const (3 4 5))))))
+    (primcall cons (const 0)
+              (primcall cons (const 1)
+                        (primcall cons (const 2)
+                                  (const (3 4 5))))))
 
   ;; These two tests doesn't work any more because we changed the way we
   ;; deal with constants -- now the algorithm will see a construction as
@@ -139,10 +136,10 @@
      (if (zero? i)
          r
          (loop (1- i) (cons (cons i i) r))))
-   (apply (primitive list)
-          (apply (primitive cons) (const 1) (const 1))
-          (apply (primitive cons) (const 2) (const 2))
-          (apply (primitive cons) (const 3) (const 3))))
+   (primcall list
+             (primcall cons (const 1) (const 1))
+             (primcall cons (const 2) (const 2))
+             (primcall cons (const 3) (const 3))))
   ;;
   ;; See above.
   #;
@@ -163,15 +160,15 @@
          r
          (loop (1- i) (cons (cons i i) r))))
    (let (r) (_)
-        ((apply (primitive list)
-                (apply (primitive cons) (const 3) (const 3))))
+        ((primcall list
+                   (primcall cons (const 3) (const 3))))
         (let (r) (_)
-             ((apply (primitive cons)
-                     (apply (primitive cons) (const 2) (const 2))
-                     (lexical r _)))
-             (apply (primitive cons)
-                    (apply (primitive cons) (const 1) (const 1))
-                    (lexical r _)))))
+             ((primcall cons
+                        (primcall cons (const 2) (const 2))
+                        (lexical r _)))
+             (primcall cons
+                       (primcall cons (const 1) (const 1))
+                       (lexical r _)))))
 
   ;; See above.
   (pass-if-peval
@@ -181,21 +178,21 @@
          (car r)
          (loop (1- i) (cons i r))))
    (let (r) (_)
-        ((apply (primitive list) (const 4)))
+        ((primcall list (const 4)))
         (let (r) (_)
-             ((apply (primitive cons)
-                     (const 3)
-                     (lexical r _)))
+             ((primcall cons
+                        (const 3)
+                        (lexical r _)))
              (let (r) (_)
-                  ((apply (primitive cons)
-                          (const 2)
-                          (lexical r _)))
+                  ((primcall cons
+                             (const 2)
+                             (lexical r _)))
                   (let (r) (_)
-                       ((apply (primitive cons)
-                               (const 1)
-                               (lexical r _)))
-                       (apply (primitive car)
-                              (lexical r _)))))))
+                       ((primcall cons
+                                  (const 1)
+                                  (lexical r _)))
+                       (primcall car
+                                 (lexical r _)))))))
 
    ;; Static sums.
   (pass-if-peval
@@ -205,7 +202,7 @@
          (loop (cdr l) (+ sum (car l)))))
    (const 10))
 
-  (pass-if-peval resolve-primitives
+  (pass-if-peval
    (let ((string->chars
           (lambda (s)
             (define (char-at n)
@@ -218,7 +215,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'
@@ -229,14 +226,13 @@
       (pmatch '(a b c d)
         ((a b . _)
          #t)))
-    (begin
-      (apply . _)
-      (const #t)))
+    (seq (call . _)
+         (const #t)))
 
   (pass-if-peval
    ;; Mutability preserved.
    ((lambda (x y z) (list x y z)) 1 2 3)
-   (apply (primitive list) (const 1) (const 2) (const 3)))
+   (primcall list (const 1) (const 2) (const 3)))
 
   (pass-if-peval
    ;; Don't propagate effect-free expressions that operate on mutable
@@ -245,10 +241,10 @@
           (y (car x)))
      (set-car! x 0)
      y)
-   (let (x) (_) ((apply (primitive list) (const 1)))
-        (let (y) (_) ((apply (primitive car) (lexical x _)))
-             (begin
-               (apply (toplevel set-car!) (lexical x _) (const 0))
+   (let (x) (_) ((primcall list (const 1)))
+        (let (y) (_) ((primcall car (lexical x _)))
+             (seq
+               (primcall set-car! (lexical x _) (const 0))
                (lexical y _)))))
   
   (pass-if-peval
@@ -257,9 +253,9 @@
    (let ((y (car x)))
      (set-car! x 0)
      y)
-   (let (y) (_) ((apply (primitive car) (toplevel x)))
-        (begin
-          (apply (toplevel set-car!) (toplevel x) (const 0))
+   (let (y) (_) ((primcall car (toplevel x)))
+        (seq
+          (primcall set-car! (toplevel x) (const 0))
           (lexical y _))))
   
   (pass-if-peval
@@ -269,8 +265,8 @@
         ((lambda _
            (lambda-case
             (((x) _ _ _ _ _)
-             (apply (lexical x _) (lexical x _))))))
-        (apply (lexical x _) (lexical x _))))
+             (call (lexical x _) (lexical x _))))))
+        (call (lexical x _) (lexical x _))))
 
   (pass-if-peval
     ;; First order, aliased primitive.
@@ -282,28 +278,28 @@
     (begin
       (define (+ x y) (pk x y))
       (+ 1 2))
-    (begin
+    (seq
       (define +
         (lambda (_)
           (lambda-case
            (((x y) #f #f #f () (_ _))
-            (apply (toplevel pk) (lexical x _) (lexical y _))))))
-      (apply (toplevel +) (const 1) (const 2))))
+            (call (toplevel pk) (lexical x _) (lexical y _))))))
+      (call (toplevel +) (const 1) (const 2))))
 
   (pass-if-peval
     ;; First-order, effects preserved.
     (let ((x 2))
       (do-something!)
       x)
-    (begin
-      (apply (toplevel do-something!))
+    (seq
+      (call (toplevel do-something!))
       (const 2)))
 
   (pass-if-peval
     ;; First order, residual bindings removed.
     (let ((x 2) (y 3))
       (* (+ x y) z))
-    (apply (primitive *) (const 5) (toplevel z)))
+    (primcall * (const 5) (toplevel z)))
 
   (pass-if-peval
     ;; First order, with lambda.
@@ -314,7 +310,7 @@
       (lambda (_)
         (lambda-case
          (((x) #f #f #f () (_))
-          (apply (primitive +) (lexical x _) (const 9)))))))
+          (primcall + (lexical x _) (const 9)))))))
 
   (pass-if-peval
     ;; First order, with lambda inlined & specialized twice.
@@ -324,22 +320,22 @@
           (y 3))
       (+ (* x (f x y))
          (f something x)))
-    (apply (primitive +)
-           (apply (primitive *)
-                  (const 2)
-                  (apply (primitive +)  ; (f 2 3)
-                         (apply (primitive *)
-                                (const 2)
-                                (toplevel top))
-                         (const 3)))
-           (let (x) (_) ((toplevel something))                    ; (f something 2)
-                ;; `something' is not const, so preserve order of
-                ;; effects with a lexical binding.
-                (apply (primitive +)
-                       (apply (primitive *)
-                              (lexical x _)
-                              (toplevel top))
-                       (const 2)))))
+    (primcall +
+              (primcall *
+                        (const 2)
+                        (primcall +     ; (f 2 3)
+                                  (primcall *
+                                            (const 2)
+                                            (toplevel top))
+                                  (const 3)))
+              (let (x) (_) ((toplevel something)) ; (f something 2)
+                   ;; `something' is not const, so preserve order of
+                   ;; effects with a lexical binding.
+                   (primcall +
+                             (primcall *
+                                       (lexical x _)
+                                       (toplevel top))
+                             (const 2)))))
   
   (pass-if-peval
    ;; First order, with lambda inlined & specialized 3 times.
@@ -349,15 +345,22 @@
         (f -1 y)
         (f 2 y)
         (f z y)))
-   (apply (primitive +)
-          (const -1)                      ; (f -1 0)
-          (const 0)                       ; (f 1 0)
-          (begin (toplevel y) (const -1)) ; (f -1 y)
-          (toplevel y)                    ; (f 2 y)
-          (let (x y) (_ _) ((toplevel z) (toplevel y)) ; (f z y)
-               (if (apply (primitive >) (lexical x _) (const 0))
-                   (lexical y _)
-                   (lexical x _)))))
+   (primcall
+    +
+    (const -1)                          ; (f -1 0)
+    (primcall
+     +
+     (const 0)                          ; (f 1 0)
+     (primcall
+      +
+      (seq (toplevel y) (const -1))     ; (f -1 y)
+      (primcall
+       +
+       (toplevel y)                                 ; (f 2 y)
+       (let (x y) (_ _) ((toplevel z) (toplevel y)) ; (f z y)
+            (if (primcall > (lexical x _) (const 0))
+                (lexical y _)
+                (lexical x _))))))))
 
   (pass-if-peval
     ;; First order, conditional.
@@ -369,7 +372,7 @@
     (lambda ()
       (lambda-case
        (((x) #f #f #f () (_))
-        (apply (toplevel display) (lexical x _))))))
+        (call (toplevel display) (lexical x _))))))
 
   (pass-if-peval
     ;; First order, recursive procedure.
@@ -388,8 +391,8 @@
      (foo)
      x)
    (let (x) (_) ((toplevel top))
-        (begin
-          (apply (toplevel foo))
+        (seq
+          (call (toplevel foo))
           (lexical x _))))
 
   (pass-if-peval
@@ -428,8 +431,8 @@
      (lambda (x)
        (+ x 1))
      '(2 3))
-    (let (y) (_) ((apply (toplevel foo)))
-         (apply (primitive +) (lexical y _) (const 7))))
+    (let (y) (_) ((call (toplevel foo)))
+         (primcall + (lexical y _) (const 7))))
 
   (pass-if-peval
     ;; Higher order with optional argument (caller-supplied value).
@@ -451,7 +454,7 @@
     ;; <https://lists.gnu.org/archive/html/bug-guile/2011-09/msg00019.html>.
     (let ((fold (lambda (f g) (f (g top)))))
       (fold 1+ (lambda (x) x)))
-    (apply (primitive 1+) (toplevel top)))
+    (primcall 1+ (toplevel top)))
   
   (pass-if-peval
     ;; Procedure not inlined when residual code contains recursive calls.
@@ -462,7 +465,7 @@
                          (f (car x3) (fold f (cdr x3) b null? car cdr))))))
       (fold * x 1 zero? (lambda (x1) x1) (lambda (x2) (- x2 1))))
     (letrec (fold) (_) (_)
-            (apply (lexical fold _)
+            (call (lexical fold _)
                    (primitive *)
                    (toplevel x)
                    (const 1)
@@ -474,7 +477,7 @@
                    (lambda ()
                      (lambda-case
                       (((x2) #f #f #f () (_))
-                       (apply (primitive -) (lexical x2 _) (const 1))))))))
+                       (primcall 1- (lexical x2 _))))))))
 
   (pass-if "inlined lambdas are alpha-renamed"
     ;; In this example, `make-adder' is inlined more than once; thus,
@@ -485,24 +488,27 @@
     ;; <https://lists.gnu.org/archive/html/bug-guile/2011-09/msg00019.html> and
     ;; <https://lists.gnu.org/archive/html/bug-guile/2011-09/msg00029.html>.
     (pmatch (unparse-tree-il
-             (peval (compile
-                     '(let ((make-adder
-                             (lambda (x) (lambda (y) (+ x y)))))
-                        (cons (make-adder 1) (make-adder 2)))
-                     #:to 'tree-il)))
-      ((apply (primitive cons)
-              (lambda ()
-                (lambda-case
-                 (((y) #f #f #f () (,gensym1))
-                  (apply (primitive +)
-                         (const 1)
-                         (lexical y ,ref1)))))
-              (lambda ()
-                (lambda-case
-                 (((y) #f #f #f () (,gensym2))
-                  (apply (primitive +)
-                         (const 2)
-                         (lexical y ,ref2))))))
+             (peval (expand-primitives!
+                     (resolve-primitives!
+                      (compile
+                       '(let ((make-adder
+                               (lambda (x) (lambda (y) (+ x y)))))
+                          (cons (make-adder 1) (make-adder 2)))
+                       #:to 'tree-il)
+                      (current-module)))))
+      ((primcall cons
+                 (lambda ()
+                   (lambda-case
+                    (((y) #f #f #f () (,gensym1))
+                     (primcall +
+                               (const 1)
+                               (lexical y ,ref1)))))
+                 (lambda ()
+                   (lambda-case
+                    (((y) #f #f #f () (,gensym2))
+                     (primcall +
+                               (const 2)
+                               (lexical y ,ref2))))))
        (and (eq? gensym1 ref1)
             (eq? gensym2 ref2)
             (not (eq? gensym1 gensym2))))
@@ -522,8 +528,8 @@
             (b (lambda () (a)))
             (c (lambda (x) x)))
      (c 10))
-   (begin (apply (toplevel foo!))
-          (const 10)))
+   (seq (call (toplevel foo!))
+        (const 10)))
 
   (pass-if-peval
     ;; Higher order, mutually recursive procedures.
@@ -544,9 +550,9 @@
     ;; Memv with non-constant list.  It could fold but doesn't
     ;; currently.
     (memv 1 (list 3 2 1))
-    (apply (primitive memv)
-           (const 1)
-           (apply (primitive list) (const 3) (const 2) (const 1))))
+    (primcall memv
+              (const 1)
+              (primcall list (const 3) (const 2) (const 1))))
 
   (pass-if-peval
     ;; Memv with non-constant key, constant list, test context
@@ -554,21 +560,20 @@
       ((3 2 1) 'a)
       (else 'b))
     (let (key) (_) ((toplevel foo))
-         (if (if (apply (primitive eqv?) (lexical key _) (const 3))
+         (if (if (primcall eqv? (lexical key _) (const 3))
                  (const #t)
-                 (if (apply (primitive eqv?) (lexical key _) (const 2))
+                 (if (primcall eqv? (lexical key _) (const 2))
                      (const #t)
-                     (apply (primitive eqv?) (lexical key _) (const 1))))
+                     (primcall eqv? (lexical key _) (const 1))))
              (const a)
              (const b))))
 
   (pass-if-peval
-    ;; Memv with non-constant key, empty list, test context.  Currently
-    ;; doesn't fold entirely.
+    ;; Memv with non-constant key, empty list, test context.
     (case foo
       (() 'a)
       (else 'b))
-    (begin (toplevel foo) (const b)))
+    (seq (toplevel foo) (const 'b)))
 
   ;;
   ;; Below are cases where constant propagation should bail out.
@@ -580,12 +585,12 @@
       (lambda (n)
         (vector-set! v n n)))
     (let (v) (_)
-         ((apply (toplevel make-vector) (const 6) (const #f)))
+         ((call (toplevel make-vector) (const 6) (const #f)))
          (lambda ()
            (lambda-case
             (((n) #f #f #f () (_))
-             (apply (toplevel vector-set!)
-                    (lexical v _) (lexical n _) (lexical n _)))))))
+             (primcall vector-set!
+                       (lexical v _) (lexical n _) (lexical n _)))))))
 
   (pass-if-peval
     ;; Mutable lexical is not propagated.
@@ -593,7 +598,7 @@
       (lambda ()
         v))
     (let (v) (_)
-         ((apply (primitive vector) (const 1) (const 2) (const 3)))
+         ((primcall vector (const 1) (const 2) (const 3)))
          (lambda ()
            (lambda-case
             ((() #f #f #f () ())
@@ -604,12 +609,13 @@
     (let* ((x (if (> p q) (frob!) (display 'chbouib)))
            (y (* x 2)))
       (+ x x y))
-    (let (x) (_) ((if (apply (primitive >) (toplevel p) (toplevel q))
-                      (apply (toplevel frob!))
-                      (apply (toplevel display) (const chbouib))))
-         (let (y) (_) ((apply (primitive *) (lexical x _) (const 2)))
-              (apply (primitive +)
-                     (lexical x _) (lexical x _) (lexical y _)))))
+    (let (x) (_) ((if (primcall > (toplevel p) (toplevel q))
+                      (call (toplevel frob!))
+                      (call (toplevel display) (const chbouib))))
+         (let (y) (_) ((primcall * (lexical x _) (const 2)))
+              (primcall +
+                        (lexical x _)
+                        (primcall + (lexical x _) (lexical y _))))))
 
   (pass-if-peval
     ;; Non-constant arguments not propagated to lambdas.
@@ -621,16 +627,16 @@
      (make-list 10)
      (list 1 2 3))
     (let (x y z) (_ _ _)
-         ((apply (primitive vector) (const 1) (const 2) (const 3))
-          (apply (toplevel make-list) (const 10))
-          (apply (primitive list) (const 1) (const 2) (const 3)))
-         (begin
-           (apply (toplevel vector-set!)
-                  (lexical x _) (const 0) (const 0))
-           (apply (toplevel set-car!)
-                  (lexical y _) (const 0))
-           (apply (toplevel set-cdr!)
-                  (lexical z _) (const ())))))
+         ((primcall vector (const 1) (const 2) (const 3))
+          (call (toplevel make-list) (const 10))
+          (primcall list (const 1) (const 2) (const 3)))
+         (seq
+           (primcall vector-set!
+                     (lexical x _) (const 0) (const 0))
+           (seq (primcall set-car!
+                          (lexical y _) (const 0))
+                (primcall set-cdr!
+                          (lexical z _) (const ()))))))
 
   (pass-if-peval
    (let ((foo top-foo) (bar top-bar))
@@ -638,9 +644,9 @@
             (f (lambda (g x) (g x x))))
        (+ (f g foo) (f g bar))))
    (let (foo bar) (_ _) ((toplevel top-foo) (toplevel top-bar))
-        (apply (primitive +)
-               (apply (primitive +) (lexical foo _) (lexical foo _))
-               (apply (primitive +) (lexical bar _) (lexical bar _)))))
+        (primcall +
+                  (primcall + (lexical foo _) (lexical foo _))
+                  (primcall + (lexical bar _) (lexical bar _)))))
 
   (pass-if-peval
     ;; Fresh objects are not turned into constants, nor are constants
@@ -649,8 +655,8 @@
            (x (cons 1 c))
            (y (cons 0 x)))
       y)
-    (let (x) (_) ((apply (primitive cons) (const 1) (const (2 3))))
-         (apply (primitive cons) (const 0) (lexical x _))))
+    (let (x) (_) ((primcall cons (const 1) (const (2 3))))
+         (primcall cons (const 0) (lexical x _))))
 
   (pass-if-peval
     ;; Bindings mutated.
@@ -658,7 +664,7 @@
       (set! x 3)
       x)
     (let (x) (_) ((const 2))
-         (begin
+         (seq
            (set! (lexical x _) (const 3))
            (lexical x _))))
 
@@ -671,8 +677,8 @@
       (frob f) ; may mutate `x'
       x)
     (letrec (x) (_) ((const 0))
-            (begin
-              (apply (toplevel frob) (lambda _ _))
+            (seq
+              (call (toplevel frob) (lambda _ _))
               (lexical x _))))
 
   (pass-if-peval
@@ -688,9 +694,9 @@
     (let ((x (make-foo)))
       (frob! x) ; may mutate `x'
       x)
-    (let (x) (_) ((apply (toplevel make-foo)))
-         (begin
-           (apply (toplevel frob!) (lexical x _))
+    (let (x) (_) ((call (toplevel make-foo)))
+         (seq
+           (call (toplevel frob!) (lexical x _))
            (lexical x _))))
 
   (pass-if-peval
@@ -701,10 +707,10 @@
                           (lambda-case
                            (((x) #f #f #f () (_))
                             (if _ _
-                                (apply (lexical loop _)
-                                       (apply (primitive 1-)
-                                              (lexical x _))))))))
-            (apply (lexical loop _) (toplevel x))))
+                                (call (lexical loop _)
+                                       (primcall 1-
+                                                 (lexical x _))))))))
+            (call (lexical loop _) (toplevel x))))
 
   (pass-if-peval
     ;; Recursion on the 2nd argument is fully evaluated.
@@ -713,8 +719,8 @@
         (if (> y 0)
             (loop x (1- y))
             (foo x y))))
-    (let (x) (_) ((apply (toplevel top)))
-         (apply (toplevel foo) (lexical x _) (const 0))))
+    (let (x) (_) ((call (toplevel top)))
+         (call (toplevel foo) (lexical x _) (const 0))))
 
   (pass-if-peval
     ;; Inlining aborted when residual code contains recursive calls.
@@ -729,10 +735,10 @@
     (letrec (loop) (_) ((lambda (_)
                           (lambda-case
                            (((x y) #f #f #f () (_ _))
-                            (if (apply (primitive >)
-                                       (lexical y _) (const 0))
+                            (if (primcall >
+                                          (lexical y _) (const 0))
                                 _ _)))))
-            (apply (lexical loop _) (toplevel x) (const 0))))
+            (call (lexical loop _) (toplevel x) (const 0))))
 
   (pass-if-peval
     ;; Infinite recursion: `peval' gives up and leaves it as is.
@@ -749,7 +755,7 @@
       (and (< x top)
            (loop (1+ x))))
     (letrec (loop) (_) ((lambda . _))
-            (apply (lexical loop _) (const 0))))
+            (call (lexical loop _) (const 0))))
 
   (pass-if-peval
     ;; This test checks that the `start' binding is indeed residualized.
@@ -760,10 +766,10 @@
         (here)))
     (let (pos) (_) ((const 0))
          (let (here) (_) (_)
-              (begin
-                (set! (lexical pos _) (const 1))
-                (apply (lexical here _))))))
-  
+              (seq
+               (set! (lexical pos _) (const 1))
+               (call (lexical here _))))))
+
   (pass-if-peval
    ;; FIXME: should this one residualize the binding?
    (letrec ((a a))
@@ -799,7 +805,7 @@
      ((lambda _
         (lambda-case
          ((() #f #f #f () ())
-          (apply (lexical a _)))))
+          (call (lexical a _)))))
       (lambda _
         (lambda-case
          (((x) #f #f #f () (_))
@@ -807,12 +813,11 @@
       (lambda _
         (lambda-case
          ((() #f #f #f () ())
-          (apply (lexical a _))))))
+          (call (lexical a _))))))
      (let (d)
        (_)
-       ((apply (toplevel foo) (lexical b _)))
-       (apply (lexical c _)
-              (lexical d _)))))
+       ((call (toplevel foo) (lexical b _)))
+       (call (lexical c _) (lexical d _)))))
 
   (pass-if-peval
    ;; In this case, we can prune the bindings.  `a' ends up being copied
@@ -821,17 +826,17 @@
    (letrec* ((a (lambda (x) (top x)))
              (b (lambda () a)))
      (foo (b) (b)))
-   (apply (toplevel foo)
-          (lambda _
-            (lambda-case
-             (((x) #f #f #f () (_))
-              (apply (toplevel top) (lexical x _)))))
-          (lambda _
-            (lambda-case
-             (((x) #f #f #f () (_))
-              (apply (toplevel top) (lexical x _)))))))
+   (call (toplevel foo)
+         (lambda _
+           (lambda-case
+            (((x) #f #f #f () (_))
+             (call (toplevel top) (lexical x _)))))
+         (lambda _
+           (lambda-case
+            (((x) #f #f #f () (_))
+             (call (toplevel top) (lexical x _)))))))
   
-  (pass-if-peval resolve-primitives
+  (pass-if-peval
     ;; The inliner sees through a `let'.
     ((let ((a 10)) (lambda (b) (* b 2))) 30)
     (const 60))
@@ -848,39 +853,39 @@
       ((lambda (x y . z)
          (list x y z))
        1 2 3 4)
-    (let (z) (_) ((apply (primitive list) (const 3) (const 4)))
-         (apply (primitive list) (const 1) (const 2) (lexical z _))))
+    (let (z) (_) ((primcall list (const 3) (const 4)))
+         (primcall list (const 1) (const 2) (lexical z _))))
 
-  (pass-if-peval resolve-primitives
+  (pass-if-peval
     ;; Unmutated lists can get inlined.
     (let ((args (list 2 3)))
       (apply (lambda (x y z w)
                (list x y z w))
              0 1 args))
-    (apply (primitive list) (const 0) (const 1) (const 2) (const 3)))
+    (primcall list (const 0) (const 1) (const 2) (const 3)))
 
-  (pass-if-peval resolve-primitives
+  (pass-if-peval
     ;; However if the list might have been mutated, it doesn't propagate.
     (let ((args (list 2 3)))
       (foo! args)
       (apply (lambda (x y z w)
                (list x y z w))
              0 1 args))
-    (let (args) (_) ((apply (primitive list) (const 2) (const 3)))
-         (begin
-           (apply (toplevel foo!) (lexical args _))
-           (apply (primitive @apply)
-                  (lambda ()
-                    (lambda-case
-                     (((x y z w) #f #f #f () (_ _ _ _))
-                      (apply (primitive list)
-                             (lexical x _) (lexical y _)
-                             (lexical z _) (lexical w _)))))
-                  (const 0)
-                  (const 1)
-                  (lexical args _)))))
-
-  (pass-if-peval resolve-primitives
+    (let (args) (_) ((primcall list (const 2) (const 3)))
+         (seq
+          (call (toplevel foo!) (lexical args _))
+          (primcall @apply
+                    (lambda ()
+                      (lambda-case
+                       (((x y z w) #f #f #f () (_ _ _ _))
+                        (primcall list
+                                  (lexical x _) (lexical y _)
+                                  (lexical z _) (lexical w _)))))
+                    (const 0)
+                    (const 1)
+                    (lexical args _)))))
+
+  (pass-if-peval
     ;; Here the `args' that gets built by the application of the lambda
     ;; takes more than effort "10" to visit.  Test that we fall back to
     ;; the source expression of the operand, which is still a call to
@@ -909,27 +914,27 @@
     (lambda ()
       (lambda-case
        (((bv offset n) #f #f #f () (_ _ _))
-        (let (x y) (_ _) ((apply (primitive bytevector-ieee-single-native-ref)
-                                 (lexical bv _)
-                                 (apply (primitive +)
-                                        (lexical offset _) (const 0)))
-                          (apply (primitive bytevector-ieee-single-native-ref)
-                                 (lexical bv _)
-                                 (apply (primitive +)
-                                        (lexical offset _) (const 4))))
-             (begin
-               (apply (primitive bytevector-ieee-single-native-set!)
-                     (lexical bv _)
-                     (apply (primitive +)
-                            (lexical offset _) (const 0))
-                     (lexical x _))
-               (apply (primitive bytevector-ieee-single-native-set!)
-                      (lexical bv _)
-                      (apply (primitive +)
-                             (lexical offset _) (const 4))
-                      (lexical y _))))))))
-
-  (pass-if-peval resolve-primitives
+        (let (x y) (_ _) ((primcall bytevector-ieee-single-native-ref
+                                    (lexical bv _)
+                                    (primcall +
+                                              (lexical offset _) (const 0)))
+                          (primcall bytevector-ieee-single-native-ref
+                                    (lexical bv _)
+                                    (primcall +
+                                              (lexical offset _) (const 4))))
+             (seq
+              (primcall bytevector-ieee-single-native-set!
+                        (lexical bv _)
+                        (primcall +
+                                  (lexical offset _) (const 0))
+                        (lexical x _))
+              (primcall bytevector-ieee-single-native-set!
+                        (lexical bv _)
+                        (primcall +
+                                  (lexical offset _) (const 4))
+                        (lexical y _))))))))
+
+  (pass-if-peval
     ;; Here we ensure that non-constant expressions are not copied.
     (lambda ()
       (let ((args (list (foo!))))
@@ -943,13 +948,13 @@
     (lambda ()
       (lambda-case
        ((() #f #f #f () ())
-        (let (_) (_) ((apply (toplevel foo!)))
+        (let (_) (_) ((call (toplevel foo!)))
              (let (z) (_) ((toplevel z))
-                  (apply (primitive 'list)
-                         (lexical z _)
-                         (lexical _ _))))))))
+                  (primcall 'list
+                            (lexical z _)
+                            (lexical _ _))))))))
 
-  (pass-if-peval resolve-primitives
+  (pass-if-peval
     ;; Rest args referenced more than once are not destructured.
     (lambda ()
       (let ((args (list 'foo)))
@@ -963,25 +968,25 @@
       (lambda-case
        ((() #f #f #f () ())
         (let (args) (_)
-             ((apply (primitive list) (const foo)))
-             (begin
-               (apply (primitive set-car!) (lexical args _) (const bar))
-               (apply (primitive @apply)
-                     (lambda . _)
-                     (toplevel z)
-                     (lexical args _))))))))
-
-  (pass-if-peval resolve-primitives
+             ((primcall list (const foo)))
+             (seq
+              (primcall set-car! (lexical args _) (const bar))
+              (primcall @apply
+                        (lambda . _)
+                        (toplevel z)
+                        (lexical args _))))))))
+
+  (pass-if-peval
     ;; Let-values inlining, even with consumers with rest args.
     (call-with-values (lambda () (values 1 2))
       (lambda args
         (apply list args)))
-    (apply (primitive list) (const 1) (const 2)))
+    (primcall list (const 1) (const 2)))
 
   (pass-if-peval
    ;; Constant folding: cons of #nil does not make list
    (cons 1 #nil)
-   (apply (primitive cons) (const 1) (const '#nil)))
+   (primcall cons (const 1) (const '#nil)))
   
   (pass-if-peval
     ;; Constant folding: cons
@@ -991,7 +996,7 @@
   (pass-if-peval
     ;; Constant folding: cons
    (begin (cons (foo) 2) #f)
-   (begin (apply (toplevel foo)) (const #f)))
+   (seq (call (toplevel foo)) (const #f)))
   
   (pass-if-peval
     ;; Constant folding: cons
@@ -1011,12 +1016,12 @@
   (pass-if-peval
    ;; Constant folding: car+cons, impure
    (car (cons 1 (bar)))
-   (begin (apply (toplevel bar)) (const 1)))
+   (seq (call (toplevel bar)) (const 1)))
   
   (pass-if-peval
    ;; Constant folding: cdr+cons, impure
    (cdr (cons (bar) 0))
-   (begin (apply (toplevel bar)) (const 0)))
+   (seq (call (toplevel bar)) (const 0)))
   
   (pass-if-peval
    ;; Constant folding: car+list
@@ -1026,40 +1031,53 @@
   (pass-if-peval
    ;; Constant folding: cdr+list
    (cdr (list 1 0))
-   (apply (primitive list) (const 0)))
+   (primcall list (const 0)))
   
   (pass-if-peval
    ;; Constant folding: car+list, impure
    (car (list 1 (bar)))
-   (begin (apply (toplevel bar)) (const 1)))
+   (seq (call (toplevel bar)) (const 1)))
   
   (pass-if-peval
    ;; Constant folding: cdr+list, impure
    (cdr (list (bar) 0))
-   (begin (apply (toplevel bar)) (apply (primitive list) (const 0))))
+   (seq (call (toplevel bar)) (primcall list (const 0))))
+
+  (pass-if-peval
+   ;; Equality primitive: same lexical
+   (let ((x (random))) (eq? x x))
+   (seq (call (toplevel random)) (const #t)))
+
+  (pass-if-peval
+   ;; Equality primitive: merge lexical identities
+   (let* ((x (random)) (y x)) (eq? x y))
+   (seq (call (toplevel random)) (const #t)))
   
   (pass-if-peval
-   resolve-primitives
    ;; Non-constant guards get lexical bindings.
    (dynamic-wind foo (lambda () bar) baz)
-   (let (pre post) (_ _) ((toplevel foo) (toplevel baz))
-        (dynwind (lexical pre _) (toplevel bar) (lexical post _))))
+   (let (w u) (_ _) ((toplevel foo) (toplevel baz))
+        (dynwind (lexical w _)
+                 (call (lexical w _))
+                 (toplevel bar)
+                 (call (lexical u _))
+                 (lexical u _))))
   
   (pass-if-peval
-   resolve-primitives
    ;; Constant guards don't need lexical bindings.
    (dynamic-wind (lambda () foo) (lambda () bar) (lambda () baz))
    (dynwind
     (lambda ()
       (lambda-case
        ((() #f #f #f () ()) (toplevel foo))))
+    (toplevel foo)
     (toplevel bar)
+    (toplevel baz)
     (lambda ()
       (lambda-case
        ((() #f #f #f () ()) (toplevel baz))))))
   
   (pass-if-peval
-   resolve-primitives
    ;; Prompt is removed if tag is unreferenced
    (let ((tag (make-prompt-tag)))
      (call-with-prompt tag
@@ -1068,7 +1086,6 @@
    (const 1))
   
   (pass-if-peval
-   resolve-primitives
    ;; Prompt is removed if tag is unreferenced, with explicit stem
    (let ((tag (make-prompt-tag "foo")))
      (call-with-prompt tag
@@ -1078,7 +1095,6 @@
 
   ;; Handler lambda inlined
   (pass-if-peval
-   resolve-primitives
    (call-with-prompt tag
                      (lambda () 1)
                      (lambda (k x) x))
@@ -1090,7 +1106,6 @@
 
   ;; Handler toplevel not inlined
   (pass-if-peval
-   resolve-primitives
    (call-with-prompt tag
                      (lambda () 1)
                      handler)
@@ -1099,12 +1114,11 @@
                 (const 1)
                 (lambda-case
                  ((() #f args #f () (_))
-                  (apply (primitive @apply)
-                         (lexical handler _)
-                         (lexical args _)))))))
+                  (primcall @apply
+                            (lexical handler _)
+                            (lexical args _)))))))
 
   (pass-if-peval
-   resolve-primitives
    ;; `while' without `break' or `continue' has no prompts and gets its
    ;; condition folded.  Unfortunately the outer `lp' does not yet get
    ;; elided, and the continuation tag stays around.  (The continue tag
@@ -1113,7 +1127,7 @@
    ;; twice before aborting.  The abort doesn't unroll the recursive
    ;; reference.)
    (while #t #t)
-   (let (_) (_) ((apply (primitive make-prompt-tag) . _))
+   (let (_) (_) ((primcall make-prompt-tag . _))
         (letrec (lp) (_)
                 ((lambda _
                    (lambda-case
@@ -1122,12 +1136,11 @@
                              ((lambda _
                                 (lambda-case
                                  ((() #f #f #f () ())
-                                  (apply (lexical loop _))))))
-                             (apply (lexical loop _)))))))
-                (apply (lexical lp _)))))
+                                  (call (lexical loop _))))))
+                             (call (lexical loop _)))))))
+                (call (lexical lp _)))))
 
   (pass-if-peval
-   resolve-primitives
    (lambda (a . rest)
      (apply (lambda (x y) (+ x y))
             a rest))
@@ -1136,7 +1149,7 @@
       (((x y) #f #f #f () (_ _))
        _))))
 
-  (pass-if-peval resolve-primitives
+  (pass-if-peval
     (car '(1 2))
     (const 1))
 
@@ -1145,17 +1158,17 @@
   ;; residualizing a reference to the leaf identifier.  The bailout is
   ;; driven by the recursive-effort-limit, which is currently 100.  We
   ;; make sure to trip it with this recursive sum thing.
-  (pass-if-peval resolve-primitives
+  (pass-if-peval
     (let ((x (let sum ((n 0) (out 0))
                (if (< n 10000)
                    (sum (1+ n) (+ out n))
                    out))))
       ((lambda (y) (list y)) x))
     (let (x) (_) (_)
-         (apply (primitive list) (lexical x _))))
+         (primcall list (lexical x _))))
 
   ;; Here we test that a common test in a chain of ifs gets lifted.
-  (pass-if-peval resolve-primitives
+  (pass-if-peval
     (if (and (struct? x) (eq? (struct-vtable x) A))
         (foo x)
         (if (and (struct? x) (eq? (struct-vtable x) B))
@@ -1166,25 +1179,25 @@
     (let (failure) (_) ((lambda _
                           (lambda-case
                            ((() #f #f #f () ())
-                            (apply (toplevel qux) (toplevel x))))))
-         (if (apply (primitive struct?) (toplevel x))
-             (if (apply (primitive eq?)
-                        (apply (primitive struct-vtable) (toplevel x))
-                        (toplevel A))
-                 (apply (toplevel foo) (toplevel x))
-                 (if (apply (primitive eq?)
-                            (apply (primitive struct-vtable) (toplevel x))
-                            (toplevel B))
-                     (apply (toplevel bar) (toplevel x))
-                     (if (apply (primitive eq?)
-                                (apply (primitive struct-vtable) (toplevel x))
-                                (toplevel C))
-                         (apply (toplevel baz) (toplevel x))
-                         (apply (lexical failure _)))))
-             (apply (lexical failure _)))))
+                            (call (toplevel qux) (toplevel x))))))
+         (if (primcall struct? (toplevel x))
+             (if (primcall eq?
+                           (primcall struct-vtable (toplevel x))
+                           (toplevel A))
+                 (call (toplevel foo) (toplevel x))
+                 (if (primcall eq?
+                               (primcall struct-vtable (toplevel x))
+                               (toplevel B))
+                     (call (toplevel bar) (toplevel x))
+                     (if (primcall eq?
+                                   (primcall struct-vtable (toplevel x))
+                                   (toplevel C))
+                         (call (toplevel baz) (toplevel x))
+                         (call (lexical failure _)))))
+             (call (lexical failure _)))))
 
   ;; Multiple common tests should get lifted as well.
-  (pass-if-peval resolve-primitives
+  (pass-if-peval
     (if (and (struct? x) (eq? (struct-vtable x) A) B)
         (foo x)
         (if (and (struct? x) (eq? (struct-vtable x) A) C)
@@ -1195,32 +1208,32 @@
     (let (failure) (_) ((lambda _
                           (lambda-case
                            ((() #f #f #f () ())
-                            (apply (toplevel qux) (toplevel x))))))
-         (if (apply (primitive struct?) (toplevel x))
-             (if (apply (primitive eq?)
-                        (apply (primitive struct-vtable) (toplevel x))
-                        (toplevel A))
+                            (call (toplevel qux) (toplevel x))))))
+         (if (primcall struct? (toplevel x))
+             (if (primcall eq?
+                           (primcall struct-vtable (toplevel x))
+                           (toplevel A))
                  (if (toplevel B)
-                     (apply (toplevel foo) (toplevel x))
+                     (call (toplevel foo) (toplevel x))
                      (if (toplevel C)
-                         (apply (toplevel bar) (toplevel x))
+                         (call (toplevel bar) (toplevel x))
                          (if (toplevel D)
-                             (apply (toplevel baz) (toplevel x))
-                             (apply (lexical failure _)))))
-                 (apply (lexical failure _)))
-             (apply (lexical failure _)))))
+                             (call (toplevel baz) (toplevel x))
+                             (call (lexical failure _)))))
+                 (call (lexical failure _)))
+             (call (lexical failure _)))))
 
-  (pass-if-peval resolve-primitives
+  (pass-if-peval
     (apply (lambda (x y) (cons x y)) '(1 2))
-    (apply (primitive cons) (const 1) (const 2)))
+    (primcall cons (const 1) (const 2)))
 
-  (pass-if-peval resolve-primitives
+  (pass-if-peval
     (apply (lambda (x y) (cons x y)) (list 1 2))
-    (apply (primitive cons) (const 1) (const 2)))
+    (primcall cons (const 1) (const 2)))
 
-  (pass-if-peval resolve-primitives
+  (pass-if-peval
     (let ((t (make-prompt-tag)))
       (call-with-prompt t
                         (lambda () (abort-to-prompt t 1 2 3))
                         (lambda (k x y z) (list x y z))))
-    (apply (primitive 'list) (const 1) (const 2) (const 3))))
+    (primcall list (const 1) (const 2) (const 3))))