module System.Mem.StableName.Dynamic.Map
( Map
, empty
, null
, singleton
, member
, notMember
, insert
, insertWith
, insertWith'
, lookup
, find
, findWithDefault
) where
import qualified Prelude
import Prelude hiding (lookup, null)
import System.Mem.StableName.Dynamic
import qualified Data.IntMap as IntMap
import Data.IntMap (IntMap)
newtype Map a = Map { getMap :: IntMap [(DynamicStableName, a)] }
empty :: Map a
empty = Map IntMap.empty
null :: Map a -> Bool
null (Map m) = IntMap.null m
singleton :: DynamicStableName -> a -> Map a
singleton k v = Map $ IntMap.singleton (hashDynamicStableName k) [(k,v)]
member :: DynamicStableName -> Map a -> Bool
member k m = case lookup k m of
Nothing -> False
Just _ -> True
notMember :: DynamicStableName -> Map a -> Bool
notMember k m = not $ member k m
insert :: DynamicStableName -> a -> Map a -> Map a
insert k v = Map . IntMap.insertWith (++) (hashDynamicStableName k) [(k,v)] . getMap
insertWith :: (a -> a -> a) -> DynamicStableName -> a -> Map a -> Map a
insertWith f k v = Map . IntMap.insertWith go (hashDynamicStableName k) [(k,v)] . getMap
where
go _ ((k',v'):kvs)
| k == k' = (k', f v v') : kvs
| otherwise = (k',v') : go undefined kvs
go _ [] = []
insertWith' :: (a -> a -> a) -> DynamicStableName -> a -> Map a -> Map a
insertWith' f k v = Map . IntMap.insertWith go (hashDynamicStableName k) [(k,v)] . getMap
where
go _ ((k',v'):kvs)
| k == k' = let v'' = f v v' in v'' `seq` (k', v'') : kvs
| otherwise = (k', v') : go undefined kvs
go _ [] = []
lookup :: DynamicStableName -> Map v -> Maybe v
lookup k (Map m) = do
pairs <- IntMap.lookup (hashDynamicStableName k) m
Prelude.lookup k pairs
find :: DynamicStableName -> Map v -> v
find k m = case lookup k m of
Nothing -> error "Map.find: element not in the map"
Just x -> x
findWithDefault :: v -> DynamicStableName -> Map v -> v
findWithDefault dflt k m = maybe dflt id $ lookup k m