From 6501480a0e7eb83511aa1d70194eb3a756e8689f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 20 Feb 2010 12:01:47 +1300 Subject: [PATCH] Fix two problems with recompilation: predicate constant folding was recording unsatisfied dependencies in some cases, and literal tuple instances of forgotten classes would cause problems for method inlining --- basis/compiler/crossref/crossref-tests.factor | 9 ++++++ basis/compiler/tests/redefine22.factor | 11 +++++++ basis/compiler/tests/redefine23.factor | 13 ++++++++ basis/compiler/tree/cleanup/cleanup.factor | 13 +++++--- .../tree/propagation/info/info.factor | 21 ++++++++---- .../tree/propagation/propagation-tests.factor | 6 ++-- .../tree/propagation/simple/simple.factor | 9 ++---- .../dependencies/dependencies.factor | 32 +++++++++---------- core/classes/algebra/algebra.factor | 9 ++++++ 9 files changed, 87 insertions(+), 36 deletions(-) create mode 100644 basis/compiler/crossref/crossref-tests.factor create mode 100644 basis/compiler/tests/redefine22.factor create mode 100644 basis/compiler/tests/redefine23.factor diff --git a/basis/compiler/crossref/crossref-tests.factor b/basis/compiler/crossref/crossref-tests.factor new file mode 100644 index 0000000000..9cd475b2de --- /dev/null +++ b/basis/compiler/crossref/crossref-tests.factor @@ -0,0 +1,9 @@ +USING: compiler.crossref fry kernel sequences tools.test vocabs words ; +IN: compiler.crossref.tests + +! Dependencies of all words should always be satisfied unless we're +! in the middle of recompiling something +[ { } ] [ + all-words dup [ subwords ] map concat append + H{ } clone '[ _ dependencies-satisfied? not ] filter +] unit-test diff --git a/basis/compiler/tests/redefine22.factor b/basis/compiler/tests/redefine22.factor new file mode 100644 index 0000000000..5837d68c73 --- /dev/null +++ b/basis/compiler/tests/redefine22.factor @@ -0,0 +1,11 @@ +IN: compiler.tests.redefine22 +USING: kernel sequences compiler.units vocabs tools.test definitions ; + +TUPLE: ttt ; +INSTANCE: ttt sequence +M: ttt new-sequence 2drop ttt new ; + +: www-1 ( a -- b ) T{ ttt } new-sequence ; + +! This used to break with a compiler error in the above word +[ ] [ [ \ ttt forget ] with-compilation-unit ] unit-test diff --git a/basis/compiler/tests/redefine23.factor b/basis/compiler/tests/redefine23.factor new file mode 100644 index 0000000000..e6061937b6 --- /dev/null +++ b/basis/compiler/tests/redefine23.factor @@ -0,0 +1,13 @@ +IN: compiler.tests.redefine23 +USING: classes.struct specialized-arrays alien.c-types sequences +compiler.units vocabs tools.test ; + +STRUCT: my-struct { x int } ; +SPECIALIZED-ARRAY: my-struct +: my-word ( a -- b ) iota [ my-struct ] my-struct-array{ } map-as ; + +[ ] [ + [ + "specialized-arrays.instances.compiler.tests.redefine23" forget-vocab + ] with-compilation-unit +] unit-test diff --git a/basis/compiler/tree/cleanup/cleanup.factor b/basis/compiler/tree/cleanup/cleanup.factor index b19c99c360..b69f053898 100644 --- a/basis/compiler/tree/cleanup/cleanup.factor +++ b/basis/compiler/tree/cleanup/cleanup.factor @@ -51,11 +51,16 @@ GENERIC: cleanup* ( node -- node/nodes ) [ in-d>> #drop ] bi prefix ; -: record-predicate-folding ( #call -- ) - [ node-input-infos first class>> ] +: >predicate-folding< ( #call -- value-info class result ) + [ node-input-infos first ] [ word>> "predicating" word-prop ] - [ node-output-infos first literal>> ] tri - [ depends-on-class<= ] [ depends-on-classes-disjoint ] if ; + [ node-output-infos first literal>> ] tri ; + +: record-predicate-folding ( #call -- ) + >predicate-folding< pick literal?>> + [ [ literal>> ] 2dip depends-on-instance-predicate ] + [ [ class>> ] 2dip depends-on-class-predicate ] + if ; : record-folding ( #call -- ) dup word>> predicate? diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor index 28ffb96f8f..7f5b9f6fcd 100644 --- a/basis/compiler/tree/propagation/info/info.factor +++ b/basis/compiler/tree/propagation/info/info.factor @@ -1,10 +1,11 @@ -! Copyright (C) 2008, 2009 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs classes classes.algebra classes.tuple -classes.tuple.private kernel accessors math math.intervals namespaces -sequences sequences.private words combinators memoize -combinators.short-circuit byte-arrays strings arrays layouts -cpu.architecture compiler.tree.propagation.copy ; +classes.tuple.private classes.singleton kernel accessors math +math.intervals namespaces sequences sequences.private words +combinators memoize combinators.short-circuit byte-arrays +strings arrays layouts cpu.architecture +compiler.tree.propagation.copy ; IN: compiler.tree.propagation.info : false-class? ( class -- ? ) \ f class<= ; @@ -65,9 +66,17 @@ DEFER: UNION: fixed-length array byte-array string ; +: literal-class ( obj -- class ) + #! Handle forgotten tuples and singleton classes properly + dup singleton-class? [ + class dup class? [ + drop tuple + ] unless + ] unless ; + : init-literal-info ( info -- info ) empty-interval >>interval - dup literal>> class >>class + dup literal>> literal-class >>class dup literal>> { { [ dup real? ] [ [a,a] >>interval ] } { [ dup tuple? ] [ tuple-slot-infos >>slots ] } diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index e2bfe58788..444a424766 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -648,7 +648,7 @@ M: array iterate first t ; inline ] final-info drop ] unit-test -[ V{ word } ] [ +[ V{ t } ] [ [ { hashtable } declare hashtable instance? ] final-classes ] unit-test @@ -660,7 +660,7 @@ M: array iterate first t ; inline [ { assoc } declare hashtable instance? ] final-classes ] unit-test -[ V{ word } ] [ +[ V{ t } ] [ [ { string } declare string? ] final-classes ] unit-test @@ -774,7 +774,7 @@ MIXIN: empty-mixin [ { fixnum } declare log2 ] final-classes ] unit-test -[ V{ word } ] [ +[ V{ t } ] [ [ { fixnum } declare log2 0 >= ] final-classes ] unit-test diff --git a/basis/compiler/tree/propagation/simple/simple.factor b/basis/compiler/tree/propagation/simple/simple.factor index ccfd6ffabd..ed417ef9d7 100644 --- a/basis/compiler/tree/propagation/simple/simple.factor +++ b/basis/compiler/tree/propagation/simple/simple.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008, 2009 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: fry accessors kernel sequences sequences.private assocs words namespaces classes.algebra combinators @@ -93,11 +93,8 @@ M: #declare propagate-before recover ; : predicate-output-infos/class ( info class -- info ) - [ class>> ] dip { - { [ 2dup class<= ] [ t ] } - { [ 2dup classes-intersect? not ] [ f ] } - [ object-info ] - } cond 2nip ; + [ class>> ] dip compare-classes + dup +incomparable+ eq? [ drop object-info ] [ ] if ; : predicate-output-infos ( info class -- info ) over literal?>> diff --git a/basis/stack-checker/dependencies/dependencies.factor b/basis/stack-checker/dependencies/dependencies.factor index df68fa8961..5469000e84 100644 --- a/basis/stack-checker/dependencies/dependencies.factor +++ b/basis/stack-checker/dependencies/dependencies.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs accessors classes.algebra fry generic kernel math -namespaces sequences words sets combinators.short-circuit -classes.tuple ; +USING: assocs accessors classes classes.algebra fry generic +kernel math namespaces sequences words sets +combinators.short-circuit classes.tuple ; FROM: classes.tuple.private => tuple-layout ; IN: stack-checker.dependencies @@ -57,28 +57,26 @@ GENERIC: satisfied? ( dependency -- ? ) boa conditional-dependencies get dup [ conjoin ] [ 2drop ] if ; inline -TUPLE: depends-on-class<= class1 class2 ; +TUPLE: depends-on-class-predicate class1 class2 result ; -: depends-on-class<= ( class1 class2 -- ) - \ depends-on-class<= add-conditional-dependency ; +: depends-on-class-predicate ( class1 class2 result -- ) + \ depends-on-class-predicate add-conditional-dependency ; -M: depends-on-class<= satisfied? +M: depends-on-class-predicate satisfied? { - [ class1>> classoid? ] - [ class2>> classoid? ] - [ [ class1>> ] [ class2>> ] bi class<= ] + [ [ class1>> classoid? ] [ class2>> classoid? ] bi and ] + [ [ [ class1>> ] [ class2>> ] bi compare-classes ] [ result>> ] bi eq? ] } 1&& ; -TUPLE: depends-on-classes-disjoint class1 class2 ; +TUPLE: depends-on-instance-predicate object class result ; -: depends-on-classes-disjoint ( class1 class2 -- ) - \ depends-on-classes-disjoint add-conditional-dependency ; +: depends-on-instance-predicate ( object class result -- ) + \ depends-on-instance-predicate add-conditional-dependency ; -M: depends-on-classes-disjoint satisfied? +M: depends-on-instance-predicate satisfied? { - [ class1>> classoid? ] - [ class2>> classoid? ] - [ [ class1>> ] [ class2>> ] bi classes-intersect? not ] + [ class>> classoid? ] + [ [ [ object>> ] [ class>> ] bi instance? ] [ result>> ] bi eq? ] } 1&& ; TUPLE: depends-on-next-method class generic next-method ; diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index 69289600e4..f9aaf3eaa5 100644 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -234,3 +234,12 @@ ERROR: topological-sort-failed ; : flatten-class ( class -- assoc ) [ (flatten-class) ] H{ } make-assoc ; + +SYMBOL: +incomparable+ + +: compare-classes ( class1 class2 -- ? ) + { + { [ 2dup class<= ] [ t ] } + { [ 2dup classes-intersect? not ] [ f ] } + [ +incomparable+ ] + } cond 2nip ;