diff --git a/basis/compiler/tree/propagation/info/info-docs.factor b/basis/compiler/tree/propagation/info/info-docs.factor index 8dcc9db3f9..40c5e7bb6d 100644 --- a/basis/compiler/tree/propagation/info/info-docs.factor +++ b/basis/compiler/tree/propagation/info/info-docs.factor @@ -1,6 +1,20 @@ -USING: compiler.tree help.markup help.syntax math sequences ; +USING: classes compiler.tree help.markup help.syntax kernel math math.intervals +sequences ; IN: compiler.tree.propagation.info +HELP: interval>literal +{ $values + { "class" class } + { "interval" interval } + { "literal" "a literal value" } + { "literal?" boolean } +} +{ $description "If interval has zero length and the class is sufficiently precise, we can turn it into a literal." } ; + +HELP: literal-class +{ $values { "obj" object } { "class" class } } +{ $description "Handle forgotten tuples and singleton classes properly." } ; + HELP: node-input-infos { $values { "node" node } { "seq" sequence } } { $description "Lists the value infos for the input variables of an SSA tree node." } ; @@ -13,6 +27,10 @@ HELP: value-info { $values { "value" integer } { "info" value-info-state } } { $description "Gets the value info for the given SSA value. If none is found then a null empty interval is returned." } ; +HELP: value-info<= +{ $values { "info1" value-info } { "info2" value-info } { "?" boolean } } +{ $description "Checks if the first value info is equal to, or smaller than the second one." } ; + HELP: value-info-state { $class-description "Represents constraints the compiler knows about the input and output variables to an SSA tree node. It has the following slots:" { $table @@ -34,6 +52,12 @@ ARTICLE: "compiler.tree.propagation.info" "Value info data type and operations" node-input-infos node-output-infos value-info +} +"Value info operations:" +{ $subsections + value-info<= + value-info-union + value-infos-union } ; ABOUT: "compiler.tree.propagation.info" diff --git a/basis/compiler/tree/propagation/info/info-tests.factor b/basis/compiler/tree/propagation/info/info-tests.factor index 6a70361ae5..23a6d0ae39 100644 --- a/basis/compiler/tree/propagation/info/info-tests.factor +++ b/basis/compiler/tree/propagation/info/info-tests.factor @@ -1,5 +1,5 @@ -USING: accessors math math.intervals sequences classes.algebra -kernel tools.test compiler.tree.propagation.info arrays ; +USING: accessors alien byte-arrays classes.struct math math.intervals sequences +classes.algebra kernel tools.test compiler.tree.propagation.info arrays ; IN: compiler.tree.propagation.info.tests { f } [ 0.0 -0.0 eql? ] unit-test @@ -64,10 +64,6 @@ TUPLE: test-tuple { x read-only } ; object-info value-info-intersect = ] unit-test -{ t } [ - null-info 3 value-info<= -] unit-test - { t t } [ f fixnum 0 40 [a,b] @@ -77,3 +73,39 @@ TUPLE: test-tuple { x read-only } ; [ class>> fixnum class= ] [ interval>> 0 40 [a,b] = ] bi ] unit-test + +! interval>literal +{ 10 t } [ + fixnum 10 10 [a,b] interval>literal +] unit-test + +STRUCT: self { s self* } ; + +! value-info<= +{ t t t t t t } [ + byte-array c-ptr value-info<= + null-info 3 value-info<= + null-info null-info value-info<= + alien c-ptr value-info<= + + 20 fixnum value-info<= + + ! A byte-array is a kind of c-ptr + f byte-array 2array self + f c-ptr 2array self + value-info<= +] unit-test + +{ f f f f } [ + ! Checking intervals + fixnum 20 value-info<= + + ! Mutable literals + [ "foo" ] [ "foo" ] value-info<= + ! Strings should be immutable but they aren't. :/ + "hey" "hey" value-info<= + + f c-ptr 2array self + f byte-array 2array self + value-info<= +] unit-test diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor index 9d1ba98e4a..e3637eb9f7 100644 --- a/basis/compiler/tree/propagation/info/info.factor +++ b/basis/compiler/tree/propagation/info/info.factor @@ -23,19 +23,17 @@ M: float eql? over float? [ [ double>bits ] same? ] [ 2drop f ] if ; M: complex eql? over complex? [ = ] [ 2drop f ] if ; TUPLE: value-info-state -class -interval -literal -literal? -slots ; + class + interval + literal + literal? + slots ; CONSTANT: null-info T{ value-info-state f null empty-interval } CONSTANT: object-info T{ value-info-state f object full-interval } : interval>literal ( class interval -- literal literal? ) - ! If interval has zero length and the class is sufficiently - ! precise, we can turn it into a literal dup special-interval? [ 2drop f f ] [ @@ -60,7 +58,6 @@ DEFER: UNION: fixed-length array byte-array string ; : literal-class ( obj -- class ) - ! Handle forgotten tuples and singleton classes properly dup singleton-class? [ class-of dup class? [ drop tuple