packages feed

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 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