Skip to content

Ghc9x #9

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
mantkiew wants to merge 7 commits into
base: master
Choose a base branch
from
Open

Ghc9x #9

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
0aa7f8c
fix strictness syntax (remove the space after bang)
mantkiew Aug 24, 2023
2ab4917
gitignore dist-newstyle/
mantkiew Aug 24, 2023
33e3682
from alexbiehl: Make sure v is evaluated in strict StringMap
mantkiew Aug 24, 2023
a206efa
MonadFail fix
mantkiew Aug 24, 2023
0fe1e8e
bump version
mantkiew Aug 24, 2023
c0bfeca
added benchmark and bumped version to 1.0.2
mantkiew Aug 24, 2023
2ce0adb
add section about benchmarking
mantkiew Aug 24, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions .gitignore
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
/tests/en_US.dict
/benchmarks/en_US.dict
dist
dist-newstyle/
cabal-dev
*.o
*.hi
Expand Down
62 changes: 31 additions & 31 deletions Data/StringMap/Base.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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"
Expand All @@ -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"
Expand Down
2 changes: 1 addition & 1 deletion Data/StringMap/Strict.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 #-}

Expand Down
26 changes: 26 additions & 0 deletions README.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
```
3 changes: 1 addition & 2 deletions benchmarks/StringMap.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
14 changes: 13 additions & 1 deletion data-stringmap.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
name: data-stringmap
version: 1.0.1.2
version: 1.0.2
license: MIT
license-file: LICENSE
author: Uwe Schmidt, Sebastian Philipp
Expand Down Expand Up @@ -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