1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays combinators.short-circuit continuations
4 fry generalizations kernel locals locals.types locals.rewrite
5 namespaces make sequences smalltalk.ast ;
6 IN: smalltalk.compiler.return
8 SYMBOL: return-continuation
10 GENERIC: need-return-continuation? ( ast -- ? )
12 M: ast-return need-return-continuation? drop t ;
14 M: ast-block need-return-continuation? body>> need-return-continuation? ;
16 M: ast-message-send need-return-continuation?
18 [ receiver>> need-return-continuation? ]
19 [ arguments>> need-return-continuation? ]
22 M: ast-cascade need-return-continuation?
24 [ receiver>> need-return-continuation? ]
25 [ messages>> need-return-continuation? ]
28 M: ast-message need-return-continuation?
29 arguments>> need-return-continuation? ;
31 M: ast-assignment need-return-continuation?
32 value>> need-return-continuation? ;
34 M: ast-sequence need-return-continuation?
35 body>> need-return-continuation? ;
37 M: array need-return-continuation? [ need-return-continuation? ] any? ;
39 M: object need-return-continuation? drop f ;
41 :: make-return ( quot n lexenv block -- quot )
42 block need-return-continuation? [
43 quot clone [ lexenv return>> <def> '[ _ ] prepend ] change-body
44 n '[ _ _ ncurry callcc1 ]
45 ] [ quot ] if rewrite-closures first ;