HMap 1.0.5 → 1.1.0
raw patch · 6 files changed
+221/−108 lines, 6 files
Files
- ChangeLog +2/−0
- Data/HKey.hs +10/−0
- Data/HKeySet.hs +144/−0
- Data/HMap.hs +27/−104
- Data/Untypeable.hs +34/−0
- HMap.cabal +4/−4
ChangeLog view
@@ -1,3 +1,5 @@+1.1.0 : Added HKeySet and Untypeable, reorganized the code+ 1.0.5 : Added KeyM monad 1.0.3 : Added NOINLINE pragma
+ Data/HKey.hs view
@@ -0,0 +1,10 @@+module Data.HKey( HKey+ , withKey+ , T+ , createKey+ -- * Key Monad+ , KeyM+ , getKey+ , runKeyM) where++import Data.HKeyPrivate
+ Data/HKeySet.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE CPP #-} +-----------------------------------------------------------------------------+-- |+-- Module : Data.HKeySet+-- Copyright : (c) Atze van der Ploeg 2013+-- License : BSD-style+-- Maintainer : atzeus@gmail.org+-- Stability : provisional+-- Portability : portable+--+-- A set of 'HKey's +module Data.HKeySet++ (+ HKeySet+ -- * Construction+ , empty+ , singleton++ -- * Combine+ , union+ , unions++ -- * Basic interface+ , null+ , size+ , member+ , insert+ , delete+++ -- * Difference and intersection+ , difference+ , intersection+ -- KeySet-HMap functions+ , overlap+ , sameKeys+ , removeKeys+ )+ where++++import Data.Unique+import Data.HKey+import Data.HMap(HMap)+import qualified Data.HMap as S+import qualified Data.List as List+import Prelude hiding (null)+-- | The type of hetrogenous key sets. +newtype HKeySet = HKeySet HMap +++-- | /O(1)/ Construct an empty key set.+empty :: HKeySet+empty = HKeySet S.empty+++-- | /O(1)/ Construct a set with a single element.+singleton :: HKey s a -> HKeySet+singleton x = HKeySet (S.singleton x undefined)+#if __GLASGOW_HASKELL__ >= 700+{-# INLINABLE singleton #-}+#endif++-- | /O(n+m)/ Construct a key set containing all elements from both sets.+--+-- To obtain good performance, the smaller set must be presented as+-- the first argument.+union :: HKeySet -> HKeySet -> HKeySet+union (HKeySet s1) (HKeySet s2) = HKeySet (s1 `S.union` s2)+{-# INLINE union #-}++-- | Construct a key set containing all elements from a list of key sets.+unions = List.foldl' union empty+{-# INLINE unions #-}++-- | /O(1)/ Return 'True' if this key set is empty, 'False' otherwise.+null :: HKeySet -> Bool+null (HKeySet x) = S.null x+{-# INLINE null #-}++-- | /O(n)/ Return the number of elements in this set.+size :: HKeySet -> Int+size (HKeySet x) = S.size x+{-# INLINE size #-}++-- | /O(min(n,W))/ Return 'True' if the given value is present in this+-- set, 'False' otherwise.+member :: HKey s a -> HKeySet -> Bool+member x (HKeySet s) = x `S.member` s+#if __GLASGOW_HASKELL__ >= 700+{-# INLINABLE member #-}+#endif++-- | /O(min(n,W))/ Add the specified value to this set.+insert :: HKey x a -> HKeySet -> HKeySet +insert x (HKeySet s) = HKeySet (S.insert x undefined s)+#if __GLASGOW_HASKELL__ >= 700+{-# INLINABLE insert #-}+#endif++-- | /O(min(n,W))/ Remove the specified value from this set if+-- present.+delete :: HKey s a -> HKeySet -> HKeySet+delete x (HKeySet s) = HKeySet (S.delete x s)+#if __GLASGOW_HASKELL__ >= 700+{-# INLINABLE delete #-}+#endif++-- | /O(n)/ Difference of two sets. Return elements of the first set+-- not existing in the second.+difference :: HKeySet -> HKeySet -> HKeySet+difference (HKeySet a) (HKeySet b) = HKeySet (S.difference a b)+#if __GLASGOW_HASKELL__ >= 700+{-# INLINABLE difference #-}+#endif++-- | /O(n)/ Intersection of two sets. Return elements present in both+-- the first set and the second.+intersection :: HKeySet -> HKeySet -> HKeySet+intersection (HKeySet a) (HKeySet b) = HKeySet (S.intersection a b)+#if __GLASGOW_HASKELL__ >= 700+{-# INLINABLE intersection #-}+#endif++{--------------------------------------------------------------------+ KeySet-HMap functions+--------------------------------------------------------------------}+-- | /O(n)/. Does the map carry any of the keys?+overlap :: HMap -> HKeySet -> Bool+overlap h (HKeySet s) = not $ S.null (h `S.intersection` s)++-- | /O(n)/. Do the keyset and the map have the same keys?+sameKeys :: HMap -> HKeySet -> Bool+sameKeys h (HKeySet s) = S.null (h `S.difference` s)++-- | /O(n)/. Remove the keys from the keyset from the map.+removeKeys :: HMap -> HKeySet -> HMap+removeKeys h (HKeySet s) = h `S.difference` s++++
Data/HMap.hs view
@@ -117,15 +117,10 @@ -module Data.HMap(- -- * HMap type- HMap +module Data.HMap - -- * Keys- , Key- , withKey- , T- , createKey+ (+ HMap -- * Operators , (!), (\\) @@ -161,21 +156,23 @@ , difference -- ** Intersection- , intersection,- -- * Key Monad- KeyM,- getKey,- runKeyM- )+ , intersection+ -- * Key reexports+ , module Data.HKey+ ) + where+import qualified Data.HKey import Prelude hiding (lookup,null)-import Unsafe.Coerce+import Data.Untypeable import Data.Unique-import System.IO.Unsafe+import Data.HKeyPrivate+import Data.HideType import Control.Monad import Data.Hashable import Data.HashMap.Lazy(HashMap) + import qualified Data.HashMap.Lazy as M import Data.Maybe(fromJust) @@ -186,53 +183,13 @@ --------------------------------------------------------------------} -instance Hashable Unique where- hashWithSalt n u = n + hashUnique u -- | The type of hetrogenous maps. newtype HMap = HMap (HashMap Unique HideType) -{--------------------------------------------------------------------- Keys---------------------------------------------------------------------} --- | The datatype of Keys. ------ [x] The scope of this key. This can either be 'T' for top-level keys created with 'createKey' or --- an existential type for keys introduced by 'withKey'.--- --- [a] The type of things that can be sorted at this key.--- --- For example, @Key T Int@ is a top-level key that can be used to store values--- of type @Int@ in a heterogenous map. -newtype Key s a = Key Unique -data HideType where- HideType :: a -> HideType ---unsafeFromHideType :: HideType -> a-unsafeFromHideType (HideType x) = unsafeCoerce x---- | /O(1)/. Scopes a key to the given function--- The key cannot escape the function (because of the existential type).------ The implementation actually *creates* a key, but because the key cannot escape--- the given function @f@, there is no way to observe that if we run --- @withKey f@ twice, that it will get a different key the second time.--withKey :: (forall x. Key x a -> b) -> b-withKey f = unsafePerformIO $ liftM f createKey -{-# NOINLINE withKey #-} ---- | The scope of top-level keys.-data T ---- | /O(1)/. Create a new top-level key.-createKey :: IO (Key T a)-createKey = fmap Key newUnique- {-------------------------------------------------------------------- Operators --------------------------------------------------------------------}@@ -241,7 +198,7 @@ -- | /O(log n)/. Find the value at a key. -- Calls 'error' when the element can not be found. -(!) :: HMap -> Key x a -> a+(!) :: HMap -> HKey x a -> a m ! k = find k m #if __GLASGOW_HASKELL__ >= 700 {-# INLINABLE (!) #-}@@ -276,7 +233,7 @@ -- The function will return the corresponding value as @('Just' value)@, -- or 'Nothing' if the key isn't in the map. -lookup :: Key x a -> HMap -> Maybe a+lookup :: HKey x a -> HMap -> Maybe a lookup (Key x) (HMap m) = fmap unsafeFromHideType (M.lookup x m) #if __GLASGOW_HASKELL__ >= 700 {-# INLINABLE lookup #-}@@ -285,7 +242,7 @@ #endif -- | /O(log n)/. Is the key a member of the map? See also 'notMember'.-member :: Key x a -> HMap -> Bool+member :: HKey x a -> HMap -> Bool member (Key x) (HMap m) = M.member x m #if __GLASGOW_HASKELL__ >= 700@@ -296,7 +253,7 @@ -- | /O(log n)/. Is the key not a member of the map? See also 'member'. -notMember :: Key x a -> HMap -> Bool+notMember :: HKey x a -> HMap -> Bool notMember k m = not $ member k m #if __GLASGOW_HASKELL__ >= 700 {-# INLINABLE notMember #-}@@ -306,7 +263,7 @@ -- | /O(log n)/. Find the value at a key. -- Calls 'error' when the element can not be found.-find :: Key x a -> HMap -> a+find :: HKey x a -> HMap -> a find x m = fromJust $ lookup x m #if __GLASGOW_HASKELL__ >= 700 {-# INLINABLE find #-}@@ -318,7 +275,7 @@ -- the value at key @k@ or returns default value @def@ -- when the key is not in the map. -findWithDefault :: a -> Key x a -> HMap -> a+findWithDefault :: a -> HKey x a -> HMap -> a findWithDefault a k m = case lookup k m of Just x -> x Nothing -> a @@ -335,10 +292,11 @@ -- | /O(1)/. A map with a single element. -singleton :: Key x a -> a -> HMap+singleton :: HKey x a -> a -> HMap singleton (Key k) x = HMap (M.singleton k (HideType x)) {-# INLINE singleton #-} + {-------------------------------------------------------------------- Insertion --------------------------------------------------------------------}@@ -347,7 +305,7 @@ -- replaced with the supplied value. 'insert' is equivalent to -- @'insertWith' 'const'@. -insert :: Key x a -> a -> HMap -> HMap+insert :: HKey x a -> a -> HMap -> HMap insert (Key k) a (HMap m) = HMap (M.insert k (HideType a) m) #if __GLASGOW_HASKELL__ >= 700 {-# INLINABLE insert #-}@@ -362,7 +320,7 @@ -- not exist in the map. If the key does exist, the function will -- insert the pair @(key, f new_value old_value)@. -insertWith :: (a -> a -> a) -> Key x a -> a -> HMap -> HMap +insertWith :: (a -> a -> a) -> HKey x a -> a -> HMap -> HMap insertWith f k a m = insert k a' m where a' = case lookup k m of Just x -> f a x@@ -379,7 +337,7 @@ -- | /O(log n)/. Delete a key and its value from the map. When the key is not -- a member of the map, the original map is returned. -delete :: Key x a -> HMap -> HMap+delete :: HKey x a -> HMap -> HMap delete (Key k) (HMap m) = HMap $ M.delete k m #if __GLASGOW_HASKELL__ >= 700 {-# INLINABLE delete #-}@@ -391,7 +349,7 @@ -- When the key is not -- a member of the map, the original map is returned. -adjust :: (a -> a) -> Key x a -> HMap -> HMap+adjust :: (a -> a) -> HKey x a -> HMap -> HMap adjust f k m = case lookup k m of Just x -> insert k (f x) m Nothing -> m@@ -406,7 +364,7 @@ -- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is -- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@. -update :: (a -> Maybe a) -> Key x a -> HMap -> HMap+update :: (a -> Maybe a) -> HKey x a -> HMap -> HMap update f k m = case lookup k m of Just x -> case f x of Just y -> insert k y m@@ -422,7 +380,7 @@ -- 'alter' can be used to insert, delete, or update a value in a 'Map'. -- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@. -alter :: (Maybe a -> Maybe a) -> Key x a -> HMap -> HMap+alter :: (Maybe a -> Maybe a) -> HKey x a -> HMap -> HMap alter f k m = case f (lookup k m) of Just x -> insert k x m Nothing -> delete k m@@ -480,41 +438,6 @@ #endif -{--------------------------------------------------------------------- Key Monad---------------------------------------------------------------------} --- | A monad that can be used to create keys--- Keys cannot escape the monad, analogous to the ST Monad.--- Can be used instead of the 'withKey' function if you--- need an statically unkown number of keys.--data GD s a = Done a- | forall b. GetKey (Key s b -> GD s a)---- uses Codensity monad like definition for speed.----newtype KeyM s a = KeyM { rk :: forall b. (a -> GD s b) -> GD s b }--instance Monad (KeyM s) where- return a = KeyM (\k -> k a)- c >>= f = KeyM (\k -> rk c (\a -> rk (f a) k))---- | Obtain a key in the key monad-getKey :: KeyM s (Key s a)-getKey = KeyM $ \c -> GetKey c-#if __GLASGOW_HASKELL__ >= 700-{-# INLINABLE getKey #-}-#endif----- | Run a key monad. Existential type makes sure keys cannot escape.-runKeyM :: (forall s. KeyM s a) -> a-runKeyM m = loop (rk m Done) where- loop (Done a) = a- loop (GetKey c) = loop $ unsafePerformIO $ liftM c createKey - {-# NOINLINE loop #-}
+ Data/Untypeable.hs view
@@ -0,0 +1,34 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.HMap+-- Copyright : (c) Atze van der Ploeg 2013+-- License : BSD-style+-- Maintainer : atzeus@gmail.org+-- Stability : provisional+-- Portability : portable+--+-- Provides a Typeable-like interface for things that cannot derive typeable.++module Data.Untypeable(+ Untypeable,+ inject,+ project)+ where++import Data.HKeyPrivate+import Data.HideType+import Data.Unique++data Untypeable = Untypeable Unique HideType++-- | Make an Untypeable value+inject :: HKey s a -> a -> Untypeable+inject (Key x) a = Untypeable x (HideType a)++-- | Project (i.e. cast) an untypeable value with a given key.+project :: HKey s a -> Untypeable -> Maybe a+project (Key x) (Untypeable x' h) + | x == x' = Just $ unsafeFromHideType h+ | otherwise = Nothing++
HMap.cabal view
@@ -1,7 +1,7 @@ Name: HMap-Version: 1.0.5-Synopsis: Fast heterogeneous maps.-Description: Fast heterogeneous maps based on Hashmaps.+Version: 1.1.0 +Synopsis: Fast heterogeneous maps and unconstrained typeable like functionality.+Description: Fast heterogeneous maps based on Hashmaps and type-able like functionality for type that are not typeable. License: BSD3 License-file: LICENSE Author: Atze van der Ploeg@@ -14,7 +14,7 @@ Tested-With: GHC==7.6.3 Library Build-Depends: base >= 2 && <= 6, unordered-containers >= 0.2, hashable >= 1.2- Exposed-modules: Data.HMap+ Exposed-modules: Data.HMap, Data.HKey, Data.Untypeable, Data.HKeySet Extensions: RankNTypes, GADTs, CPP, EmptyDataDecls source-repository head