symbolize (empty) → 0.1.0.0

raw patch · 11 files changed

+825/−0 lines, 11 filesdep +asyncdep +basedep +bytestringsetup-changed

Dependencies added: async, base, bytestring, deepseq, doctest-parallel, hashable, hedgehog, symbolize, tasty, tasty-golden, tasty-hedgehog, tasty-hunit, text, text-display, text-short, unordered-containers

Files

• CHANGELOG.md +11/−0
• LICENSE +30/−0
• README.md +116/−0
• Setup.hs +2/−0
• src/Symbolize.hs +379/−0
• src/Symbolize/Accursed.hs +14/−0
• src/Symbolize/Textual.hs +95/−0
• symbolize.cabal +122/−0
• test/doctest/DocTest.hs +5/−0
• test/suite/Suite.hs +5/−0
• test/suite/SymbolizeTest.hs +46/−0

@@ -0,0 +1,11 @@+# Changelog for `symbolize`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0 - YYYY-MM-DD

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2023++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,116 @@+# Symbolize+[![Hackage](http://img.shields.io/hackage/v/symbolize.svg)](https://hackage.haskell.org/package/symbolize)++Haskell library implementing a global Symbol Table, with garbage collection.++Symbols, also known as Atoms or Interned Strings, are a common technique+to reduce memory usage and improve performance when using many small strings.++By storing a single copy of each encountered string in a global table and giving out indexes to that table,+it is possible to compare strings for equality in constant time, instead of linear (in string size) time.++The main advantages of Symbolize over existing symbol table implementations are:++- Garbage collection: Symbols which are no longer used are automatically cleaned up.+- `Symbol`s have a memory footprint of exactly 1 `Word` and are nicely unpacked by GHC.+- Support for any `Textual` type, including `String`, (strict and lazy) `Data.Text`, (strict and lazy) `Data.ByteString` etc.+- Thread-safe.+- Efficient: Calls to `lookup` and `unintern` are free of atomic memory barriers (and never have to wait on a concurrent thread running `intern`)+- Support for a maximum of 2^64 symbols at the same time (you'll probably run out of memory before that point).++## Basic usage++This module is intended to be imported qualified, e.g.+++```haskell+import Symbolize (Symbol)+import qualified Symbolize+```++To intern a string, use `intern`:++```haskell+>>> hello = Symbolize.intern "hello"+>>> world = Symbolize.intern "world"+>>> (hello, world)+(Symbolize.intern "hello",Symbolize.intern "world")+```++Interning supports any `Textual` type, so you can also use `Data.Text` or `Data.ByteString` etc.:++```haskell+>>> import Data.Text (Text)+>>> niceCheeses = fmap Symbolize.intern (["Roquefort", "Camembert", "Brie"] :: [Text])+>>> niceCheeses+[Symbolize.intern "Roquefort",Symbolize.intern "Camembert",Symbolize.intern "Brie"]+```++And if you are using OverloadedStrings, you can use the `IsString` instance to intern constants:++```haskell+>>> hello2 = ("hello" :: Symbol)+>>> hello2+Symbolize.intern "hello"+```++Comparisons between symbols run in O(1) time:++```haskell+>>> hello == hello2+True+>>> hello == world+False+```++To get back the textual value of a symbol, use `unintern`:++```haskell+>>> Symbolize.unintern hello+"hello"+```++If you only want to check whether a string is already interned, use `lookup`:++```haskell+>>> Symbolize.lookup "hello"+Just (Symbolize.intern "hello")+```++Symbols make great keys for `Data.HashMap` and `Data.HashSet`.+Hashing them is a no-op and they are guaranteed to be unique:++```haskell+>>> import qualified Data.Hashable as Hashable+>>> Hashable.hash hello+0+>>> fmap Hashable.hash niceCheeses+[2,3,4]+```++For introspection, you can look at how many symbols currently exist:++```haskell+>>> Symbolize.globalSymbolTableSize+5+>>> [unintern (intern (show x)) | x <- [1..5]]+["1","2","3","4","5"]+>>> Symbolize.globalSymbolTableSize+10+```++Unused symbols will be garbage-collected, so you don't have to worry about memory leaks:++```haskell+>>> System.Mem.performGC+>>> Symbolize.globalSymbolTableSize+5+```++For deeper introspection, you can look at the Show instance of the global symbol table:+/(Note that the exact format is subject to change.)/++```haskell+>>> Symbolize.globalSymbolTable+GlobalSymbolTable { count = 5, next = 10, contents = [(0,"hello"),(1,"world"),(2,"Roquefort"),(3,"Camembert"),(4,"Brie")] }+```

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,379 @@+-- | Implementation of a global Symbol Table, with garbage collection.+--+-- Symbols, also known as Atoms or Interned Strings, are a common technique+-- to reduce memory usage and improve performance when using many small strings.+--+-- By storing a single copy of each encountered string in a global table and giving out indexes to that table,+-- it is possible to compare strings for equality in constant time, instead of linear (in string size) time.+--+-- The main advantages of Symbolize over existing symbol table implementations are:+--+-- - Garbage collection: Symbols which are no longer used are automatically cleaned up.+-- - `Symbol`s have a memory footprint of exactly 1 `Word` and are nicely unpacked by GHC.+-- - Support for any `Textual` type, including `String`, (strict and lazy) `Data.Text`, (strict and lazy) `Data.ByteString` etc.+-- - Thread-safe.+-- - Efficient: Calls to `lookup` and `unintern` are free of atomic memory barriers (and never have to wait on a concurrent thread running `intern`)+-- - Support for a maximum of 2^64 symbols at the same time (you'll probably run out of memory before that point).+--+-- == Basic usage+--+-- This module is intended to be imported qualified, e.g.+--+-- > import Symbolize (Symbol)+-- > import qualified Symbolize+--+-- To intern a string, use `intern`:+--+-- >>> hello = Symbolize.intern "hello"+-- >>> world = Symbolize.intern "world"+-- >>> (hello, world)+-- (Symbolize.intern "hello",Symbolize.intern "world")+--+-- Interning supports any `Textual` type, so you can also use `Data.Text` or `Data.ByteString` etc.:+--+-- >>> import Data.Text (Text)+-- >>> niceCheeses = fmap Symbolize.intern (["Roquefort", "Camembert", "Brie"] :: [Text])+-- >>> niceCheeses+-- [Symbolize.intern "Roquefort",Symbolize.intern "Camembert",Symbolize.intern "Brie"]+--+-- And if you are using OverloadedStrings, you can use the `IsString` instance to intern constants:+--+-- >>> hello2 = ("hello" :: Symbol)+-- >>> hello2+-- Symbolize.intern "hello"+-- >>> Symbolize.intern ("world" :: Text)+-- Symbolize.intern "world"+--+-- Comparisons between symbols run in O(1) time:+--+-- >>> hello == hello2+-- True+-- >>> hello == world+-- False+--+-- To get back the textual value of a symbol, use `unintern`:+--+-- >>> Symbolize.unintern hello+-- "hello"+--+-- If you want to check whether a string is currently interned, use `lookup`:+--+-- >>> Symbolize.lookup "hello"+-- Just (Symbolize.intern "hello")+--+-- Symbols make great keys for `Data.HashMap` and `Data.HashSet`.+-- Hashing them is a no-op and they are guaranteed to be unique:+--+-- >>> Data.Hashable.hash hello+-- 0+-- >>> fmap Data.Hashable.hash niceCheeses+-- [2,3,4]+--+-- For introspection, you can look at how many symbols currently exist:+--+-- >>> Symbolize.globalSymbolTableSize+-- 5+-- >>> [unintern (intern (show x)) | x <- [1..5]]+-- ["1","2","3","4","5"]+-- >>> Symbolize.globalSymbolTableSize+-- 10+--+-- Unused symbols will be garbage-collected, so you don't have to worry about memory leaks:+--+-- >>> System.Mem.performGC+-- >>> Symbolize.globalSymbolTableSize+-- 5+--+-- For deeper introspection, you can look at the Show instance of the global symbol table:+-- /(Note that the exact format is subject to change.)/+--+-- >>> Symbolize.globalSymbolTable+-- GlobalSymbolTable { count = 5, next = 10, contents = [(0,"hello"),(1,"world"),(2,"Roquefort"),(3,"Camembert"),(4,"Brie")] }+module Symbolize+  ( -- * Symbol+    Symbol,+    intern,+    unintern,+    lookup,+    Textual (..),++    -- * Introspection & Metrics+    GlobalSymbolTable,+    globalSymbolTable,+    globalSymbolTableSize,+  )+where++import Control.Applicative ((<|>))+import Control.Concurrent.MVar (MVar)+import qualified Control.Concurrent.MVar as MVar+import Control.DeepSeq (NFData (..))+import Data.Function ((&))+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import Data.Hashable (Hashable (..))+import Data.IORef (IORef)+import qualified Data.IORef as IORef+import Data.String (IsString (..))+import Data.Text.Display (Display (..))+import Data.Text.Short (ShortText)+import GHC.Read (Read (..))+import qualified Symbolize.Accursed+import Symbolize.Textual (Textual (..))+import qualified System.IO.Unsafe+import System.Mem.Weak (Weak)+import qualified System.Mem.Weak as Weak+import Text.Read (Lexeme (Ident), lexP, parens, prec, readListPrecDefault)+import qualified Text.Read+import Prelude hiding (lookup)++-- | A string-like type with O(1) equality and comparison.+--+-- A Symbol represents a string (any `Textual`, so String, Text, ByteString etc.)+-- However, it only stores an (unpacked) `Word`, used as index into a global table in which the actual string value is stored.+-- Thus equality checks are constant-time, and its memory footprint is very low.+--+-- This is very useful if you're frequently comparing strings+-- and the same strings might come up many times.+-- It also makes Symbol a great candidate for a key in a `HashMap` or `Data.HashSet`. (Hashing them is a no-op!)+--+-- The symbol table is implemented using weak pointers,+-- which means that unused symbols will be garbage collected.+-- As such, you do not need to be concerned about memory leaks.+--+-- Symbols are considered 'the same' regardless of whether they originate+-- from a `String`, (lazy or strict, normal or short) `Data.Text`, (lazy or strict, normal or short) `Data.ByteString` etc.+--+-- Symbolize supports up to 2^64 symbols existing at the same type.+-- Your system will probably run out of memory before you reach that point.+data Symbol = Symbol {-# UNPACK #-} !Word++instance Show Symbol where+  showsPrec p symbol =+    let !str = unintern @String symbol+     in showParen (p > 10) $+          showString "Symbolize.intern " . shows str++-- | To be a good citizen w.r.t both `Show` and `IsString`, reading is supported two ways:+--+-- >>> read @Symbol "Symbolize.intern \"Haskell\""+-- Symbolize.intern "Haskell"+-- >>> read @Symbol "\"Curry\""+-- Symbolize.intern "Curry"+instance Read Symbol where+  readListPrec = readListPrecDefault+  readPrec = parens $ prec 10 $ full <|> onlyString+    where+      onlyString = do+        str <- readPrec @String+        return $ Symbolize.intern str+      full = do+        Ident "Symbolize" <- lexP+        Text.Read.Symbol "." <- lexP+        Ident "intern" <- lexP+        str <- readPrec @String+        return $ Symbolize.intern str++instance IsString Symbol where+  fromString = intern+  {-# INLINE fromString #-}++-- |+-- >>> Data.Text.Display.display (Symbolize.intern "Pizza")+-- "Pizza"+instance Display Symbol where+  displayBuilder = unintern+  {-# INLINE displayBuilder #-}++-- | Takes only O(1) time.+instance Eq Symbol where+  (Symbol a) == (Symbol b) = a == b+  {-# INLINE (==) #-}++-- | Symbol contains only a strict `Word`, so it is already fully evaluated.+instance NFData Symbol where+  rnf sym = seq sym ()++-- | Symbols are ordered by their `ShortText` representation.+--+-- Comparison takes O(n) time, as they are compared byte-by-byte.+instance Ord Symbol where+  compare a b = compare (unintern @ShortText a) (unintern @ShortText b)+  {-# INLINE compare #-}++-- |+-- Hashing a `Symbol` is very fast:+--+-- `hash` is a no-op and results in zero collissions, as `Symbol`'s index is unique and can be interpreted as a hash as-is.+--+-- `hashWithSalt` takes O(1) time; just as long as hashWithSalt-ing any other `Word`.+instance Hashable Symbol where+  hash (Symbol idx) = hash idx+  hashWithSalt salt (Symbol idx) = hashWithSalt salt idx+  {-# INLINE hash #-}+  {-# INLINE hashWithSalt #-}++-- | The global Symbol Table, containing a bidirectional mapping between each symbol's textual representation and its Word index.+--+-- You cannot manipulate the table itself directly,+-- but you can use `globalSymbolTable` to get a handle to it and use its `Show` instance for introspection.+--+-- `globalSymbolTableSize` can similarly be used to get the current size of the table.+data GlobalSymbolTable = GlobalSymbolTable+  { next :: !(MVar Word),+    mappings :: !(IORef SymbolTableMappings)+  }++instance Show GlobalSymbolTable where+  show table =+    -- SAFETY: We're only reading, and do not care about performance here.+    System.IO.Unsafe.unsafePerformIO $ do+      -- NOTE: We want to make sure that (roughly) the same table state is used for each of the components+      -- which is why we use BangPatterns such that a partially-read show string will end up printing a (roughly) consistent state.+      !next' <- MVar.readMVar (next table) -- IORef.readIORef (next table)+      !mappings' <- IORef.readIORef (mappings table)+      let !contents = mappings' & symbolsToText+      -- let !reverseContents = mappings' & textToSymbols & fmap  (fmap hash . System.IO.Unsafe.unsafePerformIO . Weak.deRefWeak) & HashMap.toList+      let !count = HashMap.size contents+      pure+        $ "GlobalSymbolTable { count = "+          <> show count+          <> ", next = "+          <> show next'+          -- <> ", reverseContents = "+          -- <> show reverseContents+          <> ", contents = "+          <> show (HashMap.toList contents)+          <> " }"++data SymbolTableMappings = SymbolTableMappings+  { textToSymbols :: !(HashMap ShortText (Weak Symbol)),+    symbolsToText :: !(HashMap Word ShortText)+  }++-- | Unintern a symbol, returning its textual value.+-- Takes O(log16 n) time to look up the matching textual value, where n is the number of symbols currently in the table.+--+-- Afterwards, the textual value is converted to the desired type s. See `Textual` for the type-specific time complexity.+--+-- Runs concurrently with any other operation on the symbol table, without any atomic memory barriers.+unintern :: (Textual s) => Symbol -> s+unintern (Symbol idx) =+  let !mappingsRef = mappings globalSymbolTable'+      -- SAFETY:+      -- First, it's thread-safe because we only read (from a single IORef).+      -- Second, this function is idempotent and (outwardly) pure,+      -- so whether it is executed only once or many times for a particular Symbol does not matter in the slightest.+      -- Thus, we're very happy with the compiler inlining, CSE'ing or floating out this IO action.+      --+      -- I hope I'm correct and the Cosmic Horror will not eat me!+      -- signed by Marten, 2023-11-24+      !mappings' = Symbolize.Accursed.accursedUnutterablePerformIO $ IORef.readIORef mappingsRef+   in mappings'+        & symbolsToText+        & HashMap.lookup idx+        & maybe (error ("Symbol " <> show idx <> " not found. This should never happen" <> show globalSymbolTable')) fromShortText+{-# INLINE unintern #-}++-- | Looks up a symbol in the global symbol table.+--+-- Returns `Nothing` if no such symbol currently exists.+--+-- Takes O(log16 n) time, where n is the number of symbols currently in the table.+--+-- Runs concurrently with any other operation on the symbol table, without any atomic memory barriers.+--+-- Because the result can vary depending on the current state of the symbol table, this function is not pure.+lookup :: (Textual s) => s -> IO (Maybe Symbol)+lookup text = do+  let !text' = toShortText text+  table <- globalSymbolTable+  mappings <- IORef.readIORef (mappings table)+  let maybeWeak = mappings & textToSymbols & HashMap.lookup text'+  case maybeWeak of+    Nothing -> pure Nothing+    Just weak -> do+      Weak.deRefWeak weak+{-# NOINLINE lookup #-}++-- | Intern a string-like value.+--+-- First converts s to a `ShortText` (if it isn't already one). See `Textual` for the type-specific time complexity of this.+-- Then, takes O(log16 n) time to look up the matching symbol and insert it if it did not exist yet (where n is the number of symbols currently in the table).+--+-- Any concurrent calls to (the critical section in) `intern` are synchronized.+intern :: (Textual s) => s -> Symbol+intern text =+  let !text' = toShortText text+   in lookupOrInsert text'+  where+    lookupOrInsert text' =+      -- SAFETY: `intern` is idempotent, so inlining and CSE is benign (and might indeed improve performance).+      System.IO.Unsafe.unsafePerformIO $ MVar.modifyMVar (next globalSymbolTable') $ \next -> do+        maybeWeak <- lookup text+        case maybeWeak of+          Just symbol -> pure (next, symbol)+          Nothing -> insert text' next+    insert text' next = do+      SymbolTableMappings {symbolsToText, textToSymbols} <- IORef.readIORef (mappings globalSymbolTable')+      let !idx = nextEmptyIndex next symbolsToText+      let !symbol = Symbol idx+      weakSymbol <- Weak.mkWeakPtr symbol (Just (finalizer idx))+      let !mappings2 =+            SymbolTableMappings+              { symbolsToText = HashMap.insert idx text' symbolsToText,+                textToSymbols = HashMap.insert text' weakSymbol textToSymbols+              }+      IORef.atomicWriteIORef (mappings globalSymbolTable') mappings2++      let !nextFree = idx + 1+      pure (nextFree, symbol)+{-# INLINE intern #-}++nextEmptyIndex :: Word -> HashMap Word ShortText -> Word+nextEmptyIndex starting symbolsToText = go starting+  where+    go idx = case HashMap.lookup idx symbolsToText of+      Nothing -> idx+      _ -> go (idx + 1) -- <- Wrapping on overflow is intentional and important for correctness++-- | Returns a handle to the global symbol table. (Only) useful for introspection or debugging.+globalSymbolTable :: IO GlobalSymbolTable+globalSymbolTable =+  globalSymbolTable'+    -- re-introduce the IO bound which we unsafePerformIO'ed:+    & pure++globalSymbolTable' :: GlobalSymbolTable+globalSymbolTable' =+  -- SAFETY: We need all calls to globalSymbolTable' to use the same thunk, so NOINLINE.+  System.IO.Unsafe.unsafePerformIO $ do+    nextRef <- MVar.newMVar 0 -- IORef.newIORef 0+    mappingsRef <- IORef.newIORef (SymbolTableMappings HashMap.empty HashMap.empty)+    return (GlobalSymbolTable nextRef mappingsRef)+{-# NOINLINE globalSymbolTable' #-}++-- | Returns the current size of the global symbol table. Useful for introspection or metrics.+globalSymbolTableSize :: IO Word+globalSymbolTableSize = do+  table <- globalSymbolTable+  mappings <- IORef.readIORef (mappings table)+  let size =+        mappings+          & symbolsToText+          & HashMap.size+          & fromIntegral+  pure size++finalizer :: Word -> IO ()+finalizer idx = do+  MVar.withMVar (next globalSymbolTable') $ \_next -> do+    IORef.modifyIORef' (mappings globalSymbolTable') $ \SymbolTableMappings {symbolsToText, textToSymbols} ->+      case HashMap.lookup idx symbolsToText of+        Nothing -> error ("Duplicate finalizer called for " <> show idx <> "This should never happen") -- SymbolTableMappings {symbolsToText, textToSymbols}+        Just text ->+          SymbolTableMappings+            { symbolsToText = HashMap.delete idx symbolsToText,+              textToSymbols = HashMap.delete text textToSymbols+            }+{-# NOINLINE finalizer #-}

@@ -0,0 +1,14 @@+{-# LANGUAGE MagicHash, UnboxedTuples #-}+module Symbolize.Accursed (accursedUnutterablePerformIO) where++import GHC.IO (IO(IO))+import GHC.Base (realWorld#)++-- This \"function\" has a superficial similarity to 'System.IO.Unsafe.unsafePerformIO' but+-- it is in fact a malevolent agent of chaos.+--+-- Full warning: https://hackage.haskell.org/package/bytestring-0.12.0.2/docs/Data-ByteString-Internal.html#v:accursedUnutterablePerformIO+-- (This definition is also taken from there)+accursedUnutterablePerformIO :: IO a -> a+accursedUnutterablePerformIO (IO m) = case m realWorld# of (# _, r #)   -> r+{-# INLINE accursedUnutterablePerformIO #-}

@@ -0,0 +1,95 @@+{-# LANGUAGE FlexibleInstances #-}+-- NOTE: FlexibleInstances is needed to support `String` instance :-(++module Symbolize.Textual (Textual (..)) where++import Data.ByteString (ByteString)+import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short as ShortByteString+import Data.Function ((&))+import Data.Text (Text)+import qualified Data.Text.Encoding as Text.Encoding+import qualified Data.Text.Encoding.Error as Text.Encoding.Error+import qualified Data.Text.Lazy as LText+import Data.Text.Short (ShortText)+import qualified Data.Text.Short as ShortText+import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as Builder++-- | Implemented by any String-like types.+-- The symbol table uses `ShortText` for its internal storage, so any type which can be converted to it+-- can be turned to/from a `Symbolize.Symbol`.+--+-- Instance should handle potential invalid UTF-8 by using the Unicode replacement character,+-- c.f. `Data.Text.Encoding.Error.lenientDecode`.+class Textual a where+  toShortText :: a -> ShortText+  fromShortText :: ShortText -> a++-- |+-- - O(0) conversion (a no-op)+instance Textual ShortText where+  toShortText = id+  {-# INLINE toShortText #-}+  fromShortText = id+  {-# INLINE fromShortText #-}++-- |+-- - O(1) conversion+instance Textual Text where+  toShortText = ShortText.fromText+  {-# INLINE toShortText #-}+  fromShortText = ShortText.toText+  {-# INLINE fromShortText #-}++-- |+-- - O(n) conversion+instance Textual String where+  toShortText = ShortText.fromString+  {-# INLINE toShortText #-}+  fromShortText = ShortText.toString+  {-# INLINE fromShortText #-}++-- |+-- - O(1) conversion+instance Textual LText.Text where+  toShortText = ShortText.fromText . LText.toStrict+  {-# INLINE toShortText #-}+  fromShortText = LText.fromStrict . ShortText.toText+  {-# INLINE fromShortText #-}++-- | +-- - toShortText: O(n). Evaluates the entire builder.+-- - fromShortText: O(1)+instance Textual Builder where+  toShortText = ShortText.fromText . LText.toStrict . Builder.toLazyText+  {-# INLINE toShortText #-}+  fromShortText = Builder.fromText . ShortText.toText+  {-# INLINE fromShortText #-}++-- |+-- - toShortText: O(n). Turns invalid UTF-8 into the Unicode replacement character.+-- - fromShortText: O(0) no-op+instance Textual ShortByteString where+  toShortText byteString =+    byteString+      & ShortByteString.fromShort+      & Text.Encoding.decodeUtf8With Text.Encoding.Error.lenientDecode+      & ShortText.fromText+  {-# INLINE toShortText #-}++  fromShortText = ShortText.toShortByteString+  {-# INLINE fromShortText #-}++-- |+-- - toShortText: O(n). Turns invalid UTF-8 into the Unicode replacement character.+-- - fromShortText: O(n).+instance Textual ByteString where+  toShortText byteString =+    byteString+      & Text.Encoding.decodeUtf8With Text.Encoding.Error.lenientDecode+      & ShortText.fromText+  {-# INLINE toShortText #-}++  fromShortText = ShortText.toByteString+  {-# INLINE fromShortText #-}

@@ -0,0 +1,122 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.36.0.+--+-- see: https://github.com/sol/hpack++name:           symbolize+version:        0.1.0.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.+                By storing a single copy of each encountered string in a global table and giving out indexes to that table, it is possible to compare strings for equality in constant time, instead of linear (in string size) time.+                The main advantages of Symbolize over existing symbol table implementations are:+                - Garbage collection: Symbols which are no longer used are automatically cleaned up. - `Symbol`s have a memory footprint of exactly 1 `Word` and are nicely unpacked by GHC. - Support for any `Textual` type, including `String`, (strict and lazy) `Data.Text`, (strict and lazy) `Data.ByteString` etc. - Thread-safe. - Calls to `lookup` and `unintern` are free of atomic memory barriers (and never have to wait on a concurrent thread running `intern`) - Support for a maximum of 2^64 symbols at the same time (you'll probably run out of memory before that point).+                Please see the full README on GitHub at <https://github.com/Qqwy/haskell-symbolize#readme> +category:       Data, Data Structures+homepage:       https://github.com/Qqwy/haskell-symbolize#readme+bug-reports:    https://github.com/Qqwy/haskell-symbolize/issues+author:         Qqwy / Marten+maintainer:     qqwy@gmx.com+copyright:      2023 Marten Wijnja+license:        BSD-3-Clause+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/Qqwy/haskell-symbolize++library+  exposed-modules:+      Symbolize+  other-modules:+      Symbolize.Textual+      Symbolize.Accursed+  hs-source-dirs:+      src+  default-extensions:+      BangPatterns+      OverloadedStrings+      DeriveAnyClass+      TypeApplications+      NamedFieldPuns+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , bytestring >=0.11.0 && <0.12+    , deepseq >=1.4.0 && <1.5+    , hashable >=1.4.0 && <1.5+    , text >=2.0 && <2.2+    , text-display >=0.0.5 && <0.1+    , text-short >=0.1.0 && <0.2+    , unordered-containers >=0.2.0 && <0.3+  default-language: Haskell2010++test-suite symbolize-doctest+  type: exitcode-stdio-1.0+  main-is: DocTest.hs+  other-modules:+      Paths_symbolize+  autogen-modules:+      Paths_symbolize+  hs-source-dirs:+      test/doctest+  default-extensions:+      BangPatterns+      OverloadedStrings+      DeriveAnyClass+      TypeApplications+      NamedFieldPuns+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , bytestring >=0.11.0 && <0.12+    , deepseq >=1.4.0 && <1.5+    , doctest-parallel+    , hashable >=1.4.0 && <1.5+    , symbolize+    , text >=2.0 && <2.2+    , text-display >=0.0.5 && <0.1+    , text-short >=0.1.0 && <0.2+    , unordered-containers >=0.2.0 && <0.3+  default-language: Haskell2010++test-suite symbolize-test+  type: exitcode-stdio-1.0+  main-is: Suite.hs+  other-modules:+      SymbolizeTest+      Paths_symbolize+  autogen-modules:+      Paths_symbolize+  hs-source-dirs:+      test/suite+  default-extensions:+      BangPatterns+      OverloadedStrings+      DeriveAnyClass+      TypeApplications+      NamedFieldPuns+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-tool-depends:+      tasty-discover:tasty-discover+  build-depends:+      async+    , base >=4.7 && <5+    , bytestring >=0.11.0 && <0.12+    , deepseq >=1.4.0 && <1.5+    , hashable >=1.4.0 && <1.5+    , hedgehog+    , symbolize+    , tasty+    , tasty-golden+    , tasty-hedgehog+    , tasty-hunit+    , text >=2.0 && <2.2+    , text-display >=0.0.5 && <0.1+    , text-short >=0.1.0 && <0.2+    , unordered-containers >=0.2.0 && <0.3+  default-language: Haskell2010

@@ -0,0 +1,5 @@+import Test.DocTest (mainFromCabal)+import System.Environment (getArgs)++main :: IO ()+main = mainFromCabal "symbolize" =<< getArgs

@@ -0,0 +1,5 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover #-}+-- | Tasty test driver module. Auto-discovers any tests+-- in this directory and subdirectories and runs them.+--+-- c.f. https://hackage.haskell.org/package/tasty-discover

@@ -0,0 +1,46 @@+module SymbolizeTest where++-- import qualified System.Mem++import qualified Control.Concurrent.Async+import Control.Monad.IO.Class (liftIO)+import qualified Data.Hashable+import Data.Text (Text)+import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import qualified Symbolize+import qualified System.Mem+import Test.Tasty.HUnit++unit_simpleInternUninternTest :: IO ()+unit_simpleInternUninternTest = do+  System.Mem.performGC++  let str = "hello" :: Text+  let !symbol = Symbolize.intern str++  size <- Symbolize.globalSymbolTableSize+  size @?= 1++  let str2 = Symbolize.unintern symbol+  str2 @?= str++hprop_symbolTableIsIdempotent :: Property+hprop_symbolTableIsIdempotent = withTests 1000 $ property $ do+  texts <- forAll $ Gen.list (Range.linear 0 200) (Gen.text (Range.linear 0 20) Gen.unicode)+  let !symbols = fmap Symbolize.intern texts+  annotateShow (fmap Data.Hashable.hash symbols)+  let !texts2 = fmap Symbolize.unintern symbols++  texts2 === texts++hprop_concurrentAccessDoesNotCorruptTable :: Property+hprop_concurrentAccessDoesNotCorruptTable = withTests 500 $ property $ do+  let numCores = 8+  texts <- forAll $ Gen.list (Range.linear 0 200) (Gen.text (Range.linear 0 20) Gen.unicode)+  results <- liftIO $ Control.Concurrent.Async.forConcurrently [(1 :: Integer) .. numCores] $ \_ -> do+    let !texts2 = fmap (\val -> Symbolize.unintern $! Symbolize.intern $! val) texts+    pure texts2++  mapM_ (=== texts) results