USING: accessors arrays fry grouping kernel math math.order sequences ;
IN: compiler.cfg.linear-scan.ranges

! Range utilities
: intersect-range ( r1 r2 -- n/f )
    2dup [ first ] bi@ > [ swap ] when
    2dup [ second ] [ first ] bi* >=
    [ nip first ] [ 2drop f ] if ;

: split-range ( range n -- before after )
    swap first2 pick 1 + [ swap 2array ] 2bi@  ;

! Range sequence utilities
: extend-ranges? ( n ranges -- ? )
    [ drop f ] [ last first >= ] if-empty ;

: extend-ranges ( from to ranges -- )
    [ last first2 rot [ min ] [ max ] 2bi* 2array ] keep set-last ;

: add-new-range ( from to ranges -- )
    [ 2array ] dip push ;

: add-range ( from to ranges -- )
    2dup extend-ranges? [ extend-ranges ] [ add-new-range ] if ;

: ranges-cover? ( n ranges -- ? )
    [ first2 between? ] with any? ;

: intersect-ranges ( ranges1 ranges2 -- n/f )
    '[ _ [ intersect-range ] with map-find drop ] map-find drop ;

: shorten-ranges ( n ranges -- )
    dup empty? [ dupd add-new-range ] [
        [ last second 2array ] keep set-last
    ] if ;

: split-last-range ( before after last n -- before' after' )
    split-range [ [ but-last ] dip suffix ] [ prefix ] bi-curry* bi* ;

: split-last-range? ( last n -- ? )
    swap second <= ;

: split-ranges ( ranges n -- before after )
    [ '[ first _ <= ] partition ]
    [
        [ over last ] dip 2dup split-last-range?
        [ split-last-range ] [ 2drop ] if
    ] bi ;

: valid-ranges? ( ranges -- ? )
    [ [ first2 <= ] all? ]
    [ [ [ second ] [ first ] bi* <= ] monotonic? ] bi and ;

: fix-lower-bound ( n ranges -- ranges' )
    over '[ second _ >= ] filter unclip second swapd 2array prefix ;

: fix-upper-bound ( n ranges -- ranges' )
    over '[ first _ <= ] filter unclip-last first rot 2array suffix ;

: ranges-endpoints ( ranges -- start end )
    [ first first ] [ last last ] bi ;