mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-31 17:30:24 +02:00
Code Activity

Compile rest args

Browse source
This commit is contained in:
Ian Price 2015-06-07 21:47:08 +01:00
parent 1bed3f047e
commit 86fabef4ca
4 changed files with 32 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

9
module/language/cps/compile-js.scm
View file

@ -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))

8
module/language/js-il.scm
View file

@ -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)

23
module/language/js-il/compile-javascript.scm
View file

@ -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)))))

4
module/language/js-il/direct.scm
View file

@ -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)))