mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-14 15:40:19 +02:00
finish support for optional & keyword args; update ecmascript compiler
* libguile/_scm.h (SCM_OBJCODE_MINOR_VERSION): Bump. * libguile/vm-i-system.c (br-if-nargs-ne, br-if-args-lt) (br-if-nargs-gt): New instructions, for use by different lambda cases. (bind-optionals, bind-optionals/shuffle, bind-kwargs): New instructions, for binding optional and keyword arguments. Renumber other ops. * module/language/ecmascript/compile-tree-il.scm (comp, comp-body): Update for new tree-il. Use the new optional argument mechanism instead of emulating it with rest arguments. * module/language/glil/compile-assembly.scm (glil->assembly): Tweaks for optional and keyword argument compilation. * module/language/tree-il.scm (parse-tree-il, unparse-tree-il): Make the else case optional, in the s-expression serialization of tree-il. * module/language/tree-il/compile-glil.scm (flatten): Handle all of the lambda-case capabilities.
This commit is contained in:
Andy Wingo
parent
8753fd537c
commit
7e01997e88
7 changed files with 318 additions and 133 deletions
|
|
@ -326,14 +326,20 @@
|
|||
((begin . ,forms)
|
||||
`(begin ,@(map (lambda (x) (comp x e)) forms)))
|
||||
((lambda ,formals ,body)
|
||||
(let ((%args (gensym "%args ")))
|
||||
(-> (lambda '%args %args '()
|
||||
(comp-body (econs '%args %args e) body formals '%args)))))
|
||||
(let ((syms (map (lambda (x)
|
||||
(gensym (string-append (symbol->string x) " ")))
|
||||
formals)))
|
||||
(-> (lambda '()
|
||||
(-> (lambda-case
|
||||
`((() ,formals #f #f ,syms #f)
|
||||
,(comp-body e body formals syms))))))))
|
||||
((call/this ,obj ,prop . ,args)
|
||||
(@impl call/this*
|
||||
obj
|
||||
(-> (lambda '() '() '()
|
||||
`(apply ,(@impl pget obj prop) ,@args)))))
|
||||
(-> (lambda '()
|
||||
(-> (lambda-case
|
||||
`((() #f #f #f () #f)
|
||||
(apply ,(@impl pget obj prop) ,@args))))))))
|
||||
((call (pref ,obj ,prop) ,args)
|
||||
(comp `(call/this ,(comp obj e)
|
||||
,(-> (const prop))
|
||||
|
|
@ -433,40 +439,46 @@
|
|||
(%continue (gensym "%continue ")))
|
||||
(let ((e (econs '%loop %loop (econs '%continue %continue e))))
|
||||
(-> (letrec '(%loop %continue) (list %loop %continue)
|
||||
(list (-> (lambda '() '() '()
|
||||
(-> (begin
|
||||
(comp statement e)
|
||||
(-> (apply (-> (lexical '%continue %continue)))
|
||||
)))))
|
||||
|
||||
(-> (lambda '() '() '()
|
||||
(-> (if (@impl ->boolean (comp test e))
|
||||
(-> (apply (-> (lexical '%loop %loop))))
|
||||
(@implv *undefined*))))))
|
||||
(list (-> (lambda '()
|
||||
(-> (lambda-case
|
||||
`((() #f #f #f () #f)
|
||||
,(-> (begin
|
||||
(comp statement e)
|
||||
(-> (apply (-> (lexical '%continue %continue)))))))))))
|
||||
(-> (lambda '()
|
||||
(-> (lambda-case
|
||||
`((() #f #f #f () #f)
|
||||
,(-> (if (@impl ->boolean (comp test e))
|
||||
(-> (apply (-> (lexical '%loop %loop))))
|
||||
(@implv *undefined*)))))))))
|
||||
(-> (apply (-> (lexical '%loop %loop)))))))))
|
||||
((while ,test ,statement)
|
||||
(let ((%continue (gensym "%continue ")))
|
||||
(let ((e (econs '%continue %continue e)))
|
||||
(-> (letrec '(%continue) (list %continue)
|
||||
(list (-> (lambda '() '() '()
|
||||
(-> (if (@impl ->boolean (comp test e))
|
||||
(-> (begin (comp statement e)
|
||||
(-> (apply (-> (lexical '%continue %continue))))))
|
||||
(@implv *undefined*))))))
|
||||
(list (-> (lambda '()
|
||||
(-> (lambda-case
|
||||
`((() #f #f #f () #f)
|
||||
,(-> (if (@impl ->boolean (comp test e))
|
||||
(-> (begin (comp statement e)
|
||||
(-> (apply (-> (lexical '%continue %continue))))))
|
||||
(@implv *undefined*)))))))))
|
||||
(-> (apply (-> (lexical '%continue %continue)))))))))
|
||||
|
||||
((for ,init ,test ,inc ,statement)
|
||||
(let ((%continue (gensym "%continue ")))
|
||||
(let ((e (econs '%continue %continue e)))
|
||||
(-> (letrec '(%continue) (list %continue)
|
||||
(list (-> (lambda '() '() '()
|
||||
(-> (if (if test
|
||||
(@impl ->boolean (comp test e))
|
||||
(comp 'true e))
|
||||
(-> (begin (comp statement e)
|
||||
(comp (or inc '(begin)) e)
|
||||
(-> (apply (-> (lexical '%continue %continue))))))
|
||||
(@implv *undefined*))))))
|
||||
(list (-> (lambda '()
|
||||
(-> (lambda-case
|
||||
`((() #f #f #f () #f)
|
||||
,(-> (if (if test
|
||||
(@impl ->boolean (comp test e))
|
||||
(comp 'true e))
|
||||
(-> (begin (comp statement e)
|
||||
(comp (or inc '(begin)) e)
|
||||
(-> (apply (-> (lexical '%continue %continue))))))
|
||||
(@implv *undefined*)))))))))
|
||||
(-> (begin (comp (or init '(begin)) e)
|
||||
(-> (apply (-> (lexical '%continue %continue)))))))))))
|
||||
|
||||
|
|
@ -476,18 +488,20 @@
|
|||
(let ((e (econs '%enum %enum (econs '%continue %continue e))))
|
||||
(-> (letrec '(%enum %continue) (list %enum %continue)
|
||||
(list (@impl make-enumerator (comp object e))
|
||||
(-> (lambda '() '() '()
|
||||
(-> (if (@impl ->boolean
|
||||
(@impl pget
|
||||
(-> (lexical '%enum %enum))
|
||||
(-> (const 'length))))
|
||||
(-> (begin
|
||||
(comp `(= ,var (call/this ,(-> (lexical '%enum %enum))
|
||||
,(-> (const 'pop))))
|
||||
e)
|
||||
(comp statement e)
|
||||
(-> (apply (-> (lexical '%continue %continue))))))
|
||||
(@implv *undefined*))))))
|
||||
(-> (lambda '()
|
||||
(-> (lambda-case
|
||||
`((() #f #f #f () #f)
|
||||
(-> (if (@impl ->boolean
|
||||
(@impl pget
|
||||
(-> (lexical '%enum %enum))
|
||||
(-> (const 'length))))
|
||||
(-> (begin
|
||||
(comp `(= ,var (call/this ,(-> (lexical '%enum %enum))
|
||||
,(-> (const 'pop))))
|
||||
e)
|
||||
(comp statement e)
|
||||
(-> (apply (-> (lexical '%continue %continue))))))
|
||||
(@implv *undefined*)))))))))
|
||||
(-> (apply (-> (lexical '%continue %continue)))))))))
|
||||
|
||||
((block ,x)
|
||||
|
|
@ -495,18 +509,22 @@
|
|||
(else
|
||||
(error "compilation not yet implemented:" x)))))
|
||||
|
||||
(define (comp-body e body formals %args)
|
||||
(define (comp-body e body formals formal-syms)
|
||||
(define (process)
|
||||
(let lp ((in body) (out '()) (rvars (reverse formals)))
|
||||
(let lp ((in body) (out '()) (rvars '()))
|
||||
(pmatch in
|
||||
(((var (,x) . ,morevars) . ,rest)
|
||||
(lp `((var . ,morevars) . ,rest)
|
||||
out
|
||||
(if (memq x rvars) rvars (cons x rvars))))
|
||||
(if (or (memq x rvars) (memq x formals))
|
||||
rvars
|
||||
(cons x rvars))))
|
||||
(((var (,x ,y) . ,morevars) . ,rest)
|
||||
(lp `((var . ,morevars) . ,rest)
|
||||
`((= (ref ,x) ,y) . ,out)
|
||||
(if (memq x rvars) rvars (cons x rvars))))
|
||||
(if (or (memq x rvars) (memq x formals))
|
||||
rvars
|
||||
(cons x rvars))))
|
||||
(((var) . ,rest)
|
||||
(lp rest out rvars))
|
||||
((,x . ,rest) (guard (and (pair? x) (eq? (car x) 'lambda)))
|
||||
|
|
@ -532,18 +550,6 @@
|
|||
(syms (map (lambda (x)
|
||||
(gensym (string-append (symbol->string x) " ")))
|
||||
names))
|
||||
(e (fold acons e names syms)))
|
||||
(let ((%argv (lookup %args e)))
|
||||
(let lp ((names names) (syms syms))
|
||||
(if (null? names)
|
||||
;; fixme: here check for too many args
|
||||
(comp out e)
|
||||
(-> (let (list (car names)) (list (car syms))
|
||||
(list (-> (if (-> (apply (-> (primitive 'null?)) %argv))
|
||||
(-> (@implv *undefined*))
|
||||
(-> (let1 (-> (apply (-> (primitive 'car)) %argv))
|
||||
(lambda (v)
|
||||
(-> (set! %argv
|
||||
(-> (apply (-> (primitive 'cdr)) %argv))))
|
||||
(-> (lexical v v))))))))
|
||||
(lp (cdr names) (cdr syms))))))))))
|
||||
(e (fold econs (fold econs e formals formal-syms) names syms)))
|
||||
(-> (let names syms (map (lambda (x) (->@implv *undefined*)) names)
|
||||
(comp out e))))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue