[Guile-commits] 11/99: Compile rest args

[Christopher Allan Webber]

cwebber pushed a commit to branch compile-to-js-merge
in repository guile.

commit 86fabef4ca8c73ea6aa293d3685b52df0f442eb2
Author: Ian Price <ianprice90@googlemail.com>
AuthorDate: Sun Jun 7 21:47:08 2015 +0100

    Compile rest args
---
 module/language/cps/compile-js.scm           |  9 ++++-----
 module/language/js-il.scm                    |  8 +++++---
 module/language/js-il/compile-javascript.scm | 23 +++++++++++++++++++++--
 module/language/js-il/direct.scm             |  4 ++--
 4 files changed, 32 insertions(+), 12 deletions(-)

diff --git a/module/language/cps/compile-js.scm 
b/module/language/cps/compile-js.scm
index 250b7a1..826f646 100644
--- a/module/language/cps/compile-js.scm
+++ b/module/language/cps/compile-js.scm
@@ -40,20 +40,19 @@
      ;; add function argument prelude
      (unless (null? opt)
        (not-supported "optional arguments are not supported" clause))
-     (when rest
-       (not-supported "rest arguments are not supported" clause))
      (unless (or (null? kw) allow-other-keys?)
        (not-supported "keyword arguments are not supported" clause))
      (when alternate
        (not-supported "alternate continuations are not supported" clause))
-     (make-function self
-                    (cons tail req)
+     (make-function (make-params self (cons tail req) rest)
                     (match body
                       (($ $cont k ($ $kargs () () exp))
                        (compile-term exp))
                       (($ $cont k _)
                        (make-local (list (compile-cont body))
-                                   (make-continue k (map make-id req)))))))))
+                                   (make-continue
+                                    k
+                                    (map make-id (append req (if rest (list 
rest) '())))))))))))
 
 (define (not-supported msg clause)
   (error 'not-supported msg clause))
diff --git a/module/language/js-il.scm b/module/language/js-il.scm
index 921bac6..4c6c346 100644
--- a/module/language/js-il.scm
+++ b/module/language/js-il.scm
@@ -4,6 +4,7 @@
   #:use-module (ice-9 match)
   #:export (make-program program
             make-function function
+            make-params params
             make-continuation continuation
             make-local local
             make-var var
@@ -48,7 +49,8 @@
   (format port "#<js-il ~S>" (unparse-js exp)))
 
 (define-js-type program entry body)
-(define-js-type function name params body)
+(define-js-type function params body)
+(define-js-type params self req rest)
 (define-js-type continuation params body)
 (define-js-type local bindings body) ; local scope
 (define-js-type var id exp)
@@ -67,8 +69,8 @@
      `(program ,(unparse-js entry) . ,(map unparse-js body)))
     (($ continuation params body)
      `(continuation ,params ,(unparse-js body)))
-    (($ function name params body)
-     `(function ,name ,params ,(unparse-js body)))
+    (($ function ($ params self req opt) body)
+     `(function ,(append (list self) req (if opt (list opt) '())) ,(unparse-js 
body)))
     (($ local bindings body)
      `(local ,(map unparse-js bindings) ,(unparse-js body)))
     (($ var id exp)
diff --git a/module/language/js-il/compile-javascript.scm 
b/module/language/js-il/compile-javascript.scm
index 373d5a9..676d448 100644
--- a/module/language/js-il/compile-javascript.scm
+++ b/module/language/js-il/compile-javascript.scm
@@ -17,6 +17,20 @@
 (define (rename name)
   (format #f "kont_~a" name))
 
+(define (bind-rest-args rest num-drop)
+  (define (ref i l)
+    (if (null? l)
+        i
+        (ref (make-refine i (make-const (car l)))
+             (cdr l))))
+  (define this (rename rest))
+  (make-var this
+            (make-call (ref *scheme* (list "list" "apply"))
+                       (list
+                        (ref *scheme* (list "list"))
+                        (make-call (ref (make-id "Array") (list "prototype" 
"slice" "call"))
+                                   (list (make-id "arguments") (make-const 
num-drop)))))))
+
 (define (compile-exp exp)
   ;; TODO: handle ids for js
   (match exp
@@ -34,8 +48,13 @@
     (($ il:continuation params body)
      (make-function (map rename params) (list (compile-exp body))))
 
-    (($ il:function name params body)
-     (make-function (map rename (cons name params)) (list (compile-exp body))))
+    (($ il:function ($ il:params self req #f) body)
+     (make-function (map rename (cons self req)) (list (compile-exp body))))
+
+    (($ il:function ($ il:params self req rest) body)
+     (make-function (map rename (cons self req))
+                    (list (bind-rest-args rest (length (cons self req)))
+                          (compile-exp body))))
 
     (($ il:local bindings body)
      (make-block (append (map compile-exp bindings) (list (compile-exp 
body)))))
diff --git a/module/language/js-il/direct.scm b/module/language/js-il/direct.scm
index 6e97e3e..e431649 100644
--- a/module/language/js-il/direct.scm
+++ b/module/language/js-il/direct.scm
@@ -12,8 +12,8 @@
     (($ continuation params body)
      (make-continuation params (remove-immediate-calls body)))
 
-    (($ function name params body)
-     (make-function name params (remove-immediate-calls body)))
+    (($ function params body)
+     (make-function params (remove-immediate-calls body)))
 
     (($ local
         (($ var id ($ continuation () body)))