intern 0.5.2 → 0.6
raw patch · 3 files changed
+52/−16 lines, 3 filesdep +arrayPVP ok
version bump matches the API change (PVP)
Dependencies added: array
API changes (from Hackage documentation)
+ Data.Interned: cacheWidth :: Interned t => p t -> Int
+ Data.Interned.Internal: cacheWidth :: Interned t => p t -> Int
+ Data.Interned.Internal: content :: CacheState t -> !HashMap (Description t) (Weak t)
+ Data.Interned.Internal: fresh :: CacheState t -> {-# UNPACK #-} !Id
- Data.Interned: class (Eq (Description t), Hashable (Description t)) => Interned t where { data family Description t; type family Uninterned t; { seedIdentity _ = 0 modifyAdvice = id } }
+ Data.Interned: class (Eq (Description t), Hashable (Description t)) => Interned t where { data family Description t; type family Uninterned t; { seedIdentity _ = 0 cacheWidth _ = defaultCacheWidth modifyAdvice = id } }
- Data.Interned.Internal: Cache :: MVar (CacheState t) -> Cache t
+ Data.Interned.Internal: Cache :: Array Int (MVar (CacheState t)) -> Cache t
- Data.Interned.Internal: class (Eq (Description t), Hashable (Description t)) => Interned t where { data family Description t; type family Uninterned t; { seedIdentity _ = 0 modifyAdvice = id } }
+ Data.Interned.Internal: class (Eq (Description t), Hashable (Description t)) => Interned t where { data family Description t; type family Uninterned t; { seedIdentity _ = 0 cacheWidth _ = defaultCacheWidth modifyAdvice = id } }
- Data.Interned.Internal: getCache :: Cache t -> MVar (CacheState t)
+ Data.Interned.Internal: getCache :: Cache t -> Array Int (MVar (CacheState t))
Files
- Data/Interned/IntSet.hs +2/−1
- Data/Interned/Internal.hs +36/−12
- intern.cabal +14/−3
Data/Interned/IntSet.hs view
@@ -114,7 +114,7 @@ import qualified Data.List as List import Data.Monoid (Monoid(..)) import Data.Maybe (fromMaybe)-import Data.Interned+import Data.Interned.Internal import Data.Function (on) import Data.Hashable import Text.Read@@ -184,6 +184,7 @@ identity Nil = 0 identity (Tip i _) = i identity (Bin i _ _ _ _ _) = i+ cacheWidth _ = 16384 -- a huge cache width! seedIdentity _ = 1 identify _ UNil = Nil identify i (UTip j) = Tip i j
Data/Interned/Internal.hs view
@@ -16,27 +16,43 @@ , recover ) where +import Data.Array import Data.Hashable import Data.HashMap.Strict (HashMap)+import Data.Foldable+import Data.Traversable import qualified Data.HashMap.Strict as HashMap import Control.Concurrent.MVar import GHC.IO (unsafeDupablePerformIO, unsafePerformIO) import System.Mem.Weak +-- tuning parameter+defaultCacheWidth :: Int+defaultCacheWidth = 1024+ data CacheState t = CacheState - {-# UNPACK #-} !Id- !(HashMap (Description t) (Weak t))+ { fresh :: {-# UNPACK #-} !Id+ , content :: !(HashMap (Description t) (Weak t))+ } -newtype Cache t = Cache { getCache :: MVar (CacheState t) }+newtype Cache t = Cache { getCache :: Array Int (MVar (CacheState t)) } cacheSize :: Cache t -> IO Int-cacheSize (Cache t) = do- CacheState _ m <- readMVar t- return (HashMap.size m)+cacheSize (Cache t) = foldrM + (\a b -> do + v <- readMVar a+ return $! HashMap.size (content v) + b+ ) 0 t mkCache :: Interned t => Cache t-mkCache = result where- result = Cache $ unsafePerformIO $ newMVar $ CacheState (seedIdentity result) HashMap.empty+mkCache = result where+ element = CacheState (seedIdentity result) HashMap.empty+ w = cacheWidth result+ result = Cache + $ unsafePerformIO + $ traverse newMVar + $ listArray (0,w - 1) + $ replicate w element type Id = Int @@ -50,6 +66,8 @@ identity :: t -> Id seedIdentity :: p t -> Id seedIdentity _ = 0+ cacheWidth :: p t -> Int+ cacheWidth _ = defaultCacheWidth modifyAdvice :: IO t -> IO t modifyAdvice = id cache :: Cache t@@ -58,9 +76,14 @@ unintern :: t -> Uninterned t intern :: Interned t => Uninterned t -> t-intern !bt = unsafeDupablePerformIO $ modifyAdvice $ modifyMVar (getCache cache) go+intern !bt = unsafeDupablePerformIO $ modifyAdvice $ modifyMVar slot go where+ slot = getCache cache ! r !dt = describe bt+ !hdt = hash dt+ !wid = cacheWidth dt+ (q,r) = hdt `divMod` wid+ go (CacheState i m) = case HashMap.lookup dt m of Nothing -> k i m Just wt -> do@@ -68,16 +91,17 @@ case mt of Just t -> return (CacheState i m, t) Nothing -> k i m- k i m = do let t = identify i bt + k i m = do let t = identify (q * i + r) bt wt <- t `seq` mkWeakPtr t $ Just remove return (CacheState (i + 1) (HashMap.insert dt wt m), t)- remove = modifyMVar_ (getCache cache) $ + remove = modifyMVar_ slot $ \ (CacheState i m) -> return $ CacheState i (HashMap.delete dt m) -- given a description, go hunting for an entry in the cache recover :: Interned t => Description t -> IO (Maybe t) recover !dt = do- CacheState _ m <- readMVar $ getCache cache+ CacheState _ m <- readMVar $ getCache cache ! (hash dt `mod` cacheWidth dt) case HashMap.lookup dt m of Nothing -> return Nothing Just wt -> deRefWeak wt+
intern.cabal view
@@ -1,6 +1,6 @@ name: intern category: Data, Data Structures-version: 0.5.2+version: 0.6 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE@@ -10,7 +10,17 @@ homepage: http://github.com/ekmett/intern/ copyright: Copyright (C) 2011 Edward A. Kmett synopsis: Efficient hash-consing for arbitrary data types-description: Efficient hash-consing for arbitrary data types+description: + Efficient hash-consing for arbitrary data types+ .+ Changes from 0.5.2 to 0.6+ .+ * Widened the caches so they don't go through a single MVar per type. This has made a dramatic impact on performance. However, this broke the previous invariant that newer entries always had higher Ids than older entries.+ .+ Changes from 0.5.1 to 0.5.2+ .+ * Added Data.Interned.IntSet+ build-type: Simple extra-source-files: examples/Term.hs@@ -25,7 +35,8 @@ bytestring >= 0.9.1 && < 0.10, text >= 0.11.1.5 && < 0.12, hashable >= 1.1.2 && < 1.2,- unordered-containers >= 0.1.4 && < 0.2+ unordered-containers >= 0.1.4 && < 0.2,+ array >= 0.3.0.2 && < 0.4 exposed-modules: Data.Interned