content: module Data.Graph.Inductive.Internal.FiniteMap
         (FiniteMap(..), emptyFM, addToFM, delFromFM, updFM, accumFM,
          splitFM, isEmptyFM, sizeFM, lookupFM, elemFM, rangeFM, minFM,
          maxFM, predFM, succFM, splitMinFM, fmToList)
         where
  { import Data.Maybe (isJust);
     
    data (Ord a) => FiniteMap a b = Empty
                                  | Node Int (FiniteMap a b) (a, b) (FiniteMap a b)
                                  deriving Eq;
     
    showsMap :: (Show a, Show b, Ord a) => FiniteMap a b -> ShowS;
    showsMap (Empty) = id;
    showsMap (Node _ l (i, x) r)
      = showsMap l . (' ' :) . shows i . ("->" ++) . shows x .
          showsMap r;
     
    instance (Show a, Show b, Ord a) => Show (FiniteMap a b) where
            { showsPrec _ m = showsMap m};
     
    splitMax :: (Ord a) => FiniteMap a b -> (FiniteMap a b, (a, b));
    splitMax (Node _ l x Empty) = (l, x);
    splitMax (Node _ l x r) = (avlBalance l x m, y)
      where { (m, y) = splitMax r};
    splitMax (Empty) = error "splitMax on empty FiniteMap";
     
    merge ::
          (Ord a) => FiniteMap a b -> FiniteMap a b -> FiniteMap a b;
    merge l (Empty) = l;
    merge (Empty) r = r;
    merge l r = avlBalance l' x r
      where { (l', x) = splitMax l};
     
    emptyFM :: (Ord a) => FiniteMap a b;
    emptyFM = Empty;
     
    addToFM :: (Ord a) => FiniteMap a b -> a -> b -> FiniteMap a b;
    addToFM (Empty) i x = node Empty (i, x) Empty;
    addToFM (Node h l (j, y) r) i x
      | i < j = avlBalance (addToFM l i x) (j, y) r
      | i > j = avlBalance l (j, y) (addToFM r i x)
      | otherwise = Node h l (j, x) r;
     
    updFM ::
          (Ord a) => FiniteMap a b -> a -> (b -> b) -> FiniteMap a b;
    updFM (Empty) _ _ = Empty;
    updFM (Node h l (j, x) r) i f
      | i < j = let { l' = updFM l i f} in l' `seq` Node h l' (j, x) r
      | i > j = let { r' = updFM r i f} in r' `seq` Node h l (j, x) r'
      | otherwise = Node h l (j, f x) r;
     
    accumFM ::
            (Ord a) =>
              FiniteMap a b -> a -> (b -> b -> b) -> b -> FiniteMap a b;
    accumFM (Empty) i _ x = node Empty (i, x) Empty;
    accumFM (Node h l (j, y) r) i f x
      | i < j = avlBalance (accumFM l i f x) (j, y) r
      | i > j = avlBalance l (j, y) (accumFM r i f x)
      | otherwise = Node h l (j, f x y) r;
     
    delFromFM :: (Ord a) => FiniteMap a b -> a -> FiniteMap a b;
    delFromFM (Empty) _ = Empty;
    delFromFM (Node _ l (j, x) r) i
      | i < j = avlBalance (delFromFM l i) (j, x) r
      | i > j = avlBalance l (j, x) (delFromFM r i)
      | otherwise = merge l r;
     
    isEmptyFM :: FiniteMap a b -> Bool;
    isEmptyFM (Empty) = True;
    isEmptyFM _ = False;
     
    sizeFM :: (Ord a) => FiniteMap a b -> Int;
    sizeFM (Empty) = 0;
    sizeFM (Node _ l _ r) = sizeFM l + 1 + sizeFM r;
     
    lookupFM :: (Ord a) => FiniteMap a b -> a -> Maybe b;
    lookupFM (Empty) _ = Nothing;
    lookupFM (Node _ l (j, x) r) i
      | i < j = lookupFM l i
      | i > j = lookupFM r i
      | otherwise = Just x;
     
    rangeFM :: (Ord a) => FiniteMap a b -> a -> a -> [b];
    rangeFM m i j = rangeFMa m i j [];
    rangeFMa (Empty) _ _ a = a;
    rangeFMa (Node _ l (k, x) r) i j a
      | k < i = rangeFMa r i j a
      | k > j = rangeFMa l i j a
      | otherwise = rangeFMa l i j (x : rangeFMa r i j a);
     
    minFM :: (Ord a) => FiniteMap a b -> Maybe (a, b);
    minFM (Empty) = Nothing;
    minFM (Node _ Empty x _) = Just x;
    minFM (Node _ l _ _) = minFM l;
     
    maxFM :: (Ord a) => FiniteMap a b -> Maybe (a, b);
    maxFM (Empty) = Nothing;
    maxFM (Node _ _ x Empty) = Just x;
    maxFM (Node _ _ _ r) = maxFM r;
     
    predFM :: (Ord a) => FiniteMap a b -> a -> Maybe (a, b);
    predFM m i = predFM' m i Nothing;
    predFM' (Empty) _ p = p;
    predFM' (Node _ l (j, x) r) i p
      | i < j = predFM' l i p
      | i > j = predFM' r i (Just (j, x))
      | isJust ml = ml
      | otherwise = p
      where { ml = maxFM l};
     
    succFM :: (Ord a) => FiniteMap a b -> a -> Maybe (a, b);
    succFM m i = succFM' m i Nothing;
    succFM' (Empty) _ p = p;
    succFM' (Node _ l (j, x) r) i p
      | i < j = succFM' l i (Just (j, x))
      | i > j = succFM' r i p
      | isJust mr = mr
      | otherwise = p
      where { mr = minFM r};
     
    elemFM :: (Ord a) => FiniteMap a b -> a -> Bool;
    elemFM m i
      = case lookupFM m i of
            { Nothing -> False;
              _ -> True};
     
    splitFM ::
            (Ord a) => FiniteMap a b -> a -> Maybe (FiniteMap a b, (a, b));
    splitFM (Empty) _ = Nothing;
    splitFM (Node _ l (j, x) r) i
      = if i < j then
          case splitFM l i of
              { Just (l', y) -> Just (avlBalance l' (j, x) r, y);
                Nothing -> Nothing}
          else
          if i > j then
            case splitFM r i of
                { Just (r', y) -> Just (avlBalance l (j, x) r', y);
                  Nothing -> Nothing}
            else Just (merge l r, (j, x));
     
    splitMinFM ::
               (Ord a) => FiniteMap a b -> Maybe (FiniteMap a b, (a, b));
    splitMinFM (Empty) = Nothing;
    splitMinFM (Node _ Empty x r) = Just (r, x);
    splitMinFM (Node _ l x r) = Just (avlBalance l' x r, y)
      where { Just (l', y) = splitMinFM l};
     
    fmToList :: (Ord a) => FiniteMap a b -> [(a, b)];
    fmToList m = scan m []
      where { scan (Empty) xs = xs;
              scan (Node _ l x r) xs = scan l (x : (scan r xs))};
     
    height :: (Ord a) => FiniteMap a b -> Int;
    height (Empty) = 0;
    height (Node h _ _ _) = h;
     
    node ::
         (Ord a) =>
           FiniteMap a b -> (a, b) -> FiniteMap a b -> FiniteMap a b;
    node l val r = Node h l val r
      where { h = 1 + (height l `max` height r)};
     
    avlBalance ::
               (Ord a) =>
                 FiniteMap a b -> (a, b) -> FiniteMap a b -> FiniteMap a b;
    avlBalance l (i, x) r
      | (hr + 1 < hl) && (bias l < 0) = rotr (node (rotl l) (i, x) r)
      | (hr + 1 < hl) = rotr (node l (i, x) r)
      | (hl + 1 < hr) && (0 < bias r) = rotl (node l (i, x) (rotr r))
      | (hl + 1 < hr) = rotl (node l (i, x) r)
      | otherwise = node l (i, x) r
      where { hl = height l;
              hr = height r};
     
    bias :: (Ord a) => FiniteMap a b -> Int;
    bias (Node _ l _ r) = height l - height r;
    bias (Empty) = 0;
     
    rotr :: (Ord a) => FiniteMap a b -> FiniteMap a b;
    rotr (Empty) = Empty;
    rotr (Node _ (Node _ l1 v1 r1) v2 r2) = node l1 v1 (node r1 v2 r2);
    rotr (Node _ Empty _ _) = error "rotr on invalid FiniteMap";
     
    rotl :: (Ord a) => FiniteMap a b -> FiniteMap a b;
    rotl (Empty) = Empty;
    rotl (Node _ l1 v1 (Node _ l2 v2 r2)) = node (node l1 v1 l2) v2 r2;
    rotl (Node _ _ _ Empty) = error "rotl on invalid FiniteMap"}
  