! 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
#! 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
bi-curry* bi ;
: (compiled-unxref) ( word word-prop variable -- )
- [ [ [ dupd word-prop 2 <groups> ] dip get remove-vertex* ] 2curry ]
- [ drop [ remove-word-prop ] curry ]
+ [ '[ dup _ word-prop 2 <groups> _ get remove-vertex* ] ]
+ [ drop '[ _ remove-word-prop ] ]
2bi bi ;
: compiled-unxref ( word -- )
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
-
-[ f ] [
- 5 "my-inline-3" "compiler.tests.redefine10" lookup execute
-] unit-test
-
-[ f ] [
- 5 "my-inline-4" "compiler.tests.redefine10" lookup execute
-] unit-test
-
-[ t ] [
- 5 "my-inline-5" "compiler.tests.redefine10" lookup execute
-] unit-test
-
-[ t ] [
- 5 "my-inline-6" "compiler.tests.redefine10" lookup execute
-] unit-test
-
-[ ] [
- "USE: math
- IN: compiler.tests.redefine10
- INSTANCE: float my-mixin"
- eval( -- )
-] unit-test
-
-[ 2.0 ] [
- 1.0 "my-inline-1" "compiler.tests.redefine10" lookup execute
-] unit-test
-
-[ 2.0 ] [
- 1.0 "my-inline-2" "compiler.tests.redefine10" lookup execute
-] unit-test
-
-[ t ] [
- 1.0 "my-inline-3" "compiler.tests.redefine10" lookup execute
-] unit-test
-
-[ t ] [
- 1.0 "my-inline-4" "compiler.tests.redefine10" lookup execute
-] unit-test
-
-[ f ] [
- 1.0 "my-inline-5" "compiler.tests.redefine10" lookup execute
-] unit-test
-
-[ f ] [
- 1.0 "my-inline-6" "compiler.tests.redefine10" lookup execute
-] unit-test
-
-[
- {
- "my-mixin" "my-inline-1" "my-inline-2"
- } [ "compiler.tests.redefine10" lookup forget ] each
-] with-compilation-unit
+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 ;
+
+GENERIC: fake-float? ( obj -- ? )
+
+M: float fake-float? drop t ;
+M: object fake-float? drop f ;
+
+: my-fake-inline-3 ( a -- b ) dup my-mixin? [ fake-float? ] [ drop f ] if ;
+
+: my-baked-inline-3 ( a -- b ) { my-mixin } declare fake-float? ;
+
+[ 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
+
+[ t ] [ 5 my-inline-5 ] unit-test
+
+[ t ] [ 5 my-inline-6 ] unit-test
+
+[ ] [ [ float my-mixin add-mixin-instance ] with-compilation-unit ] unit-test
+
+[ 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
[ 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
: 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* ;
projects / factor.git / commitdiff