intern 0.6 → 0.8

raw patch · 6 files changed

+53/−55 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Interned/IntSet.hs +26/−20
• Data/Interned/Internal.hs +11/−25
• Data/Interned/Internal/ByteString.hs +2/−3
• Data/Interned/Internal/String.hs +2/−3
• Data/Interned/Internal/Text.hs +2/−3
• intern.cabal +10/−1

@@ -1,4 +1,4 @@-{-# LANGUAGE MagicHash, TypeFamilies, FlexibleInstances #-}+{-# LANGUAGE MagicHash, TypeFamilies, FlexibleInstances, BangPatterns #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Interned.IntSet@@ -110,12 +110,11 @@             ) where  import Prelude hiding (lookup,filter,foldr,foldl,null,map)-import Data.Bits  import qualified Data.List as List import Data.Monoid (Monoid(..)) import Data.Maybe (fromMaybe) import Data.Interned.Internal-import Data.Function (on)+import Data.Bits import Data.Hashable import Text.Read import GHC.Exts ( Word(..), Int(..), shiftRL# )@@ -165,11 +164,20 @@   | UTip !Int   | UBin {-# UNPACK #-} !Prefix {-# UNPACK #-} !Mask !IntSet !IntSet + tip :: Int -> IntSet tip n = intern (UTip n)  +{--------------------------------------------------------------------+  @bin@ assures that we never have empty trees within a tree.+--------------------------------------------------------------------}+bin :: Prefix -> Mask -> IntSet -> IntSet -> IntSet+bin _ _ l Nil = l+bin _ _ Nil r = r+bin p m l r = intern (UBin p m l r)+ bin_ :: Prefix -> Mask -> IntSet -> IntSet -> IntSet-bin_ p m l r = intern (UBin p m l r) +bin_ p m l r = intern (UBin p m l r)  instance Interned IntSet where   type Uninterned IntSet = UninternedIntSet@@ -193,7 +201,7 @@  instance Hashable (Description IntSet) where   hash DNil = 0-  hash (DTip n) = hash n+  hash (DTip n) = 1 `hashWithSalt` n   hash (DBin p m l r) = hash p `hashWithSalt` m `hashWithSalt` l `hashWithSalt` r  intSetCache :: Cache IntSet@@ -806,7 +814,10 @@  -- /O(1)/ instance Eq IntSet where-  (==) = (==) `on` identity+  Nil             == Nil             = True+  Tip i _         == Tip j _         = i == j+  Bin i _ _ _ _ _ == Bin j _ _ _ _ _ = i == j+  _ == _ = False  {--------------------------------------------------------------------   Ord @@ -814,16 +825,18 @@       but is usable for comparison --------------------------------------------------------------------} instance Ord IntSet where-  compare = compare `on` identity+  Nil `compare` Nil = EQ+  Nil `compare` Tip _ _ = LT+  Nil `compare` Bin _ _ _ _ _ _ = LT+  Tip _ _ `compare` Nil = GT+  Tip i _ `compare` Tip j _ = compare i j+  Tip i _ `compare` Bin j _ _ _ _ _ = compare i j +  Bin _ _ _ _ _ _ `compare` Nil = GT+  Bin i _ _ _ _ _ `compare` Tip j _ = compare i j+  Bin i _ _ _ _ _ `compare` Bin j _ _ _ _ _ = compare i j   -- compare s1 s2 = compare (toAscList s1) (toAscList s2)   {---------------------------------------------------------------------  Eq ---------------------------------------------------------------------}-instance Hashable IntSet where-  hash = hash . identity--{--------------------------------------------------------------------   Show --------------------------------------------------------------------} instance Show IntSet where@@ -857,13 +870,6 @@     m = branchMask p1 p2     p = mask p1 m -{---------------------------------------------------------------------  @bin@ assures that we never have empty trees within a tree.---------------------------------------------------------------------}-bin :: Prefix -> Mask -> IntSet -> IntSet -> IntSet-bin _ _ l Nil = l-bin _ _ Nil r = r-bin p m l r   = bin_ p m l r     {--------------------------------------------------------------------

@@ -22,9 +22,8 @@ import Data.Foldable import Data.Traversable import qualified Data.HashMap.Strict as HashMap-import Control.Concurrent.MVar+import Data.IORef import GHC.IO (unsafeDupablePerformIO, unsafePerformIO)-import System.Mem.Weak  -- tuning parameter defaultCacheWidth :: Int@@ -32,15 +31,15 @@  data CacheState t = CacheState     { fresh :: {-# UNPACK #-} !Id-   , content :: !(HashMap (Description t) (Weak t))+   , content :: !(HashMap (Description t) t)    } -newtype Cache t = Cache { getCache :: Array Int (MVar (CacheState t)) }+newtype Cache t = Cache { getCache :: Array Int (IORef (CacheState t)) }  cacheSize :: Cache t -> IO Int cacheSize (Cache t) = foldrM     (\a b -> do -       v <- readMVar a+       v <- readIORef a        return $! HashMap.size (content v) + b    ) 0 t @@ -50,7 +49,7 @@   w       = cacheWidth result   result  = Cache            $ unsafePerformIO -          $ traverse newMVar +          $ traverse newIORef           $ listArray (0,w - 1)            $ replicate w element @@ -76,32 +75,19 @@   unintern :: t -> Uninterned t  intern :: Interned t => Uninterned t -> t-intern !bt = unsafeDupablePerformIO $ modifyAdvice $ modifyMVar slot go+intern !bt = unsafeDupablePerformIO $ modifyAdvice $ atomicModifyIORef slot go   where   slot = getCache cache ! r   !dt = describe bt   !hdt = hash dt   !wid = cacheWidth dt-  (q,r) = hdt `divMod` wid-  +  r = hdt `mod` wid   go (CacheState i m) = case HashMap.lookup dt m of-    Nothing -> k i m-    Just wt -> do-      mt <- deRefWeak wt-      case mt of -        Just t -> return (CacheState i m, t)-        Nothing -> k i m-  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_ slot $ -    \ (CacheState i m) -> return $ CacheState i (HashMap.delete dt m)+    Nothing -> let t = identify (wid * i + r) bt in (CacheState (i + 1) (HashMap.insert dt t m), t)+    Just t -> (CacheState i m, t)  -- 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 ! (hash dt `mod` cacheWidth dt)-  case HashMap.lookup dt m of-    Nothing -> return Nothing-    Just wt -> deRefWeak wt-  +  CacheState _ m <- readIORef $ getCache cache ! (hash dt `mod` cacheWidth dt)+  return $ HashMap.lookup dt m

@@ -8,7 +8,6 @@ import Data.ByteString import Data.ByteString.Char8 as Char8 import Data.Hashable-import Data.Function (on)  data InternedByteString = InternedByteString    {-# UNPACK #-} !Id@@ -18,10 +17,10 @@   fromString = intern . Char8.pack  instance Eq InternedByteString where-  (==) = (==) `on` identity+  InternedByteString i _ == InternedByteString j _ = i == j  instance Ord InternedByteString where-  compare = compare `on` identity+  InternedByteString i _ `compare` InternedByteString j _ = i `compare` j  instance Show InternedByteString where   showsPrec d (InternedByteString _ b) = showsPrec d b

@@ -7,7 +7,6 @@ import Data.Interned import Data.Hashable import Data.Foldable-import Data.Function (on)  data InternedString = IS    {-# UNPACK #-} !Id@@ -17,10 +16,10 @@   fromString = intern  instance Eq InternedString where-  (==) = (==) `on` identity+  IS i _ == IS j _ = i == j   instance Ord InternedString where-  compare = compare `on` identity+  compare (IS i _) (IS j _) = compare i j  instance Show InternedString where   showsPrec d (IS _ b) = showsPrec d b

@@ -7,7 +7,6 @@ import Data.Interned import Data.Text import Data.Hashable-import Data.Function (on)  data InternedText = InternedText    {-# UNPACK #-} !Id@@ -17,10 +16,10 @@   fromString = intern . pack  instance Eq InternedText where-  (==) = (==) `on` identity+  InternedText i _ == InternedText j _ = i == j  instance Ord InternedText where-  compare = compare `on` identity+  compare (InternedText i _) (InternedText j _) = compare i j  instance Show InternedText where   showsPrec d (InternedText _ b) = showsPrec d b

@@ -1,6 +1,6 @@ name:          intern category:      Data, Data Structures-version:       0.6+version:       0.8 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -11,6 +11,15 @@ copyright:     Copyright (C) 2011 Edward A. Kmett synopsis:      Efficient hash-consing for arbitrary data types description:   +    Changes from 0.7 to 0.8+    .+    * Disabled cache removal as it was causing problems on large data sets. There is no good way to ensure that both references remain alive long enough to finish comparisons.+    * Switched to IORef from MVar+    .+    Changes from 0.6 to 0.7+    .+    * Fixed problem where comparisons could happen between data structures while one was still a thunk, leading to equal structures comparing as inequal in limited circumstances, by appropriately using strictness annotations. +    .     Efficient hash-consing for arbitrary data types     .     Changes from 0.5.2 to 0.6