Skip to content
This repository was archived by the owner on Oct 4, 2020. It is now read-only.

Commit 9365860

Browse files
matthewleonpaf31
authored andcommitted
stack-safe fromFoldable (#110)
with benchmarks that reflect no performance degradation addresses #108
1 parent 92ac171 commit 9365860

File tree

4 files changed

+68
-8
lines changed

4 files changed

+68
-8
lines changed

bench/Bench/Data/Map.purs

+23-1
Original file line numberDiff line numberDiff line change
@@ -10,8 +10,19 @@ import Data.List as L
1010
import Data.Map as M
1111

1212
benchMap :: Eff (console :: CONSOLE) Unit
13-
benchMap = benchSize
13+
benchMap = do
14+
log "size"
15+
log "---------------"
16+
benchSize
17+
18+
log ""
19+
20+
log "fromFoldable"
21+
log "------------"
22+
benchFromFoldable
23+
1424
where
25+
1526
benchSize = do
1627
let nats = L.range 0 999999
1728
natPairs = (flip Tuple) unit <$> nats
@@ -31,3 +42,14 @@ benchMap = benchSize
3142

3243
log $ "size: big map (" <> show (M.size bigMap) <> ")"
3344
benchWith 10 \_ -> M.size bigMap
45+
46+
benchFromFoldable = do
47+
let natStrs = show <$> L.range 0 99999
48+
natPairs = (flip Tuple) unit <$> natStrs
49+
shortPairList = L.take 10000 natPairs
50+
51+
log $ "fromFoldable (" <> show (L.length shortPairList) <> ")"
52+
benchWith 100 \_ -> M.fromFoldable shortPairList
53+
54+
log $ "fromFoldable (" <> show (L.length natPairs) <> ")"
55+
benchWith 10 \_ -> M.fromFoldable natPairs

bench/Bench/Data/StrMap.purs

+27
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
module Bench.Data.StrMap where
2+
3+
import Prelude
4+
import Control.Monad.Eff (Eff)
5+
import Control.Monad.Eff.Console (CONSOLE, log)
6+
import Performance.Minibench (benchWith)
7+
8+
import Data.Tuple (Tuple(..))
9+
import Data.List as L
10+
import Data.StrMap as M
11+
12+
benchStrMap :: Eff (console :: CONSOLE) Unit
13+
benchStrMap = do
14+
log "fromFoldable"
15+
benchFromFoldable
16+
17+
where
18+
benchFromFoldable = do
19+
let natStrs = show <$> L.range 0 99999
20+
natPairs = (flip Tuple) unit <$> natStrs
21+
shortPairList = L.take 10000 natPairs
22+
23+
log $ "fromFoldable (" <> show (L.length shortPairList) <> ")"
24+
benchWith 100 \_ -> M.fromFoldable shortPairList
25+
26+
log $ "fromFoldable (" <> show (L.length natPairs) <> ")"
27+
benchWith 10 \_ -> M.fromFoldable natPairs

bench/Bench/Main.purs

+14-3
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,21 @@
11
module Bench.Main where
22

3+
import Prelude
34
import Control.Monad.Eff (Eff)
4-
import Control.Monad.Eff.Console (CONSOLE)
5-
import Data.Unit (Unit)
5+
import Control.Monad.Eff.Console (CONSOLE, log)
66

77
import Bench.Data.Map (benchMap)
8+
import Bench.Data.StrMap (benchStrMap)
89

910
main :: Eff (console :: CONSOLE) Unit
10-
main = benchMap
11+
main = do
12+
log "Map"
13+
log "==="
14+
benchMap
15+
16+
log ""
17+
18+
19+
log "StrMap"
20+
log "======"
21+
benchStrMap

src/Data/StrMap.purs

+4-4
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,7 @@ module Data.StrMap
4343

4444
import Prelude
4545

46-
import Control.Monad.Eff (Eff, runPure)
46+
import Control.Monad.Eff (Eff, runPure, foreachE)
4747
import Control.Monad.ST as ST
4848

4949
import Data.Array as A
@@ -204,10 +204,10 @@ update f k m = alter (maybe Nothing f) k m
204204

205205
-- | Create a map from a foldable collection of key/value pairs
206206
fromFoldable :: forall f a. Foldable f => f (Tuple String a) -> StrMap a
207-
fromFoldable l = pureST (do
207+
fromFoldable l = pureST do
208208
s <- SM.new
209-
for_ l (\(Tuple k v) -> SM.poke s k v)
210-
pure s)
209+
foreachE (A.fromFoldable l) \(Tuple k v) -> void (SM.poke s k v)
210+
pure s
211211

212212
foreign import _lookupST :: forall a h r z. Fn4 z (a -> z) String (SM.STStrMap h a) (Eff (st :: ST.ST h | r) z)
213213

0 commit comments

Comments
 (0)