Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / compiler / tree / propagation / slots / slots.factor

diff --git a/basis/compiler/tree/propagation/slots/slots.factor b/basis/compiler/tree/propagation/slots/slots.factor
index 08a8520d0a376d75c97c9c7654e40cc89df315a1..4996729ded72a235de05968f5931dd8f8fbf8674 100644 (file)
--- a/basis/compiler/tree/propagation/slots/slots.factor
+++ b/basis/compiler/tree/propagation/slots/slots.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry assocs arrays byte-arrays strings accessors sequences
 kernel slots classes.algebra classes.tuple classes.tuple.private
@@ -8,18 +8,16 @@ IN: compiler.tree.propagation.slots
 
 ! Propagation of immutable slots and array lengths
 
-! Revisit this code when delegation is removed and when complex
-! numbers become tuples.
-
 UNION: fixed-length-sequence array byte-array string ;
 
 : sequence-constructor? ( word -- ? )
-    { <array> <byte-array> <string> } memq? ;
+    { <array> <byte-array> (byte-array) <string> } memq? ;
 
 : constructor-output-class ( word -- class )
     {
         { <array> array }
         { <byte-array> byte-array }
+        { (byte-array) byte-array }
         { <string> string }
     } at ;
 
@@ -28,33 +26,26 @@ UNION: fixed-length-sequence array byte-array string ;
     [ constructor-output-class <class-info> ]
     bi* value-info-intersect 1array ;
 
-: tuple-constructor? ( word -- ? )
-    { <tuple-boa> <complex> } memq? ;
-
 : fold-<tuple-boa> ( values class -- info )
     [ [ literal>> ] map ] dip prefix >tuple
     <literal-info> ;
 
+: read-only-slots ( values class -- slots )
+    all-slots
+    [ read-only>> [ value-info ] [ drop f ] if ] 2map
+    f prefix ;
+
 : (propagate-tuple-constructor) ( values class -- info )
-    [ [ value-info ] map ] dip [ read-only-slots ] keep
+    [ read-only-slots ] keep
     over rest-slice [ dup [ literal?>> ] when ] all? [
         [ rest-slice ] dip fold-<tuple-boa>
     ] [
         <tuple-info>
     ] if ;
 
-: propagate-<tuple-boa> ( #call -- info )
+: propagate-<tuple-boa> ( #call -- infos )
     in-d>> unclip-last
-    value-info literal>> class>> (propagate-tuple-constructor) ;
-
-: propagate-<complex> ( #call -- info )
-    in-d>> [ value-info ] map complex <tuple-info> ;
-
-: propagate-tuple-constructor ( #call word -- infos )
-    {
-        { \ <tuple-boa> [ propagate-<tuple-boa> ] }
-        { \ <complex> [ propagate-<complex> ] }
-    } case 1array ;
+    value-info literal>> first (propagate-tuple-constructor) 1array ;
 
 : read-only-slot? ( n class -- ? )
     all-slots [ offset>> = ] with find nip
@@ -72,5 +63,5 @@ UNION: fixed-length-sequence array byte-array string ;
         { [ over 0 = ] [ 2drop fixnum <class-info> ] }
         { [ 2dup length-accessor? ] [ nip length>> ] }
         { [ dup literal?>> ] [ literal>> literal-info-slot ] }
-        [ [ 1- ] [ slots>> ] bi* ?nth ]
+        [ [ 1 - ] [ slots>> ] bi* ?nth ]
     } cond [ object-info ] unless* ;