module Interval
( Interval
, mkInterval, intervalToInfinityFrom
, integersInInterval
, DisjointIntervalSet
, emptyIntervalSet, extendIntervalSet, deleteFromIntervalSet
, subIntervals
)
where
import Panic
#include "HsVersions.h"
data Interval = Interval { i_min :: Int, i_lim :: Int }
type Width = Int
mkInterval :: Int -> Width -> Interval
mkInterval min w = ASSERT (w>=0) Interval min (min+w)
intervalToInfinityFrom :: Int -> Interval
intervalToInfinityFrom min = Interval min maxBound
integersInInterval :: Interval -> [Int]
integersInInterval (Interval min lim) = gen min lim
where gen min lim | min >= lim = []
| otherwise = min : gen (min+1) lim
precedes, overlaps, adjoins, contains :: Interval -> Interval -> Bool
precedes (Interval m l) (Interval m' l') = l <= m' || l' <= m
overlaps i i' = not (i `precedes` i' || i' `precedes` i)
adjoins (Interval _ l) (Interval m _) = l == m
contains (Interval m l) (Interval m' l') = m <= m' && l >= l'
merge :: Interval -> Interval -> Interval
merge _i@(Interval m _) _i'@(Interval _ l) = (Interval m l)
newtype DisjointIntervalSet = Intervals [Interval]
emptyIntervalSet :: DisjointIntervalSet
emptyIntervalSet = Intervals []
extendIntervalSet :: DisjointIntervalSet -> Interval -> DisjointIntervalSet
extendIntervalSet (Intervals l) i = Intervals (insert [] i l)
where insert :: [Interval] -> Interval -> [Interval] -> [Interval]
insert prev' i [] = rev_app prev' [i]
insert prev' i (i':is) =
if i `precedes` i' then
if i `adjoins` i' then
insert prev' (merge i i') is
else
rev_app prev' (i : i' : is)
else if i' `precedes` i then
if i' `adjoins` i then
insert prev' (merge i' i) is
else
insert (i' : prev') i is
else
panic "overlapping intervals"
deleteFromIntervalSet :: DisjointIntervalSet -> Interval -> DisjointIntervalSet
deleteFromIntervalSet (Intervals l) i = Intervals (rm [] i l)
where rm :: [Interval] -> Interval -> [Interval] -> [Interval]
rm _ _ [] = panic "removed interval not present in set"
rm prev' i (i':is) =
if i `precedes` i' then
panic "removed interval not present in set"
else if i' `precedes` i then
rm (i' : prev') i is
else
undefined
subIntervals :: DisjointIntervalSet -> Width -> [Interval]
subIntervals = undefined
rev_app :: [a] -> [a] -> [a]
rev_app [] xs = xs
rev_app (y:ys) xs = rev_app ys (y:xs)
_unused :: ()
_unused = undefined i_min i_lim overlaps contains