]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/smalltalk/compiler/compiler.factor
factor: trim using lists
[factor.git] / extra / smalltalk / compiler / compiler.factor
index 2eeee306925bb4db811a6466b71ea0b07a9f735a..88e0f8a1199de071a5a2a1703c9064909ba5faed 100644 (file)
@@ -1,11 +1,10 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs combinators.short-circuit
-continuations fry kernel namespaces quotations sequences sets
-generalizations slots locals.types splitting math
-locals.rewrite.closures generic words combinators locals smalltalk.ast
-smalltalk.compiler.lexenv smalltalk.compiler.assignment
-smalltalk.compiler.return smalltalk.selectors smalltalk.classes ;
+USING: accessors arrays assocs combinators continuations
+generic kernel locals.types math quotations sequences
+sequences.generalizations sets smalltalk.ast smalltalk.classes
+smalltalk.compiler.assignment smalltalk.compiler.lexenv
+smalltalk.compiler.return smalltalk.selectors splitting words ;
 IN: smalltalk.compiler
 
 GENERIC: compile-ast ( lexenv ast -- quot )
@@ -67,12 +66,9 @@ M: ast-return compile-ast
 
 : block-lexenv ( block -- lexenv )
     [ [ arguments>> ] [ temporaries>> ] bi append ]
-    [ body>> [ assigned-locals ] map concat unique ] bi
+    [ body>> [ assigned-locals ] map concat fast-set ] bi
     '[
-        dup dup _ key?
-        [ <local-reader> ]
-        [ <local> ]
-        if
+        dup dup _ in? [ <local-reader> ] [ <local> ] if
     ] H{ } map>assoc
     dup
     [ nip local-reader? ] assoc-filter
@@ -123,7 +119,7 @@ M: ast-block compile-ast
     [ lexenv self>> suffix ] dip <lambda> ;
 
 : compile-method-body ( lexenv block -- quot )
-    [ [ (compile-method-body) ] [ arguments>> length 1+ ] bi ] 2keep
+    [ [ (compile-method-body) ] [ arguments>> length 1 + ] bi ] 2keep
     make-return ;
 
 : compile-method ( lexenv ast-method -- )
@@ -138,7 +134,7 @@ M: ast-class compile-ast
     nip
     [
         [ name>> ] [ superclass>> ] [ ivars>> ] tri
-        define-class <class-lexenv> 
+        define-class <class-lexenv>
     ]
     [ methods>> ] bi
     [ compile-method ] with each
@@ -148,10 +144,10 @@ ERROR: no-word name ;
 
 M: ast-foreign compile-ast
     nip
-    [ class>> dup ":" split1 lookup [ ] [ no-word ] ?if ]
+    [ class>> dup ":" split1 lookup-word [ ] [ no-word ] ?if ]
     [ name>> ] bi define-foreign
     [ nil ] ;
 
 : compile-smalltalk ( statement -- quot )
     [ empty-lexenv ] dip [ compile-sequence nip 0 ]
-    2keep make-return ;
\ No newline at end of file
+    2keep make-return ;