diff --git a/basis/compiler/crossref/crossref.factor b/basis/compiler/crossref/crossref.factor index e216a1f147..bd6e25999a 100644 --- a/basis/compiler/crossref/crossref.factor +++ b/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 ] dip get remove-vertex* ] 2curry ] - [ drop [ remove-word-prop ] curry ] + [ '[ dup _ word-prop 2 _ get remove-vertex* ] ] + [ drop '[ _ remove-word-prop ] ] 2bi bi ; : compiled-unxref ( word -- ) diff --git a/basis/compiler/tests/redefine10.factor b/basis/compiler/tests/redefine10.factor index e8d9a22e97..c23ce8cd8b 100644 --- a/basis/compiler/tests/redefine10.factor +++ b/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 -[ ] [ - "USING: kernel math classes ; - IN: compiler.tests.redefine10 - MIXIN: my-mixin - INSTANCE: fixnum my-mixin - : my-inline-1 ( a -- b ) dup my-mixin instance? [ 1 + ] when ; - : my-inline-2 ( a -- b ) dup my-mixin? [ 1 + ] when ; - : my-inline-3 ( a -- b ) dup my-mixin? [ float? ] [ 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 +MIXIN: my-mixin +INSTANCE: fixnum my-mixin +: my-inline-1 ( a -- b ) dup my-mixin instance? [ 1 + ] when ; +: my-inline-2 ( a -- b ) dup my-mixin? [ 1 + ] when ; +: my-inline-3 ( a -- b ) dup my-mixin? [ float? ] [ 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 ; -[ f ] [ - 5 "my-inline-3" "compiler.tests.redefine10" lookup execute -] unit-test +GENERIC: fake-float? ( obj -- ? ) -[ f ] [ - 5 "my-inline-4" "compiler.tests.redefine10" lookup execute -] unit-test +M: float fake-float? drop t ; +M: object fake-float? drop f ; -[ t ] [ - 5 "my-inline-5" "compiler.tests.redefine10" lookup execute -] unit-test +: my-fake-inline-3 ( a -- b ) dup my-mixin? [ fake-float? ] [ drop f ] if ; -[ t ] [ - 5 "my-inline-6" "compiler.tests.redefine10" lookup execute -] unit-test +: my-baked-inline-3 ( a -- b ) { my-mixin } declare fake-float? ; -[ ] [ - "USE: math - IN: compiler.tests.redefine10 - INSTANCE: float my-mixin" - eval( -- ) -] unit-test +[ f ] [ 5 my-inline-3 ] unit-test -[ 2.0 ] [ - 1.0 "my-inline-1" "compiler.tests.redefine10" lookup execute -] unit-test +[ f ] [ 5 my-fake-inline-3 ] unit-test -[ 2.0 ] [ - 1.0 "my-inline-2" "compiler.tests.redefine10" lookup execute -] unit-test +[ f ] [ 5 my-baked-inline-3 ] unit-test -[ t ] [ - 1.0 "my-inline-3" "compiler.tests.redefine10" lookup execute -] unit-test +[ f ] [ 5 my-inline-4 ] unit-test -[ t ] [ - 1.0 "my-inline-4" "compiler.tests.redefine10" lookup execute -] unit-test +[ t ] [ 5 my-inline-5 ] unit-test -[ f ] [ - 1.0 "my-inline-5" "compiler.tests.redefine10" lookup execute -] unit-test +[ t ] [ 5 my-inline-6 ] unit-test -[ f ] [ - 1.0 "my-inline-6" "compiler.tests.redefine10" lookup execute -] unit-test +[ ] [ [ float my-mixin add-mixin-instance ] with-compilation-unit ] unit-test -[ - { - "my-mixin" "my-inline-1" "my-inline-2" - } [ "compiler.tests.redefine10" lookup forget ] each -] with-compilation-unit +[ 2.0 ] [ 1.0 my-inline-1 ] unit-test + +[ 2.0 ] [ 1.0 my-inline-2 ] unit-test + +[ 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 diff --git a/basis/compiler/tree/builder/builder.factor b/basis/compiler/tree/builder/builder.factor index 8eb66fde1f..024a7bacca 100644 --- a/basis/compiler/tree/builder/builder.factor +++ b/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 - #! inlined usage of a method has an inline-dependency on the mixin, and - #! not the more specific type at the call site. - f specialize-method? [ - [ - in-d word/quot build-tree-with unclip-last in-d>> :> in-d' - { - { [ 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 ; \ No newline at end of file + [ + in-d word/quot build-tree-with unclip-last in-d>> :> in-d' + { + { [ 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 ; \ No newline at end of file diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor index e4bbb3459e..7a3fa323d2 100644 --- a/basis/hints/hints.factor +++ b/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 ] [ "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* ;