compiler.tree.propagation.info: fixed value-info<= so that it handles

slots correctly

if a slot is defined for a value-info, then it can't be <= a value-info
without that slot defined

basis/compiler/tree/propagation/info/info-tests.factor

@@ -96,7 +96,7 @@ STRUCT: self { s self* } ;
     value-info<=
 ] unit-test
 
-{ f f f f } [
+{ f f f f f } [
     ! Checking intervals
     fixnum <class-info> 20 <literal-info> value-info<=
 
@@ -108,4 +108,15 @@ STRUCT: self { s self* } ;
     f c-ptr <class-info> 2array self <tuple-info>
     f byte-array <class-info> 2array self <tuple-info>
     value-info<=
+
+    ! If one value-info has a slot specified and the other doesn't,
+    ! then it can't be smaller because that other slot could be
+    ! anything!
+    self <class-info>
+    f byte-array <class-info> 2array self <tuple-info> value-info<=
+] unit-test
+
+{ t f } [
+    10 <literal-info> f value-info<=
+    f 10 <literal-info> value-info<=
 ] unit-test

basis/compiler/tree/propagation/info/info.factor

@@ -3,7 +3,7 @@
 USING: accessors arrays assocs byte-arrays classes
 classes.algebra classes.singleton classes.tuple
 classes.tuple.private combinators combinators.short-circuit
-compiler.tree.propagation.copy kernel layouts math
+compiler.tree.propagation.copy compiler.utilities kernel layouts math
 math.intervals namespaces sequences sequences.private strings
 words ;
 IN: compiler.tree.propagation.info
@@ -265,19 +265,13 @@ DEFER: (value-info-union)
     } cond ;
 
 : value-info<= ( info1 info2 -- ? )
+    [ [ object-info ] unless* ] bi@
     {
-        { [ dup not ] [ 2drop t ] }
+        [ [ class>> ] bi@ class<= ]
-        { [ over not ] [ 2drop f ] }
+        [ [ interval>> ] bi@ interval-subset? ]
-        [
+        [ literals<= ]
-            {
+        [ [ slots>> ] bi@ f pad-tail-shorter [ value-info<= ] 2all? ]
-                { [ 2dup [ class>> ] bi@ class<= not ] [ f ] }
+    } 2&& ;
-                { [ 2dup [ interval>> ] bi@ interval-subset? not ] [ f ] }
-                { [ 2dup literals<= not ] [ f ] }
-                { [ 2dup [ slots>> ] bi@ [ value-info<= ] 2all? not ] [ f ] }
-                [ t ]
-            } cond 2nip
-        ]
-    } cond ;
 
 SYMBOL: value-infos
 

basis/compiler/utilities/utilities-docs.factor

@@ -1,7 +1,17 @@
-USING: assocs compiler.cfg.ssa.destruction.leaders help.markup help.syntax math
+USING: assocs compiler.cfg.ssa.destruction.leaders help.markup help.syntax
-sequences ;
+kernel math sequences ;
 IN: compiler.utilities
 
 HELP: compress-path
 { $values { "source" integer } { "assoc" assoc } { "destination" integer } }
 { $description "Gets the original definer for a vreg number. Then inserts a direct path from 'source' to that definer. For example if the assoc is " { $code "{ { 1 2 } { 2 3 } { 3 4 } { 4 4 } }" } "then the original definer of 1 is 4. The word is used by " { $link leader } " to figure out what the top leader of a vreg is." } ;
+
+HELP: pad-tail-shorter
+{ $values
+  { "seq1" sequence }
+  { "seq2" sequence }
+  { "elt" object }
+  { "seq1'" sequence }
+  { "seq2'" sequence }
+}
+{ $description "Pads the tail of the shorter sequence so that both sequences have the same length." } ;

basis/compiler/utilities/utilities.factor

@@ -22,6 +22,9 @@ IN: compiler.utilities
 
 : 2map-flat ( seq quot -- seq' ) [ 2each ] flattening ; inline
 
+: pad-tail-shorter ( seq1 seq2 elt -- seq1' seq2' )
+    2over longer length swap [ pad-tail ] 2curry bi@ ;
+
 SYMBOL: yield-hook
 
 yield-hook [ [ ] ] initialize