symbol 0.2.4.1 → 0.3.0
raw patch · 10 files changed
+395/−102 lines, 10 filesdep +symboldep +tastydep +tasty-hunitdep ~basedep ~containersdep ~deepseqsetup-changedPVP ok
version bump matches the API change (PVP)
Dependencies added: symbol, tasty, tasty-hunit, tasty-quickcheck
Dependency ranges changed: base, containers, deepseq
API changes (from Hackage documentation)
Files
- .stylish-haskell.yaml +26/−0
- CHANGELOG.md +15/−0
- Data/Symbol.hs +0/−16
- Data/Symbol/Unsafe.hs +0/−78
- README.md +48/−0
- Setup.hs +1/−1
- src/Data/Symbol.hs +27/−0
- src/Data/Symbol/Unsafe.hs +97/−0
- symbol.cabal +32/−7
- tests/Main.hs +149/−0
+ .stylish-haskell.yaml view
@@ -0,0 +1,26 @@+steps:+ - simple_align:+ cases: always+ top_level_patterns: always+ records: always+ multi_way_if: always+ - imports:+ align: global+ list_align: after_alias+ pad_module_names: true+ long_list_align: inline+ empty_list_align: inherit+ list_padding: 4+ separate_lists: true+ space_surround: false+ post_qualify: false+ group_imports: false+ - language_pragmas:+ style: vertical+ align: true+ remove_redundant: true+ - trailing_whitespace: {}++columns: 80+newline: lf+cabal: true
+ CHANGELOG.md view
@@ -0,0 +1,15 @@+# Changelog++## 0.3.0++- Add GHC 9.12 and 9.14 to CI and allow `containers` 0.8.+- Fix generic `Data` operations to reconstruct symbols through `intern`,+ preserving the association between identifiers and strings. **Compatibility+ change:** the generic representation now has one `String` field instead of+ `Int` and `String` fields. Consumers of the old representation must adapt.+- Require `base >= 4.9`, matching the GHC 8.0+ CI matrix, and remove obsolete+ compiler compatibility code.+- Add baseline and regression tests, with test execution in CI.+- Move library sources into `src/`, enable library warnings, and configure+ Stylish Haskell and VS Code formatting.+- Document ordering, interned-string lifetime, and the generic representation.
− Data/Symbol.hs
@@ -1,16 +0,0 @@-{-# LANGUAGE Trustworthy #-}---- |--- Module : Data.Symbol--- Copyright : (c) Harvard University 2009-2011--- : (c) Geoffrey Mainland 2011-2014--- License : BSD-style--- Maintainer : Geoffrey Mainland <mainland@cs.drexel.edu>--module Data.Symbol (- Symbol,- intern,- unintern- ) where--import Data.Symbol.Unsafe
− Data/Symbol/Unsafe.hs
@@ -1,78 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}---- |--- Module : Data.Symbol.Unsafe--- Copyright : (c) Harvard University 2009-2011--- : (c) Geoffrey Mainland 2011-2014--- License : BSD-style--- Maintainer : Geoffrey Mainland <mainland@cs.drexel.edu>--module Data.Symbol.Unsafe (- Symbol(..),- intern,- unintern- ) where--import Control.Concurrent.MVar-import Control.DeepSeq-import Data.Data (Data)-#if __GLASGOW_HASKELL__ >= 608-import Data.String-#endif /* __GLASGOW_HASKELL__ >= 608 */-import Data.Typeable (Typeable)-import qualified Data.Map as Map-import System.IO.Unsafe (unsafePerformIO)--data Symbol = -- | Unique identifier and the string itself- Symbol {-# UNPACK #-} !Int !String-#if defined(__GLASGOW_HASKELL__)- deriving (Data, Typeable)-#endif /* defined(__GLASGOW_HASKELL__) */--instance Eq Symbol where- (Symbol i1 _) == (Symbol i2 _) = i1 == i2--instance Ord Symbol where- compare (Symbol i1 _) (Symbol i2 _) = compare i1 i2--instance Show Symbol where- showsPrec d (Symbol _ s) = showsPrec d s--instance Read Symbol where- readsPrec d t = [(intern s, t') | (s, t') <- readList t]--#if __GLASGOW_HASKELL__ >= 608-instance IsString Symbol where- fromString = intern-#endif /* __GLASGOW_HASKELL__ >= 608 */--data SymbolEnv = SymbolEnv- { uniq :: {-# UNPACK #-} !Int- , symbols :: !(Map.Map String Symbol)- }--symbolEnv :: MVar SymbolEnv-{-# NOINLINE symbolEnv #-}-symbolEnv = unsafePerformIO $ newMVar $ SymbolEnv 1 Map.empty---- We @'deepseq' s@ so that we can guarantee that when we perform the lookup we--- won't potentially have to evaluate a thunk that might itself call @'intern'@,--- leading to a deadlock.---- |Intern a string to produce a 'Symbol'.-intern :: String -> Symbol-{-# NOINLINE intern #-}-intern s = s `deepseq` unsafePerformIO $ modifyMVar symbolEnv $ \env -> do- case Map.lookup s (symbols env) of- Nothing -> do let sym = Symbol (uniq env) s- let env' = env { uniq = uniq env + 1,- symbols = Map.insert s sym- (symbols env)- }- env' `seq` return (env', sym)- Just sym -> return (env, sym)---- |Return the 'String' associated with a 'Symbol'.-unintern :: Symbol -> String-unintern (Symbol _ s) = s
+ README.md view
@@ -0,0 +1,48 @@+# The `symbol` Package [](https://hackage.haskell.org/package/symbol) [](https://github.com/mainland/symbol/actions?query=workflow%3Ahaskell-ci)++Provides a `Symbol` data type allowing fast symbol comparisons and functions for interning symbols and recovering their `String` representation.++```haskell+import Data.Symbol (intern, unintern)++intern "name" == intern "name" -- True+unintern (intern "name") -- "name"+```++Symbols created through `intern` compare equal exactly when their strings do.+Equality and ordering compare integer identifiers in constant time. Ordering+follows identifier allocation, rather than lexicographic string order, and can+vary with evaluation order and between runs. For lexicographic ordering, compare+the strings returned by `unintern`.++Interning uses a synchronized, process-wide table. Every distinct interned+string and its symbol remain in that table for the lifetime of the process, even+after the caller drops all references. Memory use therefore grows with the+number and total size of distinct strings interned. `intern` fully evaluates its+input string before accessing the table. Inputs must be finite and fully+defined.++The `Data` instance exposes a `Symbol` constructor with one `String` field.+Generic construction and transformations call `intern`, preserving symbol+identity. Use `Data.Symbol` for the abstract API. `Data.Symbol.Unsafe` exposes+the raw constructor, which can break the association between identifiers and+strings.++To build and run the test suite:++```sh+cabal build all+cabal test all --test-show-details=direct+```++The package supports GHC 8.0 and later. CI tests the versions listed in+`symbol.cabal`; regenerate the workflow with `haskell-ci regenerate` after+changing that list or the package components.++Formatting uses `.stylish-haskell.yaml`. With the VS Code Haskell extension and+a working Haskell Language Server, the workspace settings enable formatting on+save. To format from the command line:++```sh+stylish-haskell -i Setup.hs src/Data/Symbol.hs src/Data/Symbol/Unsafe.hs tests/Main.hs+```
Setup.hs view
@@ -1,3 +1,3 @@-import Distribution.Simple+import Distribution.Simple main = defaultMain
+ src/Data/Symbol.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE Trustworthy #-}++-- |+-- Module : Data.Symbol+-- Copyright : (c) Harvard University 2009-2011+-- : (c) Geoffrey Mainland 2011-2014+-- License : BSD-style+-- Maintainer : Geoffrey Mainland <mainland@cs.drexel.edu>+--+-- Interned strings with constant-time equality and ordering. Ordering compares+-- allocated identifiers and can vary with evaluation order and between runs.+-- For lexicographic ordering, compare the strings returned by 'unintern'.+--+-- Every distinct interned string and its symbol remain in the global table for+-- the lifetime of the process, even when callers no longer reference them.+--+-- The @Data@ instance represents a symbol as a @Symbol@ constructor with a+-- single 'String' field. Generic construction and transformations use 'intern'+-- to preserve symbol identity. The internal identifier is not exposed.++module Data.Symbol (+ Symbol,+ intern,+ unintern+ ) where++import Data.Symbol.Unsafe
+ src/Data/Symbol/Unsafe.hs view
@@ -0,0 +1,97 @@+-- |+-- Module : Data.Symbol.Unsafe+-- Copyright : (c) Harvard University 2009-2011+-- : (c) Geoffrey Mainland 2011-2014+-- License : BSD-style+-- Maintainer : Geoffrey Mainland <mainland@cs.drexel.edu>+--+-- This module exposes the raw symbol constructor. Constructing symbols directly+-- can break the association between identifiers and strings. Prefer the abstract+-- API in "Data.Symbol" and construct symbols with 'intern'.++module Data.Symbol.Unsafe (+ Symbol(..),+ intern,+ unintern+ ) where++import Control.Concurrent.MVar+import Control.DeepSeq+import Data.Data (Constr, Data (..), DataType,+ Fixity (Prefix), constrIndex,+ mkConstr, mkDataType)+import qualified Data.Map as Map+import Data.String+import System.IO.Unsafe (unsafePerformIO)++-- | An interned string. Equality and ordering compare allocated identifiers in+-- constant time. Ordering can vary with evaluation order and between runs;+-- compare the results of 'unintern' for lexicographic ordering.+data Symbol = -- | Unique identifier and the string itself+ Symbol {-# UNPACK #-} !Int !String++-- | Generic operations expose only the string and reconstruct through 'intern'+-- to preserve the association between the string and its unique identifier.+instance Data Symbol where+ gfoldl k z sym = z intern `k` unintern sym+ gunfold k z c+ | constrIndex c == 1 = k (z intern)+ | otherwise = error "Data.Symbol.Unsafe.gunfold: invalid constructor"+ toConstr _ = symbolConstr+ dataTypeOf _ = symbolDataType++symbolDataType :: DataType+symbolDataType = mkDataType "Data.Symbol.Unsafe.Symbol" [symbolConstr]++symbolConstr :: Constr+symbolConstr = mkConstr symbolDataType "Symbol" [] Prefix++instance Eq Symbol where+ (Symbol i1 _) == (Symbol i2 _) = i1 == i2++instance Ord Symbol where+ compare (Symbol i1 _) (Symbol i2 _) = compare i1 i2++instance Show Symbol where+ showsPrec d (Symbol _ s) = showsPrec d s++instance Read Symbol where+ readsPrec _ t = [(intern s, t') | (s, t') <- readList t]++instance IsString Symbol where+ fromString = intern++data SymbolEnv = SymbolEnv+ { uniq :: {-# UNPACK #-} !Int+ , symbols :: !(Map.Map String Symbol)+ }++symbolEnv :: MVar SymbolEnv+{-# NOINLINE symbolEnv #-}+symbolEnv = unsafePerformIO $ newMVar $ SymbolEnv 1 Map.empty++-- We @'deepseq' s@ so that we can guarantee that when we perform the lookup we+-- won't potentially have to evaluate a thunk that might itself call @'intern'@,+-- leading to a deadlock.++-- | Intern a string using the synchronized global symbol table. Equal strings+-- produce equal symbols. The input is fully evaluated before accessing the+-- table, so it must be finite and fully defined.+--+-- Every distinct interned string and its symbol remain in the table for the+-- lifetime of the process, even after callers drop all references.+intern :: String -> Symbol+{-# NOINLINE intern #-}+intern s = s `deepseq` unsafePerformIO $ modifyMVar symbolEnv $ \env -> do+ case Map.lookup s (symbols env) of+ Nothing -> do let sym = Symbol (uniq env) s+ let env' = env { uniq = uniq env + 1,+ symbols = Map.insert s sym+ (symbols env)+ }+ env' `seq` return (env', sym)+ Just sym -> return (env, sym)++-- | Return the string associated with a symbol.+unintern :: Symbol -> String+unintern (Symbol _ s) = s
symbol.cabal view
@@ -1,10 +1,10 @@ name: symbol-version: 0.2.4.1+version: 0.3.0 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE copyright: (c) 2006-2011 Harvard University- (c) 2011-2024 Geoffrey Mainland+ (c) 2011-2026 Geoffrey Mainland author: Geoffrey Mainland <mainland@drexel.edu> maintainer: Geoffrey Mainland <mainland@drexel.edu> stability: alpha@@ -25,22 +25,47 @@ GHC==9.4.8, GHC==9.6.4, GHC==9.8.2,- GHC==9.10.1+ GHC==9.10.1,+ GHC==9.12.4,+ GHC==9.14.1 build-type: Simple +extra-source-files:+ README.md+ CHANGELOG.md+ .stylish-haskell.yaml+ library+ hs-source-dirs: src+ exposed-modules: Data.Symbol Data.Symbol.Unsafe build-depends:- base >= 4 && < 5,- containers >= 0.2 && < 0.8,- deepseq >= 1.0 && < 2.0+ base >= 4.9 && < 5,+ containers >= 0.2 && < 0.9,+ deepseq >= 1.0 && < 2 default-language: Haskell2010+ ghc-options: -Wall +test-suite symbol-tests+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Main.hs++ build-depends:+ base >= 4.9 && < 5,+ symbol,+ tasty >= 1.4 && < 1.6,+ tasty-hunit >= 0.10 && < 0.11,+ tasty-quickcheck >= 0.10 && < 0.12++ default-language: Haskell2010+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N2+ source-repository head type: git- location: git://github.com/mainland/symbol.git+ location: https://github.com/mainland/symbol.git
+ tests/Main.hs view
@@ -0,0 +1,149 @@+module Main (main) where++import Control.Concurrent (forkFinally, killThread, newEmptyMVar,+ putMVar, readMVar, takeMVar)+import Control.Exception (ErrorCall, evaluate, finally, throwIO,+ try)+import Control.Monad (forM, forM_)+import Data.Data (Data, fromConstrB, gmapM, gmapT,+ toConstr)+import Data.Maybe (fromMaybe)+import Data.String (fromString)+import Data.Symbol (Symbol, intern, unintern)+import Data.Typeable (Typeable, cast)+import Test.Tasty (TestTree, defaultMain, localOption,+ mkTimeout, testGroup)+import Test.Tasty.HUnit (Assertion, assertFailure, testCase,+ (@?=))+import Test.Tasty.QuickCheck (UnicodeString (..), testProperty)+import Text.Read (readMaybe)++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "symbol"+ [ testGroup "interning"+ [ testProperty "preserves strings" $ \(UnicodeString s) ->+ unintern (intern s) == s+ , testProperty "equality agrees with string equality" $+ \(UnicodeString s) (UnicodeString t) ->+ (intern s == intern t) == (s == t)+ , testProperty "repeated interning preserves identity" $ \(UnicodeString s) ->+ intern s == intern (reverse (reverse s))+ , testProperty "IsString agrees with intern" $ \(UnicodeString s) ->+ fromString s == intern s+ ]+ , testGroup "ordering laws"+ [ testProperty "compare agrees with equality" $+ \(UnicodeString s) (UnicodeString t) ->+ (compare (intern s) (intern t) == EQ) == (s == t)+ , testProperty "comparison is antisymmetric" $+ \(UnicodeString s) (UnicodeString t) ->+ compare (intern s) (intern t) == invert (compare (intern t) (intern s))+ , testProperty "ordering is transitive" $+ \(UnicodeString s) (UnicodeString t) (UnicodeString u) ->+ let x = intern s+ y = intern t+ z = intern u+ in not (x <= y && y <= z) || x <= z+ ]+ , testGroup "Read and Show"+ [ testProperty "Show agrees with String" $ \(UnicodeString s) ->+ show (intern s) == show s+ , testProperty "symbols round-trip" $ \(UnicodeString s) ->+ readMaybe (show (intern s)) == Just (intern s)+ , testProperty "lists of symbols round-trip" $ \strings ->+ let symbols = map (intern . getUnicodeString) strings+ in readMaybe (show symbols) == Just symbols+ , testGroup "edge cases"+ [ testCase (show s) $ do+ unintern (intern s) @?= s+ readMaybe (show (intern s)) @?= Just (intern s)+ | s <- ["", "\NUL", "\n\t", "quote\"slash\\", "\x3bb\x1f600"]+ ]+ , testCase "reads parenthesized strings" $+ readMaybe "((\"alpha\"))" @?= Just (intern "alpha")+ , testCase "reads character lists" $+ readMaybe "['a', 'b']" @?= Just (intern "ab")+ , testCase "leaves trailing input" $+ reads "\"alpha\" rest" @?= [(intern "alpha", " rest")]+ , testCase "rejects malformed input" $+ (readMaybe "\"unterminated" :: Maybe Symbol) @?= Nothing+ ]+ , testGroup "Data instance"+ [ testCase "generic string updates preserve interning" $ do+ let original = intern "generic:original"+ expected = intern "generic:changed"+ changed = gmapT (replace ("generic:changed" :: String)) original+ unintern changed @?= "generic:changed"+ changed @?= expected+ (changed == original) @?= False+ compare changed expected @?= EQ+ , testCase "generic integer updates cannot forge identifiers" $ do+ let original = intern "generic:original"+ changed = gmapT (replace (0 :: Int)) original+ changed @?= original+ unintern changed @?= unintern original+ , testProperty "generic identity traversal preserves symbols" $+ \(UnicodeString s) ->+ let sym = gmapT id (intern s)+ in sym == intern s && unintern sym == s+ , testCase "monadic generic updates preserve interning" $ do+ changed <- gmapM (return . replace ("generic:changed" :: String))+ (intern "generic:original")+ changed @?= intern "generic:changed"+ unintern changed @?= "generic:changed"+ , testCase "generic construction interns its argument" $ do+ let rebuilt = fromConstrB (stringField "generic:rebuilt")+ (toConstr (intern "generic:original")) :: Symbol+ rebuilt @?= intern "generic:rebuilt"+ unintern rebuilt @?= "generic:rebuilt"+ ]+ , localOption (mkTimeout 10000000) $ testGroup "evaluation and concurrency"+ [ testCase "nested interning does not deadlock" $ do+ sym <- evaluate (intern ("outer:" ++ unintern (intern "inner")))+ unintern sym @?= "outer:inner"+ , testCase "input exceptions leave the table usable" $ do+ result <- try (evaluate (intern ('x' : error "bad input")))+ :: IO (Either ErrorCall Symbol)+ case result of+ Left _ -> return ()+ Right _ -> assertFailure "intern did not evaluate the entire input"+ sym <- evaluate (intern "after-exception")+ unintern sym @?= "after-exception"+ , testCase "concurrent interning preserves identity" concurrentInterning+ ]+ ]++replace :: (Typeable a, Typeable b) => a -> b -> b+replace replacement value = fromMaybe value (cast replacement)++stringField :: Data a => String -> a+stringField value = fromMaybe (error "Unexpected non-string Symbol field") (cast value)++invert :: Ordering -> Ordering+invert LT = GT+invert EQ = EQ+invert GT = LT++concurrentInterning :: Assertion+concurrentInterning = do+ gate <- newEmptyMVar+ workers <- forM [0 .. 7 :: Int] $ \offset -> do+ done <- newEmptyMVar+ tid <- forkFinally+ (do readMVar gate+ forM [0 .. 255 :: Int] $ \i -> do+ let s = "concurrent:" ++ show ((i + offset) `mod` 128)+ sym <- evaluate (intern s)+ return (s, sym))+ (putMVar done)+ return (tid, done)+ flip finally (mapM_ (killThread . fst) workers) $ do+ putMVar gate ()+ results <- mapM (takeMVar . snd) workers+ symbols <- mapM (either throwIO return) results+ forM_ (concat symbols) $ \(s, sym) -> do+ unintern sym @?= s+ sym @?= intern s