summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorIan Price <ianprice90@googlemail.com>2015-06-07 21:47:08 +0100
committerIan Price <ianprice90@googlemail.com>2015-06-18 04:14:42 +0100
commit86fabef4ca8c73ea6aa293d3685b52df0f442eb2 (patch)
tree4c747cf03edd3f9e34c6e87772d3bb247665751c
parent1bed3f047e8ec4b6e0c7c4e48245d863a340158b (diff)
downloadguile-86fabef4ca8c73ea6aa293d3685b52df0f442eb2.tar.gz
Compile rest args
-rw-r--r--module/language/cps/compile-js.scm9
-rw-r--r--module/language/js-il.scm8
-rw-r--r--module/language/js-il/compile-javascript.scm23
-rw-r--r--module/language/js-il/direct.scm4
4 files changed, 32 insertions, 12 deletions
diff --git a/module/language/cps/compile-js.scm b/module/language/cps/compile-js.scm
index 250b7a17b..826f646a2 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 921bac63a..4c6c34691 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 373d5a9d3..676d4480f 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 6e97e3e9a..e43164963 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)))