compiler/utils/Interval.hs

   1 module Interval
   2   ( Interval
   3   , mkInterval, intervalToInfinityFrom
   4   , integersInInterval
   5
   6   , DisjointIntervalSet
   7   , emptyIntervalSet, extendIntervalSet, deleteFromIntervalSet
   8   , subIntervals
   9   )
  10 where
  11
  12 import Panic
  13
  14 #include "HsVersions.h"
  15
  16 ------------------------------------------------------------------
  17 -- Intervals and Sets of Intervals
  18 ------------------------------------------------------------------
  19
  20 -- This module implements intervals over the integer line and sets of
  21 -- disjoint intervals.
  22
  23 {-
  24 An interval $[x,y)$ over ordered points represents a half-open
  25 interval of points:  $\{ p \mid x \leq p < y \}$.  Half-open intervals
  26 have the nice property $[x,y) \cup [y,z) = [x,z)$.  Non-empty
  27 intervals can precede or overlap each other; an empty interval never
  28 overlaps or precedes any other.  The set of ordered elements contains
  29 a unique element $\mathit{zero}$; using it in any interval is an
  30 \emph{unchecked} run-time error.
  31 -}
  32
  33
  34 data Interval = Interval { i_min :: Int, i_lim :: Int }
  35   -- width == i_lim - i_min >= 0
  36
  37 type Width = Int
  38
  39 mkInterval :: Int -> Width -> Interval
  40 mkInterval min w = ASSERT (w>=0) Interval min (min+w)
  41 intervalToInfinityFrom :: Int -> Interval
  42 intervalToInfinityFrom min = Interval min maxBound
  43 integersInInterval :: Interval -> [Int]
  44 integersInInterval (Interval min lim) = gen min lim
  45     where gen min lim | min >= lim = []
  46                       | otherwise = min : gen (min+1) lim
  47
  48 precedes, overlaps, adjoins, contains :: Interval -> Interval -> Bool
  49 precedes (Interval m l) (Interval m' l') = l <= m' || l' <= m
  50 overlaps i i' = not (i `precedes` i' || i' `precedes` i)
  51 adjoins (Interval _ l) (Interval m _) = l == m
  52 contains (Interval m l) (Interval m' l') = m <= m' && l >= l'
  53
  54 merge :: Interval -> Interval -> Interval
  55 merge _i@(Interval m _) _i'@(Interval _ l) = {- ASSERT (adjoins i i') -} (Interval m l)
  56
  57
  58 ----------
  59
  60
  61 newtype DisjointIntervalSet = Intervals [Interval]
  62  -- invariants: * No two intervals overlap
  63  --             * Adjacent intervals have a gap between
  64  --             * Intervals are sorted by min element
  65
  66 emptyIntervalSet :: DisjointIntervalSet
  67 emptyIntervalSet = Intervals []
  68 extendIntervalSet :: DisjointIntervalSet -> Interval -> DisjointIntervalSet
  69 extendIntervalSet (Intervals l) i = Intervals (insert [] i l)
  70     where insert :: [Interval] -> Interval -> [Interval] -> [Interval]
  71           -- precondition: in 'insert prev' i l', every element of prev'
  72           -- precedes and does not adjoin i
  73           insert prev' i [] = rev_app prev' [i]
  74           insert prev' i (i':is) =
  75                  if i `precedes` i' then
  76                      if i `adjoins` i' then
  77                          insert prev' (merge i i') is
  78                      else
  79                          rev_app prev' (i : i' : is)
  80                  else if i' `precedes` i then
  81                           if i' `adjoins` i then
  82                               insert prev' (merge i' i) is
  83                           else
  84                               insert (i' : prev') i is
  85                       else
  86                           panic "overlapping intervals"
  87
  88 deleteFromIntervalSet :: DisjointIntervalSet -> Interval -> DisjointIntervalSet
  89 deleteFromIntervalSet (Intervals l) i = Intervals (rm [] i l)
  90     where rm :: [Interval] -> Interval -> [Interval] -> [Interval]
  91           -- precondition: in 'rm prev' i l', every element of prev'
  92           -- precedes and does not adjoin i
  93           rm _ _ [] = panic "removed interval not present in set"
  94           rm prev' i (i':is) =
  95                  if i `precedes` i' then
  96                      panic "removed interval not present in set"
  97                  else if i' `precedes` i then
  98                           rm (i' : prev') i is
  99                       else
 100                           -- remove i from i', leaving 0, 1, or 2 leftovers
 101                           undefined {-
 102                           ASSERTX (i' `contains` i)
 103                           let (Interval m l, Interval m' l'
 104                           panic "overlapping intervals"
 105                                      -}
 106
 107 subIntervals :: DisjointIntervalSet -> Width -> [Interval]
 108 subIntervals = undefined
 109
 110 rev_app :: [a] -> [a] -> [a]
 111 rev_app [] xs = xs
 112 rev_app (y:ys) xs = rev_app ys (y:xs)
 113
 114 _unused :: ()
 115 _unused = undefined i_min i_lim overlaps contains
 116