packages feed

symbolize 1.0.2.4 → 1.0.3.0

raw patch · 5 files changed

+168/−99 lines, 5 filesdep +vector-hashtablesdep −containersdep ~vector

Dependencies added: vector-hashtables

Dependencies removed: containers

Dependency ranges changed: vector

Files

CHANGELOG.md view
@@ -8,6 +8,14 @@  ## Unreleased +## 1.0.3.0++- Swap internals of the global symbol table.+  - Before: `IORef (Data.IntSet (NonEmpty WeakSymbol))`+  - After: `MVar (HashTable.Dictionary (HashTable.PrimState IO) U.MVector Int V.MVector NonEmptyWeakSymbol)`+    - Reading/writing to this mutable hashtable from the `vector-hashtables` package scales almost linearly+    - The `NonEmpty WeakSymbol` is replaced by a monomorphised version of the same, reducing memory overhead by one more word per symbol.+ ## 1.0.2.4  - Fix too eager creation of weak pointers, resulting in many needless allocations. This greatly reduces memory pressure and improves speed when inserting many symbols in a short amount of time! 
+ src/Symbolize/NonEmptyWeakSymbol.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE GHC2021 #-}+module Symbolize.NonEmptyWeakSymbol +(NonEmptyWeakSymbol((:|)), +toList, +nonEmpty, +singleton, +cons+) where++import Symbolize.WeakSymbol (WeakSymbol)++-- | A monomorphised version of `Data.List.NonEmpty`+-- which allows its head `WeakSymbol` to be UNPACKed into it.+-- Since we expect collisions to be _very_ rare,+-- this skips the intermediate allocation almost always.+data NonEmptyWeakSymbol where+  (:|) :: {-# UNPACK #-} !WeakSymbol -> ![WeakSymbol] -> NonEmptyWeakSymbol++toList :: NonEmptyWeakSymbol -> [WeakSymbol]+{-# INLINE toList #-}+toList (a :| as) = a : as++nonEmpty :: [WeakSymbol] -> Maybe NonEmptyWeakSymbol+{-# INLINE nonEmpty #-}+nonEmpty [] = Nothing+nonEmpty (a : as) = Just (a :| as)++singleton :: WeakSymbol -> NonEmptyWeakSymbol+{-# INLINE singleton #-}+singleton a = a :| []++cons :: WeakSymbol -> NonEmptyWeakSymbol -> NonEmptyWeakSymbol+{-# INLINE cons #-}+cons y (x :| xs) = y :| (x : xs)
src/Symbolize/SymbolTable.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_HADDOCK hide, prune #-}+{-# LANGUAGE LambdaCase #-}  module Symbolize.SymbolTable   ( insertGlobal,@@ -16,38 +17,26 @@ import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Array.Byte (ByteArray (ByteArray)) import Data.Foldable qualified as Foldable-import Data.IORef (IORef)-import Data.IORef qualified as IORef-import Data.IntMap.Strict (IntMap)-import Data.IntMap.Strict qualified as IntMap+import qualified Data.Vector.Mutable as VM+import qualified Data.Vector.Unboxed.Mutable  as UM+import Data.Vector.Hashtables qualified as HashTable import Data.List qualified-import Data.List.NonEmpty (NonEmpty(..))-import Data.List.NonEmpty qualified as NonEmpty import Data.Maybe (mapMaybe)-import GHC.Exts (ByteArray#, StableName#, Weak#, deRefWeak#, makeStableName#, mkWeak#)-import GHC.IO (IO (IO), unsafePerformIO)-import Symbolize.Accursed qualified+import GHC.Exts (ByteArray#)+import GHC.IO (unsafePerformIO) import Symbolize.Accursed qualified as Accursed import Symbolize.SipHash qualified as SipHash import System.IO.Unsafe qualified import System.Random.Stateful qualified as Random (Uniform (uniformM), globalStdGen) import Prelude hiding (lookup)---- Inside the WeakSymbol--- we keep:--- - A weak pointer to the underlying ByteArray#.---   This weak pointer will be invalidated (turn into a 'tombstone')---   when the final instance of this symbol is GC'd--- - A `StableName` for the same ByteArray#---   This ensures we have a stable hash even in the presence of the ByteArray#---   being moved around by the GC.---   We never read it after construction,---   but by keeping it around until the WeakSymbol is removed by the finalizer,---   we ensure that future calls to `makeStableName` return the same hash.-data WeakSymbol where-  WeakSymbol# :: Weak# ByteArray# -> StableName# ByteArray# -> WeakSymbol+import Control.Concurrent (MVar)+import Control.Concurrent.MVar qualified as MVar+import Symbolize.WeakSymbol (WeakSymbol)+import Symbolize.WeakSymbol qualified as WeakSymbol+import Symbolize.NonEmptyWeakSymbol (NonEmptyWeakSymbol)+import Symbolize.NonEmptyWeakSymbol qualified as NonEmptyWeakSymbol -newtype SymbolTable = SymbolTable (IntMap (NonEmpty WeakSymbol))+newtype SymbolTable = SymbolTable (HashTable.Dictionary (HashTable.PrimState IO) UM.MVector Int VM.MVector NonEmptyWeakSymbol)  -- | The global Symbol Table, containing a mapping between each symbol's textual representation and its deduplicated pointer. --@@ -58,12 +47,11 @@ -- -- Current implementation details (these might change even between PVP-compatible versions): ----- - An `IntMap` is used for mapping $(SipHash text) -> weak symbol$.---   Such an IntMap has O(min(n, 64)) lookup time.+-- - A `CuckooHashTable Int` is used for mapping $(SipHash text) -> weak symbol$. -- - Since SipHash is used as hashing algorithm and the key that is used --   is randomized on global table initialization, --   the table is resistent to HashDoS attacks.-data GlobalSymbolTable = GlobalSymbolTable (IORef SymbolTable) SipHash.SipKey+data GlobalSymbolTable = GlobalSymbolTable (MVar SymbolTable) SipHash.SipKey  newtype Hash = Hash {hashToInt :: Int} @@ -71,64 +59,62 @@ instance Show GlobalSymbolTable where   -- SAFETY: We're only reading, and do not care about performance here.   show (GlobalSymbolTable table _) = System.IO.Unsafe.unsafePerformIO $ do-    SymbolTable symtab <- IORef.readIORef table-    let contents = Data.List.sort $ map Accursed.shortTextFromBA $ foldMap aliveWeaks $ IntMap.elems symtab-    pure $ "GlobalSymbolTable { size = " <> show (length contents) <> ", symbols = " <> show contents <> " }"+    MVar.withMVar table $ \(SymbolTable symtab) -> do+      elems <- fmap snd <$> HashTable.toList symtab+      let contents = Data.List.sort $ map Accursed.shortTextFromBA $ foldMap aliveWeaks elems+      pure $ "GlobalSymbolTable { size = " <> show (length contents) <> ", symbols = " <> show contents <> " }"  insertGlobal :: ByteArray# -> IO ByteArray {-# INLINE insertGlobal #-} insertGlobal ba# = do   GlobalSymbolTable gsymtab sipkey <- globalSymbolTable   let !hash = calculateHash sipkey ba#-  -- SAFETY: If the table IORef contested, -  -- this might trigger `weak` creation for the same bytestring from multiple threads-  -- at the same time.-  -- But finalization is idempotent, and only when a thread finally wins the Compare-and-Swap-  -- will its `weak` pointer be inserted (or alternatively another previously-inserted `ba` returned).-  -- So once this function returns, we can be sure we've returned a deduplicated ByteArray-  IORef.atomicModifyIORef' gsymtab $ \table ->-    case lookup ba# hash table of-      Just ba -> (table, ba)-      Nothing ->-        let !weak = Accursed.accursedUnutterablePerformIO (mkWeakSymbol ba# (removeGlobal hash))-        in (insert hash weak table, ByteArray ba#)+  MVar.withMVar gsymtab $ \table -> do+    res <- lookup ba# sipkey table+    case res of+      Just ba -> pure ba+      Nothing -> do+        !weak <- WeakSymbol.new ba# (removeGlobal hash)+        insert hash weak table+        pure (ByteArray ba#)  lookupGlobal :: ByteArray# -> IO (Maybe ByteArray) {-# INLINE lookupGlobal #-} lookupGlobal ba# = do   GlobalSymbolTable gsymtab sipkey <- globalSymbolTable-  table <- IORef.readIORef gsymtab-  let hash = calculateHash sipkey ba#-  pure (lookup ba# hash table)+  MVar.withMVar gsymtab (lookup ba# sipkey)  removeGlobal :: Hash -> IO () {-# INLINE removeGlobal #-} removeGlobal !key = do   GlobalSymbolTable gsymtab _ <- globalSymbolTable-  IORef.atomicModifyIORef' gsymtab $ \table ->-    (remove key table, ())+  MVar.withMVar gsymtab (remove key) -insert :: Hash -> WeakSymbol -> SymbolTable -> SymbolTable+insert :: Hash -> WeakSymbol -> SymbolTable -> IO () {-# INLINE insert #-}-insert key weak (SymbolTable table) =-  let table' = IntMap.alter (Just . maybe (pure weak) (NonEmpty.cons weak)) (hashToInt key) table-   in SymbolTable table'+insert key weak (SymbolTable table) = HashTable.alter table insertOrConcat (hashToInt key)+  where+    insertOrConcat = \case+      Nothing -> Just (NonEmptyWeakSymbol.singleton weak)+      Just weaks -> Just (NonEmptyWeakSymbol.cons weak weaks) -lookup :: ByteArray# -> Hash -> SymbolTable -> Maybe ByteArray+lookup :: ByteArray# -> SipHash.SipKey -> SymbolTable -> IO (Maybe ByteArray) {-# INLINE lookup #-}-lookup ba# hash (SymbolTable table) = do-  weaks <- IntMap.lookup (hashToInt hash) table-  Foldable.find (\other -> other == ByteArray ba#) (aliveWeaks weaks)+lookup ba# sipkey (SymbolTable table) = do+  let !key = calculateHash sipkey ba#+  weaks <- HashTable.lookup table (hashToInt key)+  pure $ case weaks of+    Nothing -> Nothing+    Just weaks' ->+      Foldable.find (\other -> other == ByteArray ba#) (aliveWeaks weaks') -remove :: Hash -> SymbolTable -> SymbolTable+remove :: Hash -> SymbolTable -> IO () {-# INLINE remove #-}-remove (Hash key) (SymbolTable table) =-  let table' = IntMap.update removeTombstones key table-   in SymbolTable table'+remove (Hash key) (SymbolTable table) = HashTable.alter table (>>= removeTombstones) key   where-    removeTombstones = NonEmpty.nonEmpty . NonEmpty.filter isNoTombstone+    removeTombstones = NonEmptyWeakSymbol.nonEmpty . filter isNoTombstone . NonEmptyWeakSymbol.toList     isNoTombstone weak =-      case deRefWeakSymbol weak of+      case WeakSymbol.deref weak of         Nothing -> False         Just _ -> True @@ -138,34 +124,9 @@   let (SipHash.SipHash word) = SipHash.hash sipkey (ByteArray ba#)    in Hash (fromIntegral word) -mkWeakSymbol :: ByteArray# -> IO () -> IO WeakSymbol-{-# INLINE mkWeakSymbol #-}-mkWeakSymbol ba# (IO finalizer#) = -    -- SAFETY: This should even be safe-    -- in the presence of inlining, CSE and full laziness-    ---    -- because the result is outwardly pure-    -- and the finalizer we use is idempotent-  IO $ \s1 -> case mkWeak# ba# ba# finalizer# s1 of-    (# s2, weak# #) ->-      case makeStableName# ba# s2 of-        (# s3, sname# #) ->-          (# s3, WeakSymbol# weak# sname# #)--deRefWeakSymbol :: WeakSymbol -> Maybe ByteArray-{-# INLINE deRefWeakSymbol #-}-deRefWeakSymbol (WeakSymbol# w _sn) = -    -- SAFETY: This should even be safe-    -- in the presence of inlining, CSE and full laziness;-    Symbolize.Accursed.accursedUnutterablePerformIO $ IO $ \s ->-  case deRefWeak# w s of-    (# s1, flag, p #) -> case flag of-      0# -> (# s1, Nothing #)-      _ -> (# s1, Just (ByteArray p) #)--aliveWeaks :: NonEmpty WeakSymbol -> [ByteArray]+aliveWeaks :: NonEmptyWeakSymbol -> [ByteArray] {-# INLINE aliveWeaks #-}-aliveWeaks = mapMaybe deRefWeakSymbol . NonEmpty.toList+aliveWeaks = mapMaybe WeakSymbol.deref . NonEmptyWeakSymbol.toList  -- | Get a handle to the `GlobalSymbolTable` --@@ -177,14 +138,18 @@ -- SAFETY: We need all calls to globalSymbolTable' to use the same thunk, so NOINLINE. {-# NOINLINE globalSymbolTable' #-} globalSymbolTable' = unsafePerformIO $ do-  !ref <- IORef.newIORef (SymbolTable mempty)+  !table <- HashTable.initialize 128+  !ref <- MVar.newMVar (SymbolTable table)   !sipkey <- Random.uniformM Random.globalStdGen   pure (GlobalSymbolTable ref sipkey)  -- | Returns the current size of the global symbol table. Useful for introspection or metrics.+--+-- Should not be used in high-performance code, as it might walk over the full table. globalSymbolTableSize :: IO Word globalSymbolTableSize = do   GlobalSymbolTable gsymtab _ <- globalSymbolTable-  SymbolTable table <- IORef.readIORef gsymtab-  let size = fromIntegral (IntMap.size table)-  pure size+  MVar.withMVar gsymtab $ \(SymbolTable table) -> do+    elems <- HashTable.toList table+    let size = fromIntegral (length elems)+    pure size
+ src/Symbolize/WeakSymbol.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE GHC2021 #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE MagicHash #-}+module Symbolize.WeakSymbol (WeakSymbol, new, deref) where++import Data.Array.Byte (ByteArray (ByteArray))+import GHC.Exts (ByteArray#, StableName#, Weak#, deRefWeak#, mkWeak#, makeStableName#)+import GHC.IO (IO (IO))+import Symbolize.Accursed qualified as Accursed++-- Inside the WeakSymbol+-- we keep:+-- - A weak pointer to the underlying ByteArray#.+--   This weak pointer will be invalidated (turn into a 'tombstone')+--   when the final instance of this symbol is GC'd+-- - A `StableName` for the same ByteArray#+--   This ensures we have a stable hash even in the presence of the ByteArray#+--   being moved around by the GC.+--   We never read it after construction,+--   but by keeping it around until the WeakSymbol is removed by the finalizer,+--   we ensure that future calls to `makeStableName` return the same hash.+data WeakSymbol where+  WeakSymbol# :: Weak# ByteArray# -> StableName# ByteArray# -> WeakSymbol++-- | Create a new weak symbol+-- based on the given symbol content ByteArray+-- and finalizer to run when the weak symbol+-- is no longer needed.+new :: ByteArray# -> IO () -> IO WeakSymbol+{-# INLINE new #-}+new ba# (IO finalizer#) =+    -- SAFETY: This should even be safe+    -- in the presence of inlining, CSE and full laziness+    --+    -- because the result is outwardly pure+    -- and the finalizer we use is idempotent+  IO $ \s1 -> case mkWeak# ba# ba# finalizer# s1 of+    (# s2, weak# #) ->+      case makeStableName# ba# s2 of+        (# s3, sname# #) ->+          (# s3, WeakSymbol# weak# sname# #)++-- | Attempt to get back the containing ByteArray#+-- by looking inside this `WeakSymbol`+--+-- Returns `Nothing` if it was GC'd in the meantime+-- (which may be before, after or concurrently with when the finalizer runs)+deref :: WeakSymbol -> Maybe ByteArray+{-# INLINE deref #-}+deref (WeakSymbol# w _sn) =+    -- SAFETY: This should even be safe+    -- in the presence of inlining, CSE and full laziness;+    Accursed.accursedUnutterablePerformIO $ IO $ \s ->+  case deRefWeak# w s of+    (# s1, flag, p #) -> case flag of+      0# -> (# s1, Nothing #)+      _ -> (# s1, Just (ByteArray p) #)
symbolize.cabal view
@@ -1,11 +1,11 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.37.0.+-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack  name:           symbolize-version:        1.0.2.4+version:        1.0.3.0 synopsis:       Efficient global Symbol table, with Garbage Collection. description:    Symbols, also known as Atoms or Interned Strings, are a common technique                 to reduce memory usage and improve performance when using many small strings:@@ -58,6 +58,8 @@   other-modules:       Symbolize.Accursed       Symbolize.SipHash+      Symbolize.WeakSymbol+      Symbolize.NonEmptyWeakSymbol       Symbolize.SymbolTable   hs-source-dirs:       src@@ -72,12 +74,13 @@       base >=4.7 && <5     , binary >=0.8.9 && <0.9     , bytestring >=0.11.0 && <0.13-    , containers >=0.6.0 && <0.8     , deepseq >=1.4.0 && <1.6     , hashable >=1.4.0 && <1.6     , random >=1.2 && <2     , text >=2.0 && <2.2     , text-short >=0.1.0 && <0.2+    , vector >=0.12.0 && <0.14+    , vector-hashtables ==0.1.*   default-language: Haskell2010  test-suite symbolize-doctest@@ -100,7 +103,6 @@       base >=4.7 && <5     , binary >=0.8.9 && <0.9     , bytestring >=0.11.0 && <0.13-    , containers >=0.6.0 && <0.8     , deepseq >=1.4.0 && <1.6     , doctest-parallel     , hashable >=1.4.0 && <1.6@@ -108,6 +110,8 @@     , symbolize     , text >=2.0 && <2.2     , text-short >=0.1.0 && <0.2+    , vector >=0.12.0 && <0.14+    , vector-hashtables ==0.1.*   default-language: Haskell2010  test-suite symbolize-test@@ -134,7 +138,6 @@     , base >=4.7 && <5     , binary >=0.8.9 && <0.9     , bytestring >=0.11.0 && <0.13-    , containers >=0.6.0 && <0.8     , deepseq >=1.4.0 && <1.6     , hashable >=1.4.0 && <1.6     , hedgehog@@ -146,6 +149,8 @@     , tasty-hunit     , text >=2.0 && <2.2     , text-short >=0.1.0 && <0.2+    , vector >=0.12.0 && <0.14+    , vector-hashtables ==0.1.*   default-language: Haskell2010  benchmark symbolize-bench@@ -168,7 +173,6 @@       base >=4.7 && <5     , binary >=0.8.9 && <0.9     , bytestring >=0.11.0 && <0.13-    , containers >=0.6.0 && <0.8     , deepseq >=1.4.0 && <1.6     , hashable >=1.4.0 && <1.6     , random >=1.2 && <2@@ -176,5 +180,6 @@     , tasty-bench     , text >=2.0 && <2.2     , text-short >=0.1.0 && <0.2-    , vector+    , vector >=0.12.0 && <0.14+    , vector-hashtables ==0.1.*   default-language: Haskell2010