Code cleanups

basis/compiler/crossref/crossref.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs classes.algebra compiler.units definitions graphs
-grouping kernel namespaces sequences words
+grouping kernel namespaces sequences words fry
 stack-checker.dependencies ;
 IN: compiler.crossref
 
@@ -23,7 +23,7 @@ compiled-generic-crossref [ H{ } clone ] initialize
     #! don't have to recompile words that folded this away.
     [ compiled-usage ]
     [ "flushable" word-prop inlined-dependency flushed-dependency ? ] bi
-    [ dependency>= nip ] curry assoc-filter ;
+    '[ nip _ dependency>= ] assoc-filter ;
 
 : compiled-usages ( seq -- assocs )
     [ drop word? ] assoc-filter
@@ -42,8 +42,8 @@ compiled-generic-crossref [ H{ } clone ] initialize
     bi-curry* bi ;
 
 : (compiled-unxref) ( word word-prop variable -- )
-    [ [ [ dupd word-prop 2 <groups> ] dip get remove-vertex* ] 2curry ]
+    [ '[ dup _ word-prop 2 <groups> _ get remove-vertex* ] ]
-    [ drop [ remove-word-prop ] curry ]
+    [ drop '[ _ remove-word-prop ] ]
     2bi bi ;
 
 : compiled-unxref ( word -- )

basis/compiler/tests/redefine10.factor

@@ -1,72 +1,85 @@
 USING: eval tools.test compiler.units vocabs words kernel
-definitions sequences ;
+definitions sequences math classes classes.mixin kernel.private ;
 IN: compiler.tests.redefine10
 
 ! Mixin redefinition should update predicate call sites
 
-[ ] [
+MIXIN: my-mixin
-    "USING: kernel math classes ;
+INSTANCE: fixnum my-mixin
-    IN: compiler.tests.redefine10
+: my-inline-1 ( a -- b ) dup my-mixin instance? [ 1 + ] when ;
-    MIXIN: my-mixin
+: my-inline-2 ( a -- b ) dup my-mixin? [ 1 + ] when ;
-    INSTANCE: fixnum my-mixin
+: my-inline-3 ( a -- b ) dup my-mixin? [ float? ] [ drop f ] if ;
-    : my-inline-1 ( a -- b ) dup my-mixin instance? [ 1 + ] when ;
+: my-inline-4 ( a -- b ) dup float? [ my-mixin? ] [ drop f ] if ;
-    : my-inline-2 ( a -- b ) dup my-mixin? [ 1 + ] when ;
+: my-inline-5 ( a -- b ) dup my-mixin? [ fixnum? ] [ drop f ] if ;
-    : my-inline-3 ( a -- b ) dup my-mixin? [ float? ] [ drop f ] if ;
+: my-inline-6 ( a -- b ) dup fixnum? [ my-mixin? ] [ drop f ] if ;
-    : my-inline-4 ( a -- b ) dup float? [ my-mixin? ] [ drop f ] if ;
-    : my-inline-5 ( a -- b ) dup my-mixin? [ fixnum? ] [ drop f ] if ;
-    : my-inline-6 ( a -- b ) dup fixnum? [ my-mixin? ] [ drop f ] if ;"
-    eval( -- )
-] unit-test
 
-[ f ] [
+GENERIC: fake-float? ( obj -- ? )
-    5 "my-inline-3" "compiler.tests.redefine10" lookup execute
-] unit-test
 
-[ f ] [
+M: float fake-float? drop t ;
-    5 "my-inline-4" "compiler.tests.redefine10" lookup execute
+M: object fake-float? drop f ;
-] unit-test
 
-[ t ] [
+: my-fake-inline-3 ( a -- b ) dup my-mixin? [ fake-float? ] [ drop f ] if ;
-    5 "my-inline-5" "compiler.tests.redefine10" lookup execute
-] unit-test
 
-[ t ] [
+: my-baked-inline-3 ( a -- b ) { my-mixin } declare fake-float? ;
-    5 "my-inline-6" "compiler.tests.redefine10" lookup execute
-] unit-test
 
-[ ] [
+[ f ] [ 5 my-inline-3 ] unit-test
-    "USE: math
-    IN: compiler.tests.redefine10
-    INSTANCE: float my-mixin"
-    eval( -- )
-] unit-test
 
-[ 2.0 ] [
+[ f ] [ 5 my-fake-inline-3 ] unit-test
-    1.0 "my-inline-1" "compiler.tests.redefine10" lookup execute
-] unit-test
 
-[ 2.0 ] [
+[ f ] [ 5 my-baked-inline-3 ] unit-test
-    1.0 "my-inline-2" "compiler.tests.redefine10" lookup execute
-] unit-test
 
-[ t ] [
+[ f ] [ 5 my-inline-4 ] unit-test
-    1.0 "my-inline-3" "compiler.tests.redefine10" lookup execute
-] unit-test
 
-[ t ] [
+[ t ] [ 5 my-inline-5 ] unit-test
-    1.0 "my-inline-4" "compiler.tests.redefine10" lookup execute
-] unit-test
 
-[ f ] [
+[ t ] [ 5 my-inline-6 ] unit-test
-    1.0 "my-inline-5" "compiler.tests.redefine10" lookup execute
-] unit-test
 
-[ f ] [
+[ ] [ [ float my-mixin add-mixin-instance ] with-compilation-unit ] unit-test
-    1.0 "my-inline-6" "compiler.tests.redefine10" lookup execute
-] unit-test
 
-[
+[ 2.0 ] [ 1.0 my-inline-1 ] unit-test
-    {
+
-        "my-mixin" "my-inline-1" "my-inline-2"
+[ 2.0 ] [ 1.0 my-inline-2 ] unit-test
-    } [ "compiler.tests.redefine10" lookup forget ] each
+
-] with-compilation-unit
+[ t ] [ 1.0 my-inline-3 ] unit-test
+
+[ t ] [ 1.0 my-fake-inline-3 ] unit-test
+
+[ t ] [ 1.0 my-baked-inline-3 ] unit-test
+
+[ t ] [ 1.0 my-inline-4 ] unit-test
+
+[ f ] [ 1.0 my-inline-5 ] unit-test
+
+[ f ] [ 1.0 my-inline-6 ] unit-test
+
+[ ] [ [ fixnum my-mixin remove-mixin-instance ] with-compilation-unit ] unit-test
+
+[ f ] [ 5 my-inline-3 ] unit-test
+
+[ f ] [ 5 my-fake-inline-3 ] unit-test
+
+[ f ] [ 5 my-baked-inline-3 ] unit-test
+
+[ f ] [ 5 my-inline-4 ] unit-test
+
+[ f ] [ 5 my-inline-5 ] unit-test
+
+[ f ] [ 5 my-inline-6 ] unit-test
+
+[ ] [ [ float my-mixin remove-mixin-instance ] with-compilation-unit ] unit-test
+
+[ 1.0 ] [ 1.0 my-inline-1 ] unit-test
+
+[ 1.0 ] [ 1.0 my-inline-2 ] unit-test
+
+[ f ] [ 1.0 my-inline-3 ] unit-test
+
+[ f ] [ 1.0 my-fake-inline-3 ] unit-test
+
+[ f ] [ 1.0 my-baked-inline-3 ] unit-test
+
+[ f ] [ 1.0 my-inline-4 ] unit-test
+
+[ f ] [ 1.0 my-inline-5 ] unit-test
+
+[ f ] [ 1.0 my-inline-6 ] unit-test

basis/compiler/tree/builder/builder.factor

@@ -50,17 +50,11 @@ PRIVATE>
     [ f ] dip build-tree-with ;
 
 :: build-sub-tree ( in-d out-d word/quot -- nodes/f )
-    #! We don't want methods on mixins to have a declaration for that mixin.
+    [
-    #! This slows down compiler.tree.propagation.inlining since then every
+        in-d word/quot build-tree-with unclip-last in-d>> :> in-d'
-    #! inlined usage of a method has an inline-dependency on the mixin, and
+        {
-    #! not the more specific type at the call site.
+            { [ dup not ] [ ] }
-    f specialize-method? [
+            { [ dup ends-with-terminate? ] [ out-d [ f swap #push ] map append ] }
-        [
+            [ in-d' out-d [ [ length ] bi@ assert= ] [ #copy suffix ] 2bi ]
-            in-d word/quot build-tree-with unclip-last in-d>> :> in-d'
+        } cond
-            {
+    ] [ dup inference-error? [ drop f ] [ rethrow ] if ] recover ;
-                { [ dup not ] [ ] }
-                { [ dup ends-with-terminate? ] [ out-d [ f swap #push ] map append ] }
-                [ in-d' out-d [ [ length ] bi@ assert= ] [ #copy suffix ] 2bi ]
-            } cond
-        ] [ dup inference-error? [ drop f ] [ rethrow ] if ] recover
-    ] with-variable ;

basis/hints/hints.factor

@@ -41,18 +41,13 @@ M: object specializer-declaration class ;
 : specialize-quot ( quot specializer -- quot' )
     [ drop ] [ specializer-cases ] 2bi alist>quot ;
 
-! compiler.tree.propagation.inlining sets this to f
-SYMBOL: specialize-method?
-
-t specialize-method? set-global
-
 : method-declaration ( method -- quot )
     [ "method-generic" word-prop dispatch# object <array> ]
     [ "method-class" word-prop ]
     bi prefix [ declare ] curry [ ] like ;
 
 : specialize-method ( quot method -- quot' )
-    [ specialize-method? get [ method-declaration prepend ] [ drop ] if ]
+    [ method-declaration prepend ]
     [ "method-generic" word-prop ] bi
     specializer [ specialize-quot ] when* ;