mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 05:50:26 +02:00
Code Activity

implement do, while, for

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2009-02-21 00:31:43 +01:00
parent b358fe6502
commit 3bef3ae428
3 changed files with 83 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

85
module/language/ecmascript/compile-ghil.scm
View file

@ -51,14 +51,15 @@
(define (let1 what proc) (define (let1 what proc)
(call-with-ghil-bindings e '(%tmp) (call-with-ghil-bindings e '(%tmp)
(lambda (vars) (lambda (vars)
(make-ghil-begin e l (list (make-ghil-set e l (car vars) what) (make-ghil-bind e l vars (list what)
(proc (car vars))))))) (proc (car vars))))))
(define (begin1 what proc) (define (begin1 what proc)
(call-with-ghil-bindings e '(%tmp) (call-with-ghil-bindings e '(%tmp)
(lambda (vars) (lambda (vars)
(make-ghil-begin e l (list (make-ghil-set e l (car vars) what) (make-ghil-bind e l vars (list what)
(proc (car vars)) (make-ghil-begin
(make-ghil-ref e l (car vars))))))) e l (list (proc (car vars))
(make-ghil-ref e l (car vars))))))))
(pmatch x (pmatch x
(null (null
;; FIXME, null doesn't have much relation to EOL... ;; FIXME, null doesn't have much relation to EOL...
@ -130,7 +131,11 @@
((or ,a ,b) ((or ,a ,b)
(make-ghil-or e l (list (comp a e) (comp b e)))) (make-ghil-or e l (list (comp a e) (comp b e))))
((if ,test ,then ,else) ((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)) ((postinc (ref ,foo))
(begin1 (comp `(ref ,foo) e) (begin1 (comp `(ref ,foo) e)
(lambda (var) (lambda (var)
@ -363,6 +368,74 @@
(make-ghil-begin e l (list (comp expr e) (@implv e l *undefined*)))) (make-ghil-begin e l (list (comp expr e) (@implv e l *undefined*))))
((typeof ,expr) ((typeof ,expr)
(@impl e l typeof (list (comp expr e)))) (@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 (else
(error "compilation not yet implemented:" x))))) (error "compilation not yet implemented:" x)))))

5
module/language/ecmascript/impl.scm
View file

@ -26,9 +26,8 @@
#:use-module (language ecmascript array) #:use-module (language ecmascript array)
#:re-export (*undefined* *this* call/this* #:re-export (*undefined* *this* call/this*
pget pput pdel has-property? pget pput pdel has-property?
new-object ->boolean
new new-object new new-array)
new-array)
#:export (get-this #:export (get-this
typeof typeof
bitwise-not logical-not bitwise-not logical-not

4
module/language/ecmascript/parse.scm
View file

@ -175,8 +175,8 @@
(PrimaryExpression (this) -> 'this (PrimaryExpression (this) -> 'this
(null) -> 'null (null) -> 'null
(true) -> #t (true) -> 'true
(false) -> #f (false) -> 'false
(Identifier) -> `(ref ,$1) (Identifier) -> `(ref ,$1)
(StringLiteral) -> `(string ,$1) (StringLiteral) -> `(string ,$1)
(RegexpLiteral) -> `(regexp ,$1) (RegexpLiteral) -> `(regexp ,$1)