summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-02-21 00:31:43 +0100
committerAndy Wingo <wingo@pobox.com>2009-02-21 00:33:04 +0100
commit3bef3ae42886d910c43655792ecd9cfdc73ba886 (patch)
treeb7245810a10a421a77b9cee0272cf7c1aeddd621
parentb358fe65021a40fa80238d8f426f810d150acb08 (diff)
downloadguile-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.scm85
-rw-r--r--module/language/ecmascript/impl.scm5
-rw-r--r--module/language/ecmascript/parse.scm4
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)