{-# LANGUAGE Safe #-}
module System.Mem.StableName.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)
import Copilot.Core.Error (impossible)
data Map a = Map { getMap :: IntMap [(DynStableName, a)]
, getSize :: Int }
empty :: Map a
empty = Map IntMap.empty 0
null :: Map a -> Bool
null (Map m _) = IntMap.null m
singleton :: DynStableName -> a -> Map a
singleton k v =
Map (IntMap.singleton (hashDynStableName k) [(k,v)]) 1
member :: DynStableName -> Map a -> Bool
member k m = case lookup k m of
Nothing -> False
Just _ -> True
notMember :: DynStableName -> Map a -> Bool
notMember k m = not $ member k m
insert :: DynStableName -> a -> Map a -> Map a
insert k v Map { getMap = mp
, getSize = sz }
= Map (IntMap.insertWith (++) (hashDynStableName k) [(k,v)] mp)
(sz + 1)
insertWith :: (a -> a -> a) -> DynStableName -> a -> Map a -> Map a
insertWith f k v Map { getMap = mp
, getSize = sz }
= Map (IntMap.insertWith go (hashDynStableName k) [(k,v)] mp)
(sz + 1)
where
go _ ((k',v'):kvs)
| k == k' = (k', f v v') : kvs
| otherwise = (k',v') : go undefined kvs
go _ [] = []
insertWith' :: (a -> a -> a) -> DynStableName -> a -> Map a -> Map a
insertWith' f k v Map { getMap = mp
, getSize = sz }
= Map (IntMap.insertWith go (hashDynStableName k) [(k,v)] mp)
(sz + 1)
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 :: DynStableName -> Map v -> Maybe v
lookup k (Map m _) = do
pairs <- IntMap.lookup (hashDynStableName k) m
Prelude.lookup k pairs
find :: DynStableName -> Map v -> v
find k m = case lookup k m of
Nothing -> impossible "find" "copilot-language"
Just x -> x
findWithDefault :: v -> DynStableName -> Map v -> v
findWithDefault dflt k m = maybe dflt id $ lookup k m