compiler.cfg.linear-scan.ranges: move more range-related features into

this vocab

basis/compiler/cfg/linear-scan/allocation/spilling/spilling-docs.factor

@@ -48,6 +48,10 @@ HELP: spill-partially-available
 }
 { $description "A register would be available for part of the new interval's lifetime if all active and inactive intervals using that register were split and spilled." } ;
 
+HELP: trim-before-ranges
+{ $values { "live-interval" live-interval } }
+{ $description "Extends the last intervals range to one after the last use point and removes all intervals beyond that." } ;
+
 ARTICLE: "compiler.cfg.linear-scan.allocation.spilling" "Spill slot assignment"
 "Words and dynamic variables for assigning spill slots to spilled registers during the " { $link linear-scan } " compiler pass." ;
 

basis/compiler/cfg/linear-scan/allocation/spilling/spilling-tests.factor

@@ -49,3 +49,64 @@ IN: compiler.cfg.linear-scan.allocation.spilling.tests
 { double-rep } [
     test-live-interval last-use-rep
 ] unit-test
+
+! trim-after-ranges
+{
+    T{ live-interval-state
+       { ranges
+         {
+             T{ live-range { from 25 } { to 30 } }
+             T{ live-range { from 40 } { to 50 } }
+         }
+       }
+       { uses { T{ vreg-use { n 25 } } } }
+    }
+} [
+    T{ live-interval-state
+       { ranges
+         {
+             T{ live-range { from 0 } { to 10 } }
+             T{ live-range { from 20 } { to 30 } }
+             T{ live-range { from 40 } { to 50 } }
+         }
+       }
+       { uses { T{ vreg-use { n 25 } } } }
+    } dup trim-after-ranges
+] unit-test
+
+{
+    T{ live-interval-state
+       { ranges { T{ live-range { from 10 } { to 23 } } } }
+       { uses { T{ vreg-use { n 10 } } } }
+    }
+} [
+    T{ live-interval-state
+       { ranges { T{ live-range { from 20 } { to 23 } } } }
+       { uses { T{ vreg-use { n 10 } } } }
+    }
+    dup trim-after-ranges
+] unit-test
+
+! trim-before-ranges
+{
+    T{ live-interval-state
+       { ranges
+         {
+             T{ live-range { from 0 } { to 10 } }
+             T{ live-range { from 20 } { to 21 } }
+         }
+       }
+       { uses { T{ vreg-use { n 20 } } } }
+    }
+} [
+    T{ live-interval-state
+       { ranges
+         {
+             T{ live-range { from 0 } { to 10 } }
+             T{ live-range { from 20 } { to 30 } }
+             T{ live-range { from 40 } { to 50 } }
+         }
+       }
+       { uses { T{ vreg-use { n 20 } } } }
+    } dup trim-before-ranges
+] unit-test

basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor

@@ -9,16 +9,10 @@ math namespaces sequences ;
 IN: compiler.cfg.linear-scan.allocation.spilling
 
 : trim-before-ranges ( live-interval -- )
-    dup last-use n>> 1 +
+    dup last-use n>> 1 + swap [ fix-upper-bound ] change-ranges drop ;
-    [ '[ [ from>> _ >= ] trim-tail-slice ] change-ranges drop ]
-    [ swap ranges>> last to<< ]
-    2bi ;
 
 : trim-after-ranges ( live-interval -- )
-    dup first-use n>>
+    dup first-use n>> swap [ fix-lower-bound ] change-ranges drop ;
-    [ '[ [ to>> _ < ] trim-head-slice ] change-ranges drop ]
-    [ swap ranges>> first from<< ]
-    2bi ;
 
 : last-use-rep ( live-interval -- rep/f )
     last-use [ def-rep>> ] [ use-rep>> ] bi or ; inline
@@ -34,8 +28,7 @@ ERROR: bad-live-ranges interval ;
 
 : check-ranges ( ranges -- )
     check-allocation? get [
-        ranges>> dup [ [ from>> ] [ to>> ] bi <= ] all?
+        dup ranges>> valid-ranges? [ drop ] [ bad-live-ranges ] if
-        [ drop ] [ bad-live-ranges ] if
     ] [ drop ] if ;
 
 : spill-before ( before -- before/f )

basis/compiler/cfg/linear-scan/ranges/ranges-tests.factor

@@ -154,3 +154,47 @@ IN: compiler.cfg.linear-scan.ranges.tests
 [
     { T{ live-range f 1 10 } } 0 split-ranges
 ] must-fail
+
+! valid-ranges?
+{ t f f f } [
+    { T{ live-range f 1 10 } T{ live-range f 15 20 } } valid-ranges?
+    { T{ live-range f 10 1 } T{ live-range f 15 20 } } valid-ranges?
+    { T{ live-range f 1 5 } T{ live-range f 3 10 } } valid-ranges?
+    { T{ live-range f 5 1 } } valid-ranges?
+] unit-test
+
+! fix-lower-bound
+{
+    {
+        T{ live-range { from 25 } { to 30 } }
+        T{ live-range { from 40 } { to 50 } }
+    }
+    { T{ live-range { from 10 } { to 23 } } }
+} [
+    25 {
+        T{ live-range { from 0 } { to 10 } }
+        T{ live-range { from 20 } { to 30 } }
+        T{ live-range { from 40 } { to 50 } }
+    } fix-lower-bound
+    10 { T{ live-range { from 20 } { to 23 } } } fix-lower-bound
+] unit-test
+
+! fix-upper-bound
+{
+    {
+        T{ live-range { from 0 } { to 10 } }
+        T{ live-range { from 20 } { to 20 } }
+    }
+} [
+    20 {
+        T{ live-range { from 0 } { to 10 } }
+        T{ live-range { from 20 } { to 30 } }
+        T{ live-range { from 40 } { to 50 } }
+    } fix-upper-bound
+] unit-test
+
+{
+    { T{ live-range { from 0 } { to 20 } } }
+} [
+    20 { T{ live-range { from 0 } { to 40 } } } fix-upper-bound
+] unit-test

basis/compiler/cfg/linear-scan/ranges/ranges.factor

@@ -1,5 +1,4 @@
-USING: accessors compiler.cfg.linear-scan.allocation.state fry kernel
+USING: accessors arrays fry grouping kernel math math.order sequences ;
-math math.order namespaces sequences ;
 IN: compiler.cfg.linear-scan.ranges
 
 ! Data definitions
@@ -17,8 +16,7 @@ C: <live-range> live-range
     [ from>> ] [ to>> ] bi between? ;
 
 : split-range ( live-range n -- before after )
-    [ [ from>> ] dip <live-range> ]
+    [ [ from>> ] dip <live-range> ] [ 1 + swap to>> <live-range> ] 2bi ;
-    [ 1 + swap to>> <live-range> ] 2bi ;
 
 ! Range sequence utilities
 : extend-ranges? ( n ranges -- ? )
@@ -54,3 +52,13 @@ C: <live-range> live-range
         [ over last ] dip 2dup split-last-range?
         [ split-last-range ] [ 2drop ] if
     ] bi ;
+
+: valid-ranges? ( ranges -- ? )
+    [ [ [ from>> ] [ to>> ] bi <= ] all? ]
+    [ [ [ to>> ] [ from>> ] bi* <= ] monotonic? ] bi and ;
+
+: fix-lower-bound ( n ranges -- ranges' )
+    over '[ to>> _ >= ] filter [ first from<< ] keep ;
+
+: fix-upper-bound ( n ranges -- ranges' )
+    over '[ from>> _ <= ] filter [ last to<< ] keep ;