summaryrefslogtreecommitdiff
path: root/module/language/ecmascript/compile-tree-il.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2012-07-05 11:06:29 +0200
committerAndy Wingo <wingo@pobox.com>2012-07-05 11:06:29 +0200
commitc0cfa9ef07aad3afef822d1afe1786eb655bd121 (patch)
tree12c0effd4555c19fdfe9e0d15213687e2c8db045 /module/language/ecmascript/compile-tree-il.scm
parent21b83fb7953fd2b5e40ca9206a0a72ec3cb2489e (diff)
downloadguile-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.scm27
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)))