compiler.tree.propagation.recursive: better counter-class

basis/compiler/tree/propagation/recursive/recursive-docs.factor

@@ -1,7 +1,12 @@
-USING: compiler.tree compiler.tree.propagation.info
+USING: classes compiler.tree compiler.tree.propagation.info
-compiler.tree.propagation.nodes help.markup help.syntax sequences ;
+compiler.tree.propagation.nodes help.markup help.syntax math.intervals
+sequences ;
 IN: compiler.tree.propagation.recursive
 
+HELP: counter-class
+{ $values { "interval" interval } { "class" class } { "class'" class } }
+{ $description "The smallest class to use for a counter that iterates the given interval." } ;
+
 HELP: recursive-phi-infos
 { $values { "node" #recursive } { "infos" sequence } }
 { $description "The sequence of " { $link value-info-state } " that is the input to the recursive block." } ;

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

@@ -1,9 +1,22 @@
-USING: accessors tools.test compiler.tree compiler.tree.builder
+USING: accessors compiler.tree compiler.tree.builder
 compiler.tree.optimizer compiler.tree.propagation.info
-compiler.tree.propagation.recursive math.intervals kernel kernel.private
+compiler.tree.propagation.recursive kernel kernel.private layouts
-math literals layouts sequences ;
+literals math math.intervals sequences sequences.private tools.test ;
 IN: compiler.tree.propagation.recursive.tests
 
+! counter-class
+{
+    array-capacity
+    fixnum
+    integer
+    array-capacity
+} [
+    0 100 [a,b] fixnum counter-class
+    -100 100 [a,b] fixnum counter-class
+    0 100 [a,b] integer counter-class
+    0 10 [a,b] array-capacity counter-class
+] unit-test
+
 ! generalize-counter-interval
 { T{ interval f { 0 t } { 1/0. t } } } [
     T{ interval f { 1 t } { 1 t } }

basis/compiler/tree/propagation/recursive/recursive.factor

@@ -20,10 +20,8 @@ IN: compiler.tree.propagation.recursive
     [ latest-input-infos ] bi ;
 
 : counter-class ( interval class -- class' )
-    dup fixnum class<= [
+    dup fixnum class<= rot array-capacity-interval interval-subset? and
-        swap array-capacity-interval interval-subset?
+    [ drop array-capacity ] when ;
-        [ drop array-capacity ] when
-    ] [ nip ] if ;
 
 :: generalize-counter-interval ( interval initial-interval class -- interval' )
     interval class counter-class :> class