compiler.tree.propagation: better length propagation

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

@@ -1,8 +1,8 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 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 words combinators
+namespaces sequences words combinators byte-arrays strings
 arrays compiler.tree.propagation.copy ;
 IN: compiler.tree.propagation.info
 
@@ -66,12 +66,17 @@ DEFER: <literal-info>
     [ read-only>> [ <literal-info> ] [ drop f ] if ] 2map
     f prefix ;
 
+UNION: fixed-length array byte-array string ;
+
 : init-literal-info ( info -- info )
+    [-inf,inf] >>interval
     dup literal>> class >>class
-    dup literal>> dup real? [ [a,a] >>interval ] [
+    dup literal>> {
-        [ [-inf,inf] >>interval ] dip
+        { [ dup real? ] [ [a,a] >>interval ] }
-        dup tuple? [ tuple-slot-infos >>slots ] [ drop ] if
+        { [ dup tuple? ] [ tuple-slot-infos >>slots ] }
-    ] if ; inline
+        { [ dup fixed-length? ] [ length <literal-info> >>length ] }
+        [ drop ]
+    } cond ; inline
 
 : init-value-info ( info -- info )
     dup literal?>> [

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

@@ -331,6 +331,16 @@ cell-bits 32 = [
     [ { fixnum } declare dup 10 eq? [ "A" throw ] unless ] final-literals
 ] unit-test
 
+[ V{ 3 } ] [ [ [ { 1 2 3 } ] [ { 4 5 6 } ] if length ] final-literals ] unit-test
+
+[ V{ 3 } ] [ [ [ B{ 1 2 3 } ] [ B{ 4 5 6 } ] if length ] final-literals ] unit-test
+
+[ V{ 3 } ] [ [ [ "yay" ] [ "hah" ] if length ] final-literals ] unit-test
+
+[ V{ 3 } ] [ [ 3 <byte-array> length ] final-literals ] unit-test
+
+[ V{ 3 } ] [ [ 3 f <string> length ] final-literals ] unit-test
+
 ! Slot propagation
 TUPLE: prop-test-tuple { x integer } ;