diff options
author | Andy Wingo <wingo@pobox.com> | 2012-07-05 11:06:29 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2012-07-05 11:06:29 +0200 |
commit | c0cfa9ef07aad3afef822d1afe1786eb655bd121 (patch) | |
tree | 12c0effd4555c19fdfe9e0d15213687e2c8db045 /module/language/ecmascript/compile-tree-il.scm | |
parent | 21b83fb7953fd2b5e40ca9206a0a72ec3cb2489e (diff) | |
download | guile-c0cfa9ef07aad3afef822d1afe1786eb655bd121.tar.gz |
compile ecmascript's `return' as an abort
* module/language/ecmascript/compile-tree-il.scm (current-return-tag):
(with-return-prompt, comp): Compile `return' as an abort instead of a
primcall to `return'. Fixes beta-reduction by the optimizer -- it
doesn't make sense for `return' to move from one function to another!
Diffstat (limited to 'module/language/ecmascript/compile-tree-il.scm')
-rw-r--r-- | module/language/ecmascript/compile-tree-il.scm | 27 |
1 files changed, 24 insertions, 3 deletions
diff --git a/module/language/ecmascript/compile-tree-il.scm b/module/language/ecmascript/compile-tree-il.scm index a2401f442..b5f0a3528 100644 --- a/module/language/ecmascript/compile-tree-il.scm +++ b/module/language/ecmascript/compile-tree-il.scm @@ -70,6 +70,26 @@ (set-source-properties! res (location x)))) res))) +(define current-return-tag (make-parameter #f)) + +(define (return expr) + (-> (abort (or (current-return-tag) (error "return outside function")) + (list expr) + (-> (const '()))))) + +(define (with-return-prompt body-thunk) + (let ((tag (gensym "return"))) + (parameterize ((current-return-tag + (-> (lexical 'return tag)))) + (-> (let '(return) (list tag) + (list (-> (apply (-> (primitive 'make-prompt-tag))))) + (-> (prompt (current-return-tag) + (body-thunk) + (let ((val (gensym "val"))) + (-> (lambda-case + `(((k val) #f #f #f () (,(gensym) ,val)) + ,(-> (lexical 'val val))))))))))))) + (define (comp x e) (let ((l (location x))) (define (let1 what proc) @@ -330,7 +350,9 @@ `(lambda () (lambda-case ((() ,formals #f #f ,(map (lambda (x) (@implv *undefined*)) formals) ,syms) - ,(comp-body e body formals syms)))))) + ,(with-return-prompt + (lambda () + (comp-body e body formals syms)))))))) ((call/this ,obj ,prop . ,args) (@impl call/this* obj @@ -352,8 +374,7 @@ `(apply ,(comp proc e) ,@(map (lambda (x) (comp x e)) args))) ((return ,expr) - (-> (apply (-> (primitive 'return)) - (comp expr e)))) + (return (comp expr e))) ((array . ,args) `(apply ,(@implv new-array) ,@(map (lambda (x) (comp x e)) args))) |