diff --git a/extra/smalltalk/compiler/assignment/assignment.factor b/extra/smalltalk/compiler/assignment/assignment.factor new file mode 100644 index 0000000000..3a0a769f86 --- /dev/null +++ b/extra/smalltalk/compiler/assignment/assignment.factor @@ -0,0 +1,36 @@ +! 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 diff --git a/extra/smalltalk/compiler/assignment/authors.txt b/extra/smalltalk/compiler/assignment/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/extra/smalltalk/compiler/assignment/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/extra/smalltalk/compiler/return/authors.txt b/extra/smalltalk/compiler/return/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/extra/smalltalk/compiler/return/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/extra/smalltalk/compiler/return/return.factor b/extra/smalltalk/compiler/return/return.factor new file mode 100644 index 0000000000..31b4a1511b --- /dev/null +++ b/extra/smalltalk/compiler/return/return.factor @@ -0,0 +1,50 @@ +! 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