diff options
author | Andy Wingo <wingo@pobox.com> | 2009-02-21 00:31:43 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-02-21 00:33:04 +0100 |
commit | 3bef3ae42886d910c43655792ecd9cfdc73ba886 (patch) | |
tree | b7245810a10a421a77b9cee0272cf7c1aeddd621 | |
parent | b358fe65021a40fa80238d8f426f810d150acb08 (diff) | |
download | guile-3bef3ae42886d910c43655792ecd9cfdc73ba886.tar.gz |
implement do, while, for
* module/language/ecmascript/compile-ghil.scm (comp): Use ghil-bind when
making temp vars, so that disassembly understands things. Implement do,
while, and for.
* module/language/ecmascript/parse.scm (parse-ecmascript): Some tweaks.
* module/language/ecmascript/impl.scm (language): Export ->boolean.
-rw-r--r-- | module/language/ecmascript/compile-ghil.scm | 85 | ||||
-rw-r--r-- | module/language/ecmascript/impl.scm | 5 | ||||
-rw-r--r-- | module/language/ecmascript/parse.scm | 4 |
3 files changed, 83 insertions, 11 deletions
diff --git a/module/language/ecmascript/compile-ghil.scm b/module/language/ecmascript/compile-ghil.scm index 5834771cd..ffb34a54d 100644 --- a/module/language/ecmascript/compile-ghil.scm +++ b/module/language/ecmascript/compile-ghil.scm @@ -51,14 +51,15 @@ (define (let1 what proc) (call-with-ghil-bindings e '(%tmp) (lambda (vars) - (make-ghil-begin e l (list (make-ghil-set e l (car vars) what) - (proc (car vars))))))) + (make-ghil-bind e l vars (list what) + (proc (car vars)))))) (define (begin1 what proc) (call-with-ghil-bindings e '(%tmp) (lambda (vars) - (make-ghil-begin e l (list (make-ghil-set e l (car vars) what) - (proc (car vars)) - (make-ghil-ref e l (car vars))))))) + (make-ghil-bind e l vars (list what) + (make-ghil-begin + e l (list (proc (car vars)) + (make-ghil-ref e l (car vars)))))))) (pmatch x (null ;; FIXME, null doesn't have much relation to EOL... @@ -130,7 +131,11 @@ ((or ,a ,b) (make-ghil-or e l (list (comp a e) (comp b e)))) ((if ,test ,then ,else) - (make-ghil-if e l (comp test e) (comp then e) (comp else e))) + (make-ghil-if e l (@impl e l ->boolean (list (comp test e))) + (comp then e) (comp else e))) + ((if ,test ,then ,else) + (make-ghil-if e l (@impl e l ->boolean (list (comp test e))) + (comp then e) (@implv e l *undefined*))) ((postinc (ref ,foo)) (begin1 (comp `(ref ,foo) e) (lambda (var) @@ -363,6 +368,74 @@ (make-ghil-begin e l (list (comp expr e) (@implv e l *undefined*)))) ((typeof ,expr) (@impl e l typeof (list (comp expr e)))) + ((do ,statement ,test) + (call-with-ghil-bindings e '(%loop %continue) + (lambda (vars) + (make-ghil-bind + e l vars (list + (call-with-ghil-environment e '() + (lambda (e _) + (make-ghil-lambda + e l '() #f '() + (make-ghil-begin + e l (list (comp statement e) + (make-ghil-call e l (make-ghil-ref + e l (ghil-var-for-ref! e '%continue)) + '())))))) + (call-with-ghil-environment e '() + (lambda (e _) + (make-ghil-lambda + e l '() #f '() + (make-ghil-if e l (comp test e) + (make-ghil-call e l (make-ghil-ref + e l (ghil-var-for-ref! e '%loop)) + '()) + (@implv e l *undefined*)))))) + (make-ghil-call e l (make-ghil-ref e l (car vars)) '()))))) + ((while ,test ,statement) + (call-with-ghil-bindings e '(%continue) + (lambda (vars) + (make-ghil-begin + e l + (list (make-ghil-set + e l (car vars) + (call-with-ghil-environment e '() + (lambda (e _) + (make-ghil-lambda + e l '() #f '() + (make-ghil-if + e l (comp test e) + (make-ghil-begin + e l (list (comp statement e) + (make-ghil-call e l (make-ghil-ref + e l (ghil-var-for-ref! e '%continue)) + '()))) + (@implv e l *undefined*)))))) + (make-ghil-call e l (make-ghil-ref e l (car vars)) '())))))) + ((for ,init ,test ,inc ,statement) + (call-with-ghil-bindings e '(%continue) + (lambda (vars) + (make-ghil-begin + e l + (list (comp (or init '(begin)) e) + (make-ghil-set + e l (car vars) + (call-with-ghil-environment e '() + (lambda (e _) + (make-ghil-lambda + e l '() #f '() + (make-ghil-if + e l (comp (or test 'true) e) + (make-ghil-begin + e l (list (comp (or inc '(begin)) e) + (comp statement e) + (make-ghil-call e l (make-ghil-ref + e l (ghil-var-for-ref! e '%continue)) + '()))) + (@implv e l *undefined*)))))) + (make-ghil-call e l (make-ghil-ref e l (car vars)) '())))))) + ((block ,x) + (comp x e)) (else (error "compilation not yet implemented:" x))))) diff --git a/module/language/ecmascript/impl.scm b/module/language/ecmascript/impl.scm index 9db92e3e4..d4b936c6c 100644 --- a/module/language/ecmascript/impl.scm +++ b/module/language/ecmascript/impl.scm @@ -26,9 +26,8 @@ #:use-module (language ecmascript array) #:re-export (*undefined* *this* call/this* pget pput pdel has-property? - new-object - new - new-array) + ->boolean + new-object new new-array) #:export (get-this typeof bitwise-not logical-not diff --git a/module/language/ecmascript/parse.scm b/module/language/ecmascript/parse.scm index e088cbece..27070268c 100644 --- a/module/language/ecmascript/parse.scm +++ b/module/language/ecmascript/parse.scm @@ -175,8 +175,8 @@ (PrimaryExpression (this) -> 'this (null) -> 'null - (true) -> #t - (false) -> #f + (true) -> 'true + (false) -> 'false (Identifier) -> `(ref ,$1) (StringLiteral) -> `(string ,$1) (RegexpLiteral) -> `(regexp ,$1) |