Merge commit 'de1eb420a5a95b17e85b19c4d98c869036e9ecb0'

[bpt/guile.git] / test-suite / tests / tree-il.test

diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 2d0784e..63baef9 100644 (file)
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -84,15 +84,15 @@
    (begin (void) (const 1))
    (program () (std-prelude 0 0 #f) (label _) (const 1) (call return 1)))
   (assert-tree-il->glil
-   (apply (primitive +) (void) (const 1))
+   (primcall + (void) (const 1))
    (program () (std-prelude 0 0 #f) (label _) (void) (call add1 1) (call return 1))))
 
 (with-test-prefix "application"
   (assert-tree-il->glil
-   (apply (toplevel foo) (const 1))
+   (call (toplevel foo) (const 1))
    (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (const 1) (call tail-call 1)))
   (assert-tree-il->glil
-   (begin (apply (toplevel foo) (const 1)) (void))
+   (begin (call (toplevel foo) (const 1)) (void))
    (program () (std-prelude 0 0 #f) (label _) (call new-frame 0) (toplevel ref foo) (const 1) (mv-call 1 ,l1)
             (call drop 1) (branch br ,l2)
             (label ,l3) (mv-bind 0 #f)
@@ -100,7 +100,7 @@
             (void) (call return 1))
    (and (eq? l1 l3) (eq? l2 l4)))
   (assert-tree-il->glil
-   (apply (toplevel foo) (apply (toplevel bar)))
+   (call (toplevel foo) (call (toplevel bar)))
    (program ()  (std-prelude 0 0 #f) (label _) (toplevel ref foo) (call new-frame 0) (toplevel ref bar) (call call 0)
             (call tail-call 1))))
 
@@ -119,7 +119,7 @@
    (eq? l1 l3) (eq? l2 l4))
 
   (assert-tree-il->glil
-   (apply (primitive null?) (if (toplevel foo) (const 1) (const 2)))
+   (primcall null? (if (toplevel foo) (const 1) (const 2)))
    (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (branch br-if-not ,l1)
             (const 1) (branch br ,l2)
                     (label ,l3) (const 2) (label ,l4)
@@ -136,7 +136,7 @@
    (program () (std-prelude 0 0 #f) (label _) (const #f) (call return 1)))
 
   (assert-tree-il->glil
-   (apply (primitive null?) (primitive +))
+   (primcall null? (primitive +))
    (program () (std-prelude 0 0 #f) (label _) (toplevel ref +) (call null? 1)
             (call return 1))))
 
@@ -156,7 +156,7 @@
             (unbind)))
 
   (assert-tree-il->glil without-partial-evaluation
-   (let (x) (y) ((const 1)) (apply (primitive null?) (lexical x y)))
+   (let (x) (y) ((const 1)) (primcall null? (lexical x y)))
    (program () (std-prelude 0 1 #f) (label _)
             (const 1) (bind (x #f 0)) (lexical #t #f set 0)
             (lexical #t #f ref 0) (call null? 1) (call return 1)
@@ -166,7 +166,7 @@
   (assert-tree-il->glil
    ;; unreferenced sets may be optimized away -- make sure they are ref'd
    (let (x) (y) ((const 1))
-        (set! (lexical x y) (apply (primitive 1+) (lexical x y))))
+        (set! (lexical x y) (primcall 1+ (lexical x y))))
    (program () (std-prelude 0 1 #f) (label _)
             (const 1) (bind (x #t 0)) (lexical #t #t box 0)
             (lexical #t #t ref 0) (call add1 1) (lexical #t #t set 0)
@@ -175,7 +175,7 @@
 
   (assert-tree-il->glil
    (let (x) (y) ((const 1))
-        (begin (set! (lexical x y) (apply (primitive 1+) (lexical x y)))
+        (begin (set! (lexical x y) (primcall 1+ (lexical x y)))
                (lexical x y)))
    (program () (std-prelude 0 1 #f) (label _)
             (const 1) (bind (x #t 0)) (lexical #t #t box 0)
@@ -185,8 +185,8 @@
 
   (assert-tree-il->glil
    (let (x) (y) ((const 1))
-     (apply (primitive null?)
-            (set! (lexical x y) (apply (primitive 1+) (lexical x y)))))
+     (primcall null?
+           (set! (lexical x y) (primcall 1+ (lexical x y)))))
    (program () (std-prelude 0 1 #f) (label _)
             (const 1) (bind (x #t 0)) (lexical #t #t box 0)
             (lexical #t #t ref 0) (call add1 1) (lexical #t #t set 0) (void)
@@ -207,7 +207,7 @@
             (const #f) (call return 1)))
 
   (assert-tree-il->glil
-   (apply (primitive null?) (@ (foo) bar))
+   (primcall null? (@ (foo) bar))
    (program () (std-prelude 0 0 #f) (label _)
             (module public ref (foo) bar)
             (call null? 1) (call return 1)))
@@ -225,7 +225,7 @@
             (const #f) (call return 1)))
 
   (assert-tree-il->glil
-   (apply (primitive null?) (@@ (foo) bar))
+   (primcall null? (@@ (foo) bar))
    (program () (std-prelude 0 0 #f) (label _)
             (module private ref (foo) bar)
             (call null? 1) (call return 1))))
@@ -244,7 +244,7 @@
             (const #f) (call return 1)))
 
   (assert-tree-il->glil
-   (apply (primitive null?) (set! (@ (foo) bar) (const 2)))
+   (primcall null? (set! (@ (foo) bar) (const 2)))
    (program () (std-prelude 0 0 #f) (label _)
             (const 2) (module public set (foo) bar)
             (void) (call null? 1) (call return 1)))
@@ -262,7 +262,7 @@
             (const #f) (call return 1)))
 
   (assert-tree-il->glil
-   (apply (primitive null?) (set! (@@ (foo) bar) (const 2)))
+   (primcall null? (set! (@@ (foo) bar) (const 2)))
    (program () (std-prelude 0 0 #f) (label _)
             (const 2) (module private set (foo) bar)
             (void) (call null? 1) (call return 1))))
@@ -281,7 +281,7 @@
             (const #f) (call return 1)))
 
   (assert-tree-il->glil
-   (apply (primitive null?) (toplevel bar))
+   (primcall null? (toplevel bar))
    (program () (std-prelude 0 0 #f) (label _)
             (toplevel ref bar)
             (call null? 1) (call return 1))))
@@ -300,7 +300,7 @@
             (const #f) (call return 1)))
 
   (assert-tree-il->glil
-   (apply (primitive null?) (set! (toplevel bar) (const 2)))
+   (primcall null? (set! (toplevel bar) (const 2)))
    (program () (std-prelude 0 0 #f) (label _)
             (const 2) (toplevel set bar)
             (void) (call null? 1) (call return 1))))
@@ -319,7 +319,7 @@
             (const #f) (call return 1)))
 
   (assert-tree-il->glil
-   (apply (primitive null?) (define bar (const 2)))
+   (primcall null? (define bar (const 2)))
    (program () (std-prelude 0 0 #f) (label _)
             (const 2) (toplevel define bar)
             (void) (call null? 1) (call return 1))))
@@ -337,7 +337,7 @@
 
   (assert-tree-il->glil
    ;; This gets simplified by `peval'.
-   (apply (primitive null?) (const 2))
+   (primcall null? (const 2))
    (program () (std-prelude 0 0 #f) (label _)
             (const #f) (call return 1))))
 
@@ -345,7 +345,7 @@
   ;; simple bindings -> let
   (assert-tree-il->glil without-partial-evaluation
    (letrec (x y) (x1 y1) ((const 10) (const 20))
-           (apply (toplevel foo) (lexical x x1) (lexical y y1)))
+           (call (toplevel foo) (lexical x x1) (lexical y y1)))
    (program () (std-prelude 0 2 #f) (label _)
             (const 10) (const 20)
             (bind (x #f 0) (y #f 1))
@@ -357,8 +357,8 @@
 
   ;; complex bindings -> box and set! within let
   (assert-tree-il->glil without-partial-evaluation
-   (letrec (x y) (x1 y1) ((apply (toplevel foo)) (apply (toplevel bar)))
-           (apply (primitive +) (lexical x x1) (lexical y y1)))
+   (letrec (x y) (x1 y1) ((call (toplevel foo)) (call (toplevel bar)))
+           (primcall + (lexical x x1) (lexical y y1)))
    (program () (std-prelude 0 4 #f) (label _)
             (void) (void) ;; what are these?
             (bind (x #t 0) (y #t 1))
@@ -375,8 +375,8 @@
   
   ;; complex bindings in letrec* -> box and set! in order
   (assert-tree-il->glil without-partial-evaluation
-   (letrec* (x y) (x1 y1) ((apply (toplevel foo)) (apply (toplevel bar)))
-            (apply (primitive +) (lexical x x1) (lexical y y1)))
+   (letrec* (x y) (x1 y1) ((call (toplevel foo)) (call (toplevel bar)))
+            (primcall + (lexical x x1) (lexical y y1)))
    (program () (std-prelude 0 2 #f) (label _)
             (void) (void) ;; what are these?
             (bind (x #t 0) (y #t 1))
@@ -495,38 +495,38 @@
 
   (assert-tree-il->glil
    ;; This gets simplified by `peval'.
-   (apply (primitive null?) (begin (const #f) (const 2)))
+   (primcall null? (begin (const #f) (const 2)))
    (program () (std-prelude 0 0 #f) (label _)
             (const #f) (call return 1))))
 
 (with-test-prefix "values"
   (assert-tree-il->glil
-   (apply (primitive values)
-          (apply (primitive values) (const 1) (const 2)))
+   (primcall values
+             (primcall values (const 1) (const 2)))
    (program () (std-prelude 0 0 #f) (label _)
             (const 1) (call return 1)))
 
   (assert-tree-il->glil
-   (apply (primitive values)
-          (apply (primitive values) (const 1) (const 2))
-          (const 3))
+   (primcall values
+             (primcall values (const 1) (const 2))
+             (const 3))
    (program () (std-prelude 0 0 #f) (label _)
             (const 1) (const 3) (call return/values 2)))
 
   (assert-tree-il->glil
-   (apply (primitive +)
-          (apply (primitive values) (const 1) (const 2)))
+   (primcall +
+             (primcall values (const 1) (const 2)))
    (program () (std-prelude 0 0 #f) (label _)
             (const 1) (call return 1)))
 
   ;; Testing `(values foo)' in push context with RA.
   (assert-tree-il->glil without-partial-evaluation
-   (apply (primitive cdr)
-          (letrec (lp) (#{lp ~V9KrhVD4PFEL6oCTrLg3A}#)
-                  ((lambda ((name . lp))
-                     (lambda-case ((() #f #f #f () ())
-                                   (apply (toplevel values) (const (one two)))))))
-                  (apply (lexical lp #{lp ~V9KrhVD4PFEL6oCTrLg3A}#))))
+   (primcall cdr
+             (letrec (lp) (#{lp ~V9KrhVD4PFEL6oCTrLg3A}#)
+                     ((lambda ((name . lp))
+                        (lambda-case ((() #f #f #f () ())
+                                      (primcall values (const (one two)))))))
+                     (call (lexical lp #{lp ~V9KrhVD4PFEL6oCTrLg3A}#))))
    (program () (std-prelude 0 0 #f) (label _)
             (branch br _) ;; entering the fix, jump to :2
             ;; :1 body of lp, jump to :3
@@ -574,10 +574,10 @@
 
 (with-test-prefix "apply"
   (assert-tree-il->glil
-   (apply (primitive @apply) (toplevel foo) (toplevel bar))
+   (primcall @apply (toplevel foo) (toplevel bar))
    (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (toplevel ref bar) (call tail-apply 2)))
   (assert-tree-il->glil
-   (begin (apply (primitive @apply) (toplevel foo) (toplevel bar)) (void))
+   (begin (primcall @apply (toplevel foo) (toplevel bar)) (void))
    (program () (std-prelude 0 0 #f) (label _)
             (call new-frame 0) (toplevel ref apply) (toplevel ref foo) (toplevel ref bar) (mv-call 2 ,l1)
             (call drop 1) (branch br ,l2) (label ,l3) (mv-bind 0 #f)
@@ -585,7 +585,7 @@
             (void) (call return 1))
    (and (eq? l1 l3) (eq? l2 l4)))
   (assert-tree-il->glil
-   (apply (toplevel foo) (apply (toplevel @apply) (toplevel bar) (toplevel baz)))
+   (call (toplevel foo) (call (toplevel @apply) (toplevel bar) (toplevel baz)))
    (program () (std-prelude 0 0 #f) (label _)
             (toplevel ref foo)
             (call new-frame 0) (toplevel ref bar) (toplevel ref baz) (call apply 2)
@@ -593,10 +593,10 @@
 
 (with-test-prefix "call/cc"
   (assert-tree-il->glil
-   (apply (primitive @call-with-current-continuation) (toplevel foo))
+   (primcall @call-with-current-continuation (toplevel foo))
    (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (call tail-call/cc 1)))
   (assert-tree-il->glil
-   (begin (apply (primitive @call-with-current-continuation) (toplevel foo)) (void))
+   (begin (primcall @call-with-current-continuation (toplevel foo)) (void))
    (program () (std-prelude 0 0 #f) (label _)
             (call new-frame 0) (toplevel ref call-with-current-continuation) (toplevel ref foo) (mv-call 1 ,l1)
             (call drop 1) (branch br ,l2) (label ,l3) (mv-bind 0 #f)
@@ -604,8 +604,8 @@
             (void) (call return 1))
    (and (eq? l1 l3) (eq? l2 l4)))
   (assert-tree-il->glil
-   (apply (toplevel foo)
-          (apply (toplevel @call-with-current-continuation) (toplevel bar)))
+   (call (toplevel foo)
+          (call (toplevel @call-with-current-continuation) (toplevel bar)))
    (program () (std-prelude 0 0 #f) (label _)
             (toplevel ref foo)
             (toplevel ref bar) (call call/cc 1)
@@ -655,9 +655,9 @@
                                   '(lambda ()
                                      (lambda-case
                                       (((x y) #f #f #f () (x1 y1))
-                                       (apply (toplevel +)
-                                              (lexical x x1)
-                                              (lexical y y1)))
+                                       (call (toplevel +)
+                                             (lexical x x1)
+                                             (lexical y y1)))
                                       #f))))))
       (and (equal? (map strip-source leaves)
                    (list (make-lexical-ref #f 'y 'y1)