mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 17:20:29 +02:00
Code Activity

Different types for Continuation and Variable identifiers

Browse source
This commit is contained in:
Ian Price 2015-06-18 11:02:05 +01:00
parent 78cacbe450
commit 2e10f55426
4 changed files with 127 additions and 72 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -15,8 +15,8 @@
make-call call
make-closure closure
make-branch branch
make-return return
make-id id
make-kid kid
make-seq seq
make-prompt prompt
))
@ -52,7 +52,7 @@
(format port "#<js-il ~S>" (unparse-js exp)))
(define-js-type program entry body)
(define-js-type function params body)
(define-js-type function self tail body)
(define-js-type jump-table spec)
(define-js-type params self req opt rest kw allow-other-keys?)
(define-js-type continuation params body)
@ -61,11 +61,11 @@
(define-js-type continue cont args)
(define-js-type const value)
(define-js-type primcall name args)
(define-js-type call name args)
(define-js-type call name k args)
(define-js-type closure label num-free)
(define-js-type branch test consequence alternate)
(define-js-type id name)
(define-js-type return val)
(define-js-type kid name)
(define-js-type seq body)
(define-js-type prompt escape? tag handler)
@ -74,32 +74,40 @@
(($ program entry body)
`(program ,(unparse-js entry) . ,(map unparse-js body)))
(($ continuation params body)
`(continuation ,params ,(unparse-js body)))
(($ function args body)
`(function ,args ,(unparse-js body)))
`(continuation ,(map unparse-js params) ,(unparse-js body)))
(($ function self tail body)
`(function ,self ,tail ,(unparse-js body)))
(($ jump-table body)
`(jump-table ,@(map (lambda (p)
`(,(unparse-js (car p)) . ,(cdr p)))
body)))
(($ params self req opt rest kw allow-other-keys?)
`(params ,self ,req ,opt ,rest ,kw ,allow-other-keys?))
(($ params ($ id self) req opt rest kws allow-other-keys?)
`(params ,self
,(map unparse-js req)
,(map unparse-js opt)
,(and rest (unparse-js rest))
,(map (match-lambda
((kw ($ id name) ($ id sym))
(list kw name sym)))
kws)
,allow-other-keys?))
(($ local bindings body)
`(local ,(map unparse-js bindings) ,(unparse-js body)))
(($ var id exp)
`(var ,id ,(unparse-js exp)))
(($ continue k args)
(($ continue ($ kid k) args)
`(continue ,k ,(map unparse-js args)))
(($ branch test then else)
`(if ,(unparse-js test) ,(unparse-js then) ,(unparse-js else)))
(($ const c)
`(const ,c))
(($ primcall name args)
`(primcall ,name , args))
(($ call name args)
`(call ,name , args))
(($ closure label nfree)
`(primcall ,name ,(map unparse-js args)))
(($ call ($ id name) ($ kid k) args)
`(call ,name ,k ,(map unparse-js args)))
(($ closure ($ kid label) nfree)
`(closure ,label ,nfree))
(($ return val)
`(return . ,(unparse-js val)))
(($ id name)
`(id . ,name))))
`(id . ,name))
(($ kid name)
`(kid . ,name))))