--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays kernel sequences sets smalltalk.ast ;
+IN: smalltalk.compiler.assignment
+
+GENERIC: assigned-locals ( ast -- seq )
+
+M: ast-return assigned-locals value>> assigned-locals ;
+
+M: ast-block assigned-locals
+ [ body>> assigned-locals ] [ arguments>> ] bi diff ;
+
+M: ast-message-send assigned-locals
+ [ receiver>> assigned-locals ]
+ [ arguments>> assigned-locals ]
+ bi append ;
+
+M: ast-cascade assigned-locals
+ [ receiver>> assigned-locals ]
+ [ messages>> assigned-locals ]
+ bi append ;
+
+M: ast-message assigned-locals
+ arguments>> assigned-locals ;
+
+M: ast-assignment assigned-locals
+ [ name>> dup ast-name? [ name>> 1array ] [ drop { } ] if ]
+ [ value>> assigned-locals ] bi append ;
+
+M: ast-sequence assigned-locals
+ body>> assigned-locals ;
+
+M: array assigned-locals
+ [ assigned-locals ] map concat ;
+
+M: object assigned-locals drop f ;
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays combinators.short-circuit continuations
+fry generalizations kernel locals.rewrite.closures namespaces
+sequences smalltalk.ast ;
+IN: smalltalk.compiler.return
+
+SYMBOL: return-continuation
+
+GENERIC: need-return-continuation? ( ast -- ? )
+
+M: ast-return need-return-continuation? drop t ;
+
+M: ast-block need-return-continuation? body>> need-return-continuation? ;
+
+M: ast-message-send need-return-continuation?
+ {
+ [ receiver>> need-return-continuation? ]
+ [ arguments>> need-return-continuation? ]
+ } 1&& ;
+
+M: ast-cascade need-return-continuation?
+ {
+ [ receiver>> need-return-continuation? ]
+ [ messages>> need-return-continuation? ]
+ } 1&& ;
+
+M: ast-message need-return-continuation?
+ arguments>> need-return-continuation? ;
+
+M: ast-assignment need-return-continuation?
+ value>> need-return-continuation? ;
+
+M: ast-sequence need-return-continuation?
+ body>> need-return-continuation? ;
+
+M: array need-return-continuation? [ need-return-continuation? ] any? ;
+
+M: object need-return-continuation? drop f ;
+
+: make-return ( quot n block -- quot )
+ need-return-continuation? [
+ '[
+ [
+ _ _ ncurry
+ [ return-continuation set ] prepose callcc1
+ ] with-scope
+ ]
+ ] [ drop ] if
+ rewrite-closures first ;
\ No newline at end of file