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

fix bugs in ecmascript compiler

Browse source 
* module/language/ecmascript/compile-tree-il.scm: Fix a number of bugs,
  fallen out from the ghil->tree-il conversion.

* module/language/tree-il/compile-glil.scm (*primcall-ops*): Add a hack
  for "return" for javascript. Scheme shouldn't see this because it's
  not an "interesting primitive".
This commit is contained in:
Andy Wingo 2009-11-14 13:34:40 +01:00
parent e581ec7874
commit d61e866c76
2 changed files with 31 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

50
module/language/ecmascript/compile-tree-il.scm
View file

@ -33,7 +33,7 @@
(define-syntax @implv
(syntax-rules ()
((_ sym)
(-> (module-ref '(language ecmascript impl) 'sym #t)))))
(-> (@ '(language ecmascript impl) 'sym)))))
(define-syntax @impl
(syntax-rules ()
@ -44,7 +44,7 @@
'())
(define (econs name gensym env)
(acons name gensym env))
(acons name (-> (lexical name gensym)) env))
(define (lookup name env)
(or (assq-ref env name)
@ -52,7 +52,9 @@
(define (compile-tree-il exp env opts)
(values
(parse-tree-il (comp exp (empty-lexical-environment)))
(parse-tree-il
(-> (begin (@impl js-init)
(comp exp (empty-lexical-environment)))))
env
env))
@ -99,7 +101,7 @@
((string ,str)
(-> (const str)))
(this
(@impl get-this '()))
(@impl get-this))
((+ ,a)
(-> (apply (-> (primitive '+))
(@impl ->number (comp a e))
@ -166,7 +168,7 @@
(-> (if (@impl ->boolean (comp test e))
(comp then e)
(comp else e))))
((if ,test ,then ,else)
((if ,test ,then)
(-> (if (@impl ->boolean (comp test e))
(comp then e)
(@implv *undefined*))))
@ -314,32 +316,36 @@
((ref ,id)
(lookup id e))
((var . ,forms)
(-> (begin
(map (lambda (form)
(pmatch form
((,x ,y)
(-> (define x (comp y e))))
((,x)
(-> (define x (@implv *undefined*))))
(else (error "bad var form" form))))
forms))))
`(begin
,@(map (lambda (form)
(pmatch form
((,x ,y)
(-> (define x (comp y e))))
((,x)
(-> (define x (@implv *undefined*))))
(else (error "bad var form" form))))
forms)))
((begin)
(-> (void)))
((begin ,form)
(comp form e))
((begin . ,forms)
`(begin ,@(map (lambda (x) (comp x e)) forms)))
((lambda ,formals ,body)
(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))))))))
`(lambda ()
(lambda-case
((() ,formals #f #f ,(map (lambda (x) (@implv *undefined*)) formals) ,syms #f)
,(comp-body e body formals syms))))))
((call/this ,obj ,prop . ,args)
(@impl call/this*
obj
(-> (lambda '()
(-> (lambda-case
`((() #f #f #f () () #f)
(apply ,(@impl pget obj prop) ,@args))))))))
`(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))
@ -551,5 +557,5 @@
(gensym (string-append (symbol->string x) " ")))
names))
(e (fold econs (fold econs e formals formal-syms) names syms)))
(-> (let names syms (map (lambda (x) (->@implv *undefined*)) names)
(-> (let names syms (map (lambda (x) (@implv *undefined*)) names)
(comp out e))))))

3
module/language/tree-il/compile-glil.scm
View file

@ -108,6 +108,9 @@
((vector-ref . 2) . vector-ref)
((vector-set! . 3) . vector-set)
;; hack for javascript
((return . 1) return)
((bytevector-u8-ref . 2) . bv-u8-ref)
((bytevector-u8-set! . 3) . bv-u8-set)
((bytevector-s8-ref . 2) . bv-s8-ref)