From 0aa7f8c9e0d9b63d4dc866ddd5c6d636d193c368 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20Antkiewicz?= Date: Thu, 24 Aug 2023 09:27:48 -0400 Subject: [PATCH 1/7] fix strictness syntax (remove the space after bang) --- Data/StringMap/Base.hs | 58 +++++++++++++++++++++--------------------- 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/Data/StringMap/Base.hs b/Data/StringMap/Base.hs index ba77074..8cc2e8e 100644 --- a/Data/StringMap/Base.hs +++ b/Data/StringMap/Base.hs @@ -166,12 +166,12 @@ import Data.Size data StringMap v = Empty | Val { value' :: v - , tree :: ! (StringMap v) + , tree :: !(StringMap v) } | Branch { sym :: {-# UNPACK #-} - ! Sym - , child :: ! (StringMap v) - , next :: ! (StringMap v) + !Sym + , child :: !(StringMap v) + , next :: !(StringMap v) } -- the space optimisation nodes, these @@ -181,30 +181,30 @@ data StringMap v = Empty | Leaf { value' :: v -- a value at a leaf of the tree } | Last { sym :: {-# UNPACK #-} - ! Sym -- the last entry in a branch list - , child :: ! (StringMap v) -- or no branch but a single child + !Sym -- the last entry in a branch list + , child :: !(StringMap v) -- or no branch but a single child } - | LsSeq { syms :: ! Key1 -- a sequence of single childs - , child :: ! (StringMap v) -- in a last node + | LsSeq { syms :: !Key1 -- a sequence of single childs + , child :: !(StringMap v) -- in a last node } - | BrSeq { syms :: ! Key1 -- a sequence of single childs - , child :: ! (StringMap v) -- in a branch node - , next :: ! (StringMap v) + | BrSeq { syms :: !Key1 -- a sequence of single childs + , child :: !(StringMap v) -- in a branch node + , next :: !(StringMap v) } - | LsSeL { syms :: ! Key1 -- a sequence of single childs + | LsSeL { syms :: !Key1 -- a sequence of single childs , value' :: v -- with a leaf } - | BrSeL { syms :: ! Key1 -- a sequence of single childs + | BrSeL { syms :: !Key1 -- a sequence of single childs , value' :: v -- with a leaf in a branch node - , next :: ! (StringMap v) + , next :: !(StringMap v) } | BrVal { sym :: {-# UNPACK #-} - ! Sym -- a branch with a single char + !Sym -- a branch with a single char , value' :: v -- and a value - , next :: ! (StringMap v) + , next :: !(StringMap v) } | LsVal { sym :: {-# UNPACK #-} - ! Sym -- a last node with a single char + !Sym -- a last node with a single char , value' :: v -- and a value } deriving (Show, Eq, Ord, Typeable) @@ -217,18 +217,18 @@ data StringMap v = Empty -- for internal use in prefix tree to optimize space efficiency data Key1 = Nil - | S1 {-# UNPACK #-} ! Sym - | S2 {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym - | S3 {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym - | S4 {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym - | C1 {-# UNPACK #-} ! Sym - ! Key1 - | C2 {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym - ! Key1 - | C3 {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym - ! Key1 - | C4 {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym - ! Key1 + | S1 {-# UNPACK #-} !Sym + | S2 {-# UNPACK #-} !Sym {-# UNPACK #-} !Sym + | S3 {-# UNPACK #-} !Sym {-# UNPACK #-} !Sym {-# UNPACK #-} !Sym + | S4 {-# UNPACK #-} !Sym {-# UNPACK #-} !Sym {-# UNPACK #-} !Sym {-# UNPACK #-} !Sym + | C1 {-# UNPACK #-} !Sym + !Key1 + | C2 {-# UNPACK #-} !Sym {-# UNPACK #-} !Sym + !Key1 + | C3 {-# UNPACK #-} !Sym {-# UNPACK #-} !Sym {-# UNPACK #-} !Sym + !Key1 + | C4 {-# UNPACK #-} !Sym {-# UNPACK #-} !Sym {-# UNPACK #-} !Sym {-# UNPACK #-} !Sym + !Key1 deriving (Eq, Ord, Typeable) instance Show Key1 where From 2ab4917523e01f73832a28336cf360ea9ba5d099 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20Antkiewicz?= Date: Thu, 24 Aug 2023 09:28:24 -0400 Subject: [PATCH 2/7] gitignore dist-newstyle/ --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index d535806..4679b40 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,7 @@ /tests/en_US.dict /benchmarks/en_US.dict dist +dist-newstyle/ cabal-dev *.o *.hi From 33e36826a16671dd35287f3975f5df23b73c5dec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20Antkiewicz?= Date: Thu, 24 Aug 2023 09:29:47 -0400 Subject: [PATCH 3/7] from alexbiehl: Make sure v is evaluated in strict StringMap --- Data/StringMap/Strict.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Data/StringMap/Strict.hs b/Data/StringMap/Strict.hs index bdb2c20..347bff1 100644 --- a/Data/StringMap/Strict.hs +++ b/Data/StringMap/Strict.hs @@ -173,7 +173,7 @@ insert !k !v = insertWith const k v -- the value of @f new_value old_value@ will be inserted. insertWith :: (a -> a -> a) -> Key -> a -> StringMap a -> StringMap a -insertWith f !k v t = insert' f v k t +insertWith f !k !v t = insert' f v k t {-# INLINE insertWith #-} From a206efa0f23849f70886b38024bb7eaff91b4e1f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20Antkiewicz?= Date: Thu, 24 Aug 2023 09:31:38 -0400 Subject: [PATCH 4/7] MonadFail fix --- Data/StringMap/Base.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Data/StringMap/Base.hs b/Data/StringMap/Base.hs index 8cc2e8e..6c4effc 100644 --- a/Data/StringMap/Base.hs +++ b/Data/StringMap/Base.hs @@ -421,7 +421,7 @@ singleton k v = anyseq (fromKey k) (val v empty) -- | /O(1)/ Extract the value of a node (if there is one) -value :: Monad m => StringMap a -> m a +value :: MonadFail m => StringMap a -> m a value t = case norm t of Val v _ -> return v _ -> fail "StringMap.value: no value at this node" @@ -447,7 +447,7 @@ succ t = case norm t of -- | /O(min(n,L))/ Find the value associated with a key. The function will @return@ the result in -- the monad or @fail@ in it if the key isn't in the map. -lookup :: Monad m => Key -> StringMap a -> m a +lookup :: MonadFail m => Key -> StringMap a -> m a lookup k t = case lookup' k t of Just v -> return v Nothing -> fail "StringMap.lookup: Key not found" From 0fe1e8e3919de3077b40a61f54cb681c3548307e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20Antkiewicz?= Date: Thu, 24 Aug 2023 09:31:59 -0400 Subject: [PATCH 5/7] bump version --- data-stringmap.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/data-stringmap.cabal b/data-stringmap.cabal index 2ce086a..6e004d7 100644 --- a/data-stringmap.cabal +++ b/data-stringmap.cabal @@ -1,5 +1,5 @@ name: data-stringmap -version: 1.0.1.2 +version: 1.0.1.3 license: MIT license-file: LICENSE author: Uwe Schmidt, Sebastian Philipp From c0bfecacc3c88cbc183b726e39e7a24471b64800 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20Antkiewicz?= Date: Thu, 24 Aug 2023 12:46:47 -0400 Subject: [PATCH 6/7] added benchmark and bumped version to 1.0.2 --- benchmarks/StringMap.hs | 3 +-- data-stringmap.cabal | 14 +++++++++++++- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/benchmarks/StringMap.hs b/benchmarks/StringMap.hs index 707eab6..ed5b907 100644 --- a/benchmarks/StringMap.hs +++ b/benchmarks/StringMap.hs @@ -4,7 +4,6 @@ module Main where import Control.DeepSeq import Control.Exception (evaluate) import Control.Monad.Trans (liftIO) -import Criterion.Config import Criterion.Main import Data.List (foldl') import qualified Data.StringMap.Strict as M @@ -22,7 +21,7 @@ main = do m <- return $ (M.fromList elems :: M.StringMap Int) defaultMainWith defaultConfig - (liftIO . evaluate $ rnf [m]) + --(liftIO . evaluate $ rnf [m]) [ bench "lookup" $ whnf (lookup keys) m , bench "insert" $ whnf (ins elems) M.empty , bench "insertWith empty" $ whnf (insWith elems) M.empty diff --git a/data-stringmap.cabal b/data-stringmap.cabal index 6e004d7..c146a59 100644 --- a/data-stringmap.cabal +++ b/data-stringmap.cabal @@ -1,5 +1,5 @@ name: data-stringmap -version: 1.0.1.3 +version: 1.0.2 license: MIT license-file: LICENSE author: Uwe Schmidt, Sebastian Philipp @@ -143,3 +143,15 @@ test-suite strict hs-source-dirs: tests + +benchmark bench-all + type: exitcode-stdio-1.0 + main-is: benchmarks/StringMap.hs + build-depends: base + , binary + , containers + , criterion + , deepseq + , mtl + , data-stringmap + ghc-options: -O2 \ No newline at end of file From 2ce0adb947adaa5581d347ce8555ec76db44d815 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20Antkiewicz?= Date: Thu, 24 Aug 2023 13:06:35 -0400 Subject: [PATCH 7/7] add section about benchmarking --- README.md | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/README.md b/README.md index 6c8f7fa..78e52ac 100644 --- a/README.md +++ b/README.md @@ -37,4 +37,30 @@ $ cabal install in the root directory. Everything else should be done automatically by cabal. +Benchmarking +------------ + +Execute +``` +$ cd StringMap +$ cp benchmarks/space/en_US.dict +$ cabal bench +... +Running 1 benchmarks... +Benchmark bench-all: RUNNING... +benchmarking lookup +time 27.78 ms (25.56 ms .. 29.25 ms) + 0.981 R² (0.955 R² .. 0.995 R²) +mean 31.97 ms (30.56 ms .. 33.15 ms) +std dev 2.811 ms (2.310 ms .. 3.555 ms) +variance introduced by outliers: 34% (moderately inflated) +benchmarking insert +time 57.58 ms (55.47 ms .. 59.29 ms) + 0.997 R² (0.994 R² .. 1.000 R²) +mean 56.74 ms (55.23 ms .. 58.51 ms) +std dev 3.083 ms (2.058 ms .. 4.828 ms) +variance introduced by outliers: 15% (moderately inflated) +... +Benchmark bench-all: FINISH +``` \ No newline at end of file