diff options
author | Ian Price <ianprice90@googlemail.com> | 2015-06-07 21:47:08 +0100 |
---|---|---|
committer | Ian Price <ianprice90@googlemail.com> | 2015-06-18 04:14:42 +0100 |
commit | 86fabef4ca8c73ea6aa293d3685b52df0f442eb2 (patch) | |
tree | 4c747cf03edd3f9e34c6e87772d3bb247665751c | |
parent | 1bed3f047e8ec4b6e0c7c4e48245d863a340158b (diff) | |
download | guile-86fabef4ca8c73ea6aa293d3685b52df0f442eb2.tar.gz |
Compile rest args
-rw-r--r-- | module/language/cps/compile-js.scm | 9 | ||||
-rw-r--r-- | module/language/js-il.scm | 8 | ||||
-rw-r--r-- | module/language/js-il/compile-javascript.scm | 23 | ||||
-rw-r--r-- | 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 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))) |