----------------------------------------------------------------------------- -- | -- Module : SimpleMap -- Copyright : (C) 2012 Drew Day -- : (C) 1999 Martin Erwig -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Drew Day -- Stability : experimental -- Portability : portable -- -- Code adapted from: -- -- -- Documentation (and further updates in technique) forthcoming. ---------------------------------------------------------------------------- module SimpleMap (FiniteMap(..), --transparent(not yet abstract) emptyFM,addToFM,delFromFM, updFM, -- applies function to stored entry accumFM, -- defines or aggregates entries splitFM, -- combines delFrom & lookup isEmptyFM,sizeFM,lookupFM,elemFM, rangeFM, -- applies lookup to an interval minFM,maxFM,predFM,succFM, splitMinFM, -- combines splitFM & minFM fmToList ) where import Data.Maybe (isJust) data FiniteMap a b = Empty | Node (FiniteMap a b) (a,b) (FiniteMap a b) deriving (Eq) ---------------------------------------------------------------------- -- MAIN FUNCTIONS ---------------------------------------------------------------------- emptyFM :: Ord a => FiniteMap a b isEmptyFM :: FiniteMap a b -> Bool elemFM :: Ord a => FiniteMap a b -> a -> Bool sizeFM :: Ord a => FiniteMap a b -> Int minFM :: Ord a => FiniteMap a b -> Maybe (a,b) maxFM :: Ord a => FiniteMap a b -> Maybe (a,b) lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b succFM :: Ord a => FiniteMap a b -> a -> Maybe (a,b) predFM :: Ord a => FiniteMap a b -> a -> Maybe (a,b) succFM' :: Ord a => FiniteMap a b -> a -> Maybe (a,b) -> Maybe (a,b) predFM' :: Ord a => FiniteMap a b -> a -> Maybe (a,b) -> Maybe (a,b) rangeFM :: Ord a => FiniteMap a b -> a -> a -> [b] delFromFM :: Ord a => FiniteMap a b -> a -> FiniteMap a b addToFM :: Ord a => FiniteMap a b -> a -> b -> FiniteMap a b updFM :: Ord a => FiniteMap a b -> a -> (b -> b) -> FiniteMap a b accumFM :: Ord a => FiniteMap a b -> a -> (b -> b -> b) -> b -> FiniteMap a b fmToList :: Ord a => FiniteMap a b -> [(a,b)] merge :: Ord a => FiniteMap a b -> FiniteMap a b -> FiniteMap a b splitMax :: Ord a => FiniteMap a b -> (FiniteMap a b,(a,b)) splitMinFM :: Ord a => FiniteMap a b -> Maybe (FiniteMap a b,(a,b)) splitFM :: Ord a => FiniteMap a b -> a -> Maybe (FiniteMap a b,(a,b)) emptyFM = Empty isEmptyFM Empty = True isEmptyFM _ = False sizeFM(Empty ) = 0 sizeFM (Node l _ r) = sizeFM l + 1 + sizeFM r minFM (Empty ) = Nothing minFM (Node Empty x _____) = Just x minFM (Node l x _____) = minFM l maxFM (Empty ) = Nothing maxFM (Node _____ x Empty) = Just x maxFM (Node _____ x r ) = maxFM r predFM m i = predFM' m i Nothing succFM m i = succFM' m i Nothing rangeFM m i j = rangeFMa m i j [] elemFM m i = case lookupFM m i of {Nothing -> False; _ -> True} addToFM (Empty ) i x = Node Empty ( i, x) Empty addToFM (Node l (j,y) r) i x | i < j = Node (addToFM l i x) (j ,y ) r | i > j = Node l (j ,y ) (addToFM r i x) | otherwise = Node l (j , x) r accumFM (Empty ) i f x = Node Empty (i , x ) Empty accumFM (Node l (j,y) r) i f x | i < j = Node (accumFM l i f x) ( j, y) r | i > j = Node l ( j, y) (accumFM r i f x) | otherwise = Node l ( j,f x y) r updFM (Empty ) _ _ = Empty updFM (Node l (j,x) r) i f | i < j = Node (updFM l i f) (j, x) r | i > j = Node l (j, x) (updFM r i f) | otherwise = Node l (j,f x) r delFromFM (Empty ) _ = Empty delFromFM (Node l (j,x) r) i | i < j = Node (delFromFM l i) (j,x) r | i > j = Node l (j,x) (delFromFM r i) | otherwise = merge l r lookupFM (Empty ) _ = Nothing lookupFM (Node l (j,x) r) i | i < j = lookupFM l i | i > j = lookupFM r i | otherwise = Just x 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) 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' (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 fmToList m = scan m [] where scan Empty xs = xs scan (Node l x r) xs = scan l (scan r (x:xs)) splitFM (Empty ) _ = Nothing splitFM (Node l (j,x) r) i = if i < j then case splitFM l i of Just (l',y) -> Just (Node l' (j,x) r ,y) Nothing -> Nothing else if i > j then case splitFM r i of Just (r',y) -> Just (Node l (j,x) r',y) Nothing -> Nothing else {- i = j -} Just (merge l r ,(j,x)) splitMinFM (Empty ) = Nothing splitMinFM (Node Empty x r) = Just (r,x) splitMinFM (Node l x r) = Just (Node l' x r,y) where Just (l' ,y) = splitMinFM l splitMax (Node l x Empty) = (l,x) splitMax (Node l x r ) = (Node l x m , y) where (m , y) = splitMax r merge l Empty = l merge Empty r = r merge l r = Node l' x r where (l',x) = splitMax l ---------------------------------------------------------------------- -- UTILITIES ---------------------------------------------------------------------- -- pretty printing -- 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