Merge remote-tracking branch 'origin/stable-2.0'

[bpt/guile.git] / module / language / ecmascript / compile-tree-il.scm

diff --git a/module/language/ecmascript/compile-tree-il.scm b/module/language/ecmascript/compile-tree-il.scm
index b5f0a35..2fe0d92 100644 (file)
--- a/module/language/ecmascript/compile-tree-il.scm
+++ b/module/language/ecmascript/compile-tree-il.scm
@@ -32,7 +32,7 @@
   (-> (@ '(language ecmascript impl) 'sym)))
 
 (define-syntax-rule (@impl sym arg ...)
-  (-> (apply (@implv sym) arg ...)))
+  (-> (call (@implv sym) arg ...)))
 
 (define (empty-lexical-environment)
   '())
@@ -82,7 +82,7 @@
     (parameterize ((current-return-tag
                     (-> (lexical 'return tag))))
       (-> (let '(return) (list tag)
-               (list (-> (apply (-> (primitive 'make-prompt-tag)))))
+               (list (-> (primcall 'make-prompt-tag)))
                (-> (prompt (current-return-tag)
                            (body-thunk)
                            (let ((val (gensym "val")))
@@ -115,23 +115,23 @@
       (this
        (@impl get-this))
       ((+ ,a)
-       (-> (apply (-> (primitive '+))
-                  (@impl ->number (comp a e))
-                  (-> (const 0)))))
+       (-> (call (-> (primitive '+))
+                 (@impl ->number (comp a e))
+                 (-> (const 0)))))
       ((- ,a)
-       (-> (apply (-> (primitive '-)) (-> (const 0)) (comp a e))))
+       (-> (call (-> (primitive '-)) (-> (const 0)) (comp a e))))
       ((~ ,a)
        (@impl bitwise-not (comp a e)))
       ((! ,a)
        (@impl logical-not (comp a e)))
       ((+ ,a ,b)
-       (-> (apply (-> (primitive '+)) (comp a e) (comp b e))))
+       (-> (call (-> (primitive '+)) (comp a e) (comp b e))))
       ((- ,a ,b)
-       (-> (apply (-> (primitive '-)) (comp a e) (comp b e))))
+       (-> (call (-> (primitive '-)) (comp a e) (comp b e))))
       ((/ ,a ,b)
-       (-> (apply (-> (primitive '/)) (comp a e) (comp b e))))
+       (-> (call (-> (primitive '/)) (comp a e) (comp b e))))
       ((* ,a ,b)
-       (-> (apply (-> (primitive '*)) (comp a e) (comp b e))))
+       (-> (call (-> (primitive '*)) (comp a e) (comp b e))))
       ((% ,a ,b)
        (@impl mod (comp a e) (comp b e)))
       ((<< ,a ,b)
@@ -139,27 +139,27 @@
       ((>> ,a ,b)
        (@impl shift (comp a e) (comp `(- ,b) e)))
       ((< ,a ,b)
-       (-> (apply (-> (primitive '<)) (comp a e) (comp b e))))
+       (-> (call (-> (primitive '<)) (comp a e) (comp b e))))
       ((<= ,a ,b)
-       (-> (apply (-> (primitive '<=)) (comp a e) (comp b e))))
+       (-> (call (-> (primitive '<=)) (comp a e) (comp b e))))
       ((> ,a ,b)
-       (-> (apply (-> (primitive '>)) (comp a e) (comp b e))))
+       (-> (call (-> (primitive '>)) (comp a e) (comp b e))))
       ((>= ,a ,b)
-       (-> (apply (-> (primitive '>=)) (comp a e) (comp b e))))
+       (-> (call (-> (primitive '>=)) (comp a e) (comp b e))))
       ((in ,a ,b)
        (@impl has-property? (comp a e) (comp b e)))
       ((== ,a ,b)
-       (-> (apply (-> (primitive 'equal?)) (comp a e) (comp b e))))
+       (-> (call (-> (primitive 'equal?)) (comp a e) (comp b e))))
       ((!= ,a ,b)
-       (-> (apply (-> (primitive 'not))
-                  (-> (apply (-> (primitive 'equal?))
-                             (comp a e) (comp b e))))))
+       (-> (call (-> (primitive 'not))
+                 (-> (call (-> (primitive 'equal?))
+                           (comp a e) (comp b e))))))
       ((=== ,a ,b)
-       (-> (apply (-> (primitive 'eqv?)) (comp a e) (comp b e))))
+       (-> (call (-> (primitive 'eqv?)) (comp a e) (comp b e))))
       ((!== ,a ,b)
-       (-> (apply (-> (primitive 'not))
-                  (-> (apply (-> (primitive 'eqv?))
-                             (comp a e) (comp b e))))))
+       (-> (call (-> (primitive 'not))
+                 (-> (call (-> (primitive 'eqv?))
+                           (comp a e) (comp b e))))))
       ((& ,a ,b)
        (@impl band (comp a e) (comp b e)))
       ((^ ,a ,b)
@@ -188,9 +188,9 @@
        (begin1 (comp `(ref ,foo) e)
                (lambda (var)
                  (-> (set! (lookup foo e)
-                           (-> (apply (-> (primitive '+))
-                                      (-> (lexical var var))
-                                      (-> (const 1)))))))))
+                           (-> (call (-> (primitive '+))
+                                     (-> (lexical var var))
+                                     (-> (const 1)))))))))
       ((postinc (pref ,obj ,prop))
        (let1 (comp obj e)
              (lambda (objvar)
@@ -201,9 +201,9 @@
                          (@impl pput
                                 (-> (lexical objvar objvar))
                                 (-> (const prop))
-                                (-> (apply (-> (primitive '+))
-                                           (-> (lexical tmpvar tmpvar))
-                                           (-> (const 1))))))))))
+                                (-> (call (-> (primitive '+))
+                                          (-> (lexical tmpvar tmpvar))
+                                          (-> (const 1))))))))))
       ((postinc (aref ,obj ,prop))
        (let1 (comp obj e)
              (lambda (objvar)
@@ -216,16 +216,16 @@
                                  (@impl pput
                                         (-> (lexical objvar objvar))
                                         (-> (lexical propvar propvar))
-                                        (-> (apply (-> (primitive '+))
-                                                   (-> (lexical tmpvar tmpvar))
-                                                   (-> (const 1))))))))))))
+                                        (-> (call (-> (primitive '+))
+                                                  (-> (lexical tmpvar tmpvar))
+                                                  (-> (const 1))))))))))))
       ((postdec (ref ,foo))
        (begin1 (comp `(ref ,foo) e)
                (lambda (var)
                  (-> (set (lookup foo e)
-                          (-> (apply (-> (primitive '-))
-                                     (-> (lexical var var))
-                                     (-> (const 1)))))))))
+                          (-> (call (-> (primitive '-))
+                                    (-> (lexical var var))
+                                    (-> (const 1)))))))))
       ((postdec (pref ,obj ,prop))
        (let1 (comp obj e)
              (lambda (objvar)
@@ -236,9 +236,9 @@
                          (@impl pput
                                 (-> (lexical objvar objvar))
                                 (-> (const prop))
-                                (-> (apply (-> (primitive '-))
-                                           (-> (lexical tmpvar tmpvar))
-                                           (-> (const 1))))))))))
+                                (-> (call (-> (primitive '-))
+                                          (-> (lexical tmpvar tmpvar))
+                                          (-> (const 1))))))))))
       ((postdec (aref ,obj ,prop))
        (let1 (comp obj e)
              (lambda (objvar)
@@ -258,18 +258,18 @@
        (let ((v (lookup foo e)))
          (-> (begin
                (-> (set! v
-                         (-> (apply (-> (primitive '+))
-                                    v
-                                    (-> (const 1))))))
+                         (-> (call (-> (primitive '+))
+                                   v
+                                   (-> (const 1))))))
                v))))
       ((preinc (pref ,obj ,prop))
        (let1 (comp obj e)
              (lambda (objvar)
-               (begin1 (-> (apply (-> (primitive '+))
-                                  (@impl pget
-                                         (-> (lexical objvar objvar))
-                                         (-> (const prop)))
-                                  (-> (const 1))))
+               (begin1 (-> (call (-> (primitive '+))
+                                 (@impl pget
+                                        (-> (lexical objvar objvar))
+                                        (-> (const prop)))
+                                 (-> (const 1))))
                        (lambda (tmpvar)
                          (@impl pput (-> (lexical objvar objvar))
                                 (-> (const prop))
@@ -279,11 +279,11 @@
              (lambda (objvar)
                (let1 (comp prop e)
                      (lambda (propvar)
-                       (begin1 (-> (apply (-> (primitive '+))
-                                          (@impl pget
-                                                 (-> (lexical objvar objvar))
-                                                 (-> (lexical propvar propvar)))
-                                          (-> (const 1))))
+                       (begin1 (-> (call (-> (primitive '+))
+                                         (@impl pget
+                                                (-> (lexical objvar objvar))
+                                                (-> (lexical propvar propvar)))
+                                         (-> (const 1))))
                                (lambda (tmpvar)
                                  (@impl pput
                                         (-> (lexical objvar objvar))
@@ -293,18 +293,18 @@
        (let ((v (lookup foo e)))
          (-> (begin
                (-> (set! v
-                        (-> (apply (-> (primitive '-))
+                         (-> (call (-> (primitive '-))
                                    v
                                    (-> (const 1))))))
                v))))
       ((predec (pref ,obj ,prop))
        (let1 (comp obj e)
              (lambda (objvar)
-               (begin1 (-> (apply (-> (primitive '-))
-                                  (@impl pget
-                                         (-> (lexical objvar objvar))
-                                         (-> (const prop)))
-                                  (-> (const 1))))
+               (begin1 (-> (call (-> (primitive '-))
+                                 (@impl pget
+                                        (-> (lexical objvar objvar))
+                                        (-> (const prop)))
+                                 (-> (const 1))))
                        (lambda (tmpvar)
                          (@impl pput
                                 (-> (lexical objvar objvar))
@@ -315,11 +315,11 @@
              (lambda (objvar)
                (let1 (comp prop e)
                      (lambda (propvar)
-                       (begin1 (-> (apply (-> (primitive '-))
-                                          (@impl pget
-                                                 (-> (lexical objvar objvar))
-                                                 (-> (lexical propvar propvar)))
-                                          (-> (const 1))))
+                       (begin1 (-> (call (-> (primitive '-))
+                                         (@impl pget
+                                                (-> (lexical objvar objvar))
+                                                (-> (lexical propvar propvar)))
+                                         (-> (const 1))))
                                (lambda (tmpvar)
                                  (@impl pput
                                         (-> (lexical objvar objvar))
@@ -359,7 +359,7 @@
               (-> (lambda '() 
                     `(lambda-case
                       ((() #f #f #f () ())
-                       (apply ,(@impl pget obj prop) ,@args)))))))
+                       (call ,(@impl pget obj prop) ,@args)))))))
       ((call (pref ,obj ,prop) ,args)
        (comp `(call/this ,(comp obj e)
                          ,(-> (const prop))
@@ -371,24 +371,24 @@
                          ,@(map (lambda (x) (comp x e)) args))
              e))
       ((call ,proc ,args)
-       `(apply ,(comp proc e)                
-               ,@(map (lambda (x) (comp x e)) args)))
+       `(call ,(comp proc e)                
+              ,@(map (lambda (x) (comp x e)) args)))
       ((return ,expr)
        (return (comp expr e)))
       ((array . ,args)
-       `(apply ,(@implv new-array)
-               ,@(map (lambda (x) (comp x e)) args)))
+       `(call ,(@implv new-array)
+              ,@(map (lambda (x) (comp x e)) args)))
       ((object . ,args)
-       `(apply ,(@implv new-object)
-               ,@(map (lambda (x)
-                         (pmatch x
-                                 ((,prop ,val)
-                                  (-> (apply (-> (primitive 'cons))
-                                             (-> (const prop))
-                                             (comp val e))))
-                                 (else
-                                  (error "bad prop-val pair" x))))
-                       args)))
+       `(call ,(@implv new-object)
+              ,@(map (lambda (x)
+                       (pmatch x
+                         ((,prop ,val)
+                          (-> (call (-> (primitive 'cons))
+                                    (-> (const prop))
+                                    (comp val e))))
+                         (else
+                          (error "bad prop-val pair" x))))
+                     args)))
       ((pref ,obj ,prop)
        (@impl pget
               (comp obj e)
@@ -463,14 +463,14 @@
                                         `((() #f #f #f () ())
                                           ,(-> (begin
                                                  (comp statement e)
-                                                 (-> (apply (-> (lexical '%continue %continue)))))))))))
+                                                 (-> (call (-> (lexical '%continue %continue)))))))))))
                              (-> (lambda '()
                                    (-> (lambda-case
                                         `((() #f #f #f () ())
                                           ,(-> (if (@impl ->boolean (comp test e))
-                                                   (-> (apply (-> (lexical '%loop %loop))))
+                                                   (-> (call (-> (lexical '%loop %loop))))
                                                    (@implv *undefined*)))))))))
-                       (-> (apply (-> (lexical '%loop %loop)))))))))
+                       (-> (call (-> (lexical '%loop %loop)))))))))
       ((while ,test ,statement)
        (let ((%continue (gensym "%continue ")))
          (let ((e (econs '%continue %continue e)))
@@ -480,9 +480,9 @@
                                         `((() #f #f #f () ())
                                           ,(-> (if (@impl ->boolean (comp test e))
                                                    (-> (begin (comp statement e)
-                                                              (-> (apply (-> (lexical '%continue %continue))))))
+                                                              (-> (call (-> (lexical '%continue %continue))))))
                                                    (@implv *undefined*)))))))))
-                       (-> (apply (-> (lexical '%continue %continue)))))))))
+                       (-> (call (-> (lexical '%continue %continue)))))))))
       
       ((for ,init ,test ,inc ,statement)
        (let ((%continue (gensym "%continue ")))
@@ -496,10 +496,10 @@
                                                        (comp 'true e))
                                                    (-> (begin (comp statement e)
                                                               (comp (or inc '(begin)) e)
-                                                              (-> (apply (-> (lexical '%continue %continue))))))
+                                                              (-> (call (-> (lexical '%continue %continue))))))
                                                    (@implv *undefined*)))))))))
                        (-> (begin (comp (or init '(begin)) e)
-                                  (-> (apply (-> (lexical '%continue %continue)))))))))))
+                                  (-> (call (-> (lexical '%continue %continue)))))))))))
       
       ((for-in ,var ,object ,statement)
        (let ((%enum (gensym "%enum "))
@@ -519,9 +519,9 @@
                                                                                   ,(-> (const 'pop))))
                                                               e)
                                                         (comp statement e)
-                                                        (-> (apply (-> (lexical '%continue %continue))))))
+                                                        (-> (call (-> (lexical '%continue %continue))))))
                                                   (@implv *undefined*)))))))))
-                       (-> (apply (-> (lexical '%continue %continue)))))))))
+                       (-> (call (-> (lexical '%continue %continue)))))))))
       
       ((block ,x)
        (comp x e))