]> gitweb.factorcode.org Git - factor.git/commitdiff
compiler.tree.propagation: clean up
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Wed, 10 Mar 2010 02:15:49 +0000 (15:15 +1300)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Wed, 10 Mar 2010 02:15:49 +0000 (15:15 +1300)
basis/compiler/tree/propagation/info/info.factor
basis/compiler/tree/propagation/slots/slots.factor

index b154845c076d88bc9f78740fbcc90cf2fcfbaa1e..22ea1306d67bf2393ff7db5fb372c2bb011eae23 100644 (file)
@@ -47,9 +47,7 @@ CONSTANT: object-info T{ value-info f object full-interval }
             { [ over interval-length 0 > ] [ 3drop f f ] }
             { [ pick bignum class<= ] [ 2nip >bignum t ] }
             { [ pick integer class<= ] [ 2nip >fixnum t ] }
-            { [ pick float class<= ] [
-                2nip dup zero? [ drop f f ] [ >float t ] if
-            ] }
+            { [ pick float class<= ] [ 2nip dup zero? [ drop f f ] [ >float t ] if ] }
             [ 3drop f f ]
         } cond
     ] if ;
@@ -73,9 +71,11 @@ UNION: fixed-length array byte-array string ;
         ] unless
     ] unless ;
 
-: length-slots ( length class -- slots )
-    "slots" word-prop length 1 - f <array>
-    swap prefix ;
+: (slots-with-length) ( length class -- slots )
+    "slots" word-prop length 1 - f <array> swap prefix ;
+
+: slots-with-length ( seq -- slots )
+    [ length <literal-info> ] [ class ] bi (slots-with-length) ;
 
 : init-literal-info ( info -- info )
     empty-interval >>interval
@@ -83,10 +83,7 @@ UNION: fixed-length array byte-array string ;
     dup literal>> {
         { [ dup real? ] [ [a,a] >>interval ] }
         { [ dup tuple? ] [ tuple-slot-infos >>slots ] }
-        { [ dup fixed-length? ] [
-            [ length <literal-info> ] [ class ] bi
-            length-slots >>slots
-        ] }
+        { [ dup fixed-length? ] [ slots-with-length >>slots ] }
         [ drop ]
     } cond ; inline
 
@@ -164,10 +161,10 @@ UNION: fixed-length array byte-array string ;
         t >>literal?
     init-value-info ; foldable
 
-: <sequence-info'> ( length class -- info )
+: <sequence-info> ( length class -- info )
     <value-info>
         over >>class
-        [ length-slots ] dip swap >>slots
+        [ (slots-with-length) ] dip swap >>slots
     init-value-info ;
 
 : <tuple-info> ( slots class -- info )
index 6429928294e1ea16528db3ed1b27c506dc24e7b3..2602d6d59a9ed7ebd6830514c855aa2ffbd587e4 100644 (file)
@@ -23,7 +23,7 @@ IN: compiler.tree.propagation.slots
 : propagate-sequence-constructor ( #call word -- infos )
     [ in-d>> first value-info ]
     [ constructor-output-class ] bi*
-    <sequence-info'> 1array ;
+    <sequence-info> 1array ;
 
 : fold-<tuple-boa> ( values class -- info )
     [ [ literal>> ] map ] dip prefix >tuple