factor: trim using lists

[factor.git] / extra / smalltalk / compiler / return / return.factor

diff --git a/extra/smalltalk/compiler/return/return.factor b/extra/smalltalk/compiler/return/return.factor
index 31b4a1511b24f48c58683a58d0e988994cf78ba6..1cb783047e43d350a227bb80e5a9a16689dca16d 100644 (file)
--- a/extra/smalltalk/compiler/return/return.factor
+++ b/extra/smalltalk/compiler/return/return.factor
@@ -1,8 +1,8 @@
 ! 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 ;
+generalizations kernel locals.rewrite locals.types sequences
+smalltalk.ast ;
 IN: smalltalk.compiler.return
 
 SYMBOL: return-continuation
@@ -17,13 +17,13 @@ M: ast-message-send need-return-continuation?
     {
         [ receiver>> need-return-continuation? ]
         [ arguments>> need-return-continuation? ]
-    } 1&& ;
+    } 1|| ;
 
 M: ast-cascade need-return-continuation?
     {
         [ receiver>> need-return-continuation? ]
         [ messages>> need-return-continuation? ]
-    } 1&& ;
+    } 1|| ;
 
 M: ast-message need-return-continuation?
     arguments>> need-return-continuation? ;
@@ -38,13 +38,8 @@ 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
+:: make-return ( quot n lexenv block -- quot )
+    block need-return-continuation? [
+        quot clone [ lexenv return>> <def> '[ _ ] prepend ] change-body
+        n '[ _ _ ncurry callcc1 ]
+    ] [ quot ] if rewrite-closures first ;