From 7879be070cd0f5f1eb076f6addc7a210bfdd50b0 Mon Sep 17 00:00:00 2001
From: Matthew Leon <ml@matthewleon.com>
Date: Tue, 6 Jun 2017 10:22:31 +0100
Subject: [PATCH] stack-safe fromFoldable

with benchmarks that reflect no performance degradation

addresses #108
---
 bench/Bench/Data/Map.purs    | 24 +++++++++++++++++++++++-
 bench/Bench/Data/StrMap.purs | 27 +++++++++++++++++++++++++++
 bench/Bench/Main.purs        | 17 ++++++++++++++---
 src/Data/StrMap.purs         |  8 ++++----
 4 files changed, 68 insertions(+), 8 deletions(-)
 create mode 100644 bench/Bench/Data/StrMap.purs

diff --git a/bench/Bench/Data/Map.purs b/bench/Bench/Data/Map.purs
index a92d014a..a2197fc7 100644
--- a/bench/Bench/Data/Map.purs
+++ b/bench/Bench/Data/Map.purs
@@ -10,8 +10,19 @@ import Data.List as L
 import Data.Map as M
 
 benchMap :: Eff (console :: CONSOLE) Unit
-benchMap = benchSize
+benchMap = do
+  log "size"
+  log "---------------"
+  benchSize
+
+  log ""
+
+  log "fromFoldable"
+  log "------------"
+  benchFromFoldable
+
   where
+
   benchSize = do
     let nats = L.range 0 999999
         natPairs = (flip Tuple) unit <$> nats
@@ -31,3 +42,14 @@ benchMap = benchSize
 
     log $ "size: big map (" <> show (M.size bigMap) <> ")"
     benchWith 10  \_ -> M.size bigMap
+
+  benchFromFoldable = do
+    let natStrs = show <$> L.range 0 99999
+        natPairs = (flip Tuple) unit <$> natStrs
+        shortPairList = L.take 10000 natPairs
+
+    log $ "fromFoldable (" <> show (L.length shortPairList) <> ")"
+    benchWith 100 \_ -> M.fromFoldable shortPairList
+
+    log $ "fromFoldable (" <> show (L.length natPairs) <> ")"
+    benchWith 10 \_ -> M.fromFoldable natPairs
diff --git a/bench/Bench/Data/StrMap.purs b/bench/Bench/Data/StrMap.purs
new file mode 100644
index 00000000..1c7f419a
--- /dev/null
+++ b/bench/Bench/Data/StrMap.purs
@@ -0,0 +1,27 @@
+module Bench.Data.StrMap where
+
+import Prelude
+import Control.Monad.Eff (Eff)
+import Control.Monad.Eff.Console (CONSOLE, log)
+import Performance.Minibench (benchWith)
+
+import Data.Tuple (Tuple(..))
+import Data.List as L
+import Data.StrMap as M
+
+benchStrMap :: Eff (console :: CONSOLE) Unit
+benchStrMap = do
+  log "fromFoldable"
+  benchFromFoldable
+
+  where
+  benchFromFoldable = do
+    let natStrs = show <$> L.range 0 99999
+        natPairs = (flip Tuple) unit <$> natStrs
+        shortPairList = L.take 10000 natPairs
+
+    log $ "fromFoldable (" <> show (L.length shortPairList) <> ")"
+    benchWith 100 \_ -> M.fromFoldable shortPairList
+
+    log $ "fromFoldable (" <> show (L.length natPairs) <> ")"
+    benchWith 10 \_ -> M.fromFoldable natPairs
diff --git a/bench/Bench/Main.purs b/bench/Bench/Main.purs
index be3c4332..f8f641b0 100644
--- a/bench/Bench/Main.purs
+++ b/bench/Bench/Main.purs
@@ -1,10 +1,21 @@
 module Bench.Main where
 
+import Prelude
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Console (CONSOLE)
-import Data.Unit (Unit)
+import Control.Monad.Eff.Console (CONSOLE, log)
 
 import Bench.Data.Map (benchMap)
+import Bench.Data.StrMap (benchStrMap)
 
 main :: Eff (console :: CONSOLE) Unit
-main = benchMap
+main = do
+  log "Map"
+  log "==="
+  benchMap
+
+  log ""
+
+
+  log "StrMap"
+  log "======"
+  benchStrMap
diff --git a/src/Data/StrMap.purs b/src/Data/StrMap.purs
index e5c0b798..b5c2727c 100644
--- a/src/Data/StrMap.purs
+++ b/src/Data/StrMap.purs
@@ -43,7 +43,7 @@ module Data.StrMap
 
 import Prelude
 
-import Control.Monad.Eff (Eff, runPure)
+import Control.Monad.Eff (Eff, runPure, foreachE)
 import Control.Monad.ST as ST
 
 import Data.Array as A
@@ -204,10 +204,10 @@ update f k m = alter (maybe Nothing f) k m
 
 -- | Create a map from a foldable collection of key/value pairs
 fromFoldable :: forall f a. Foldable f => f (Tuple String a) -> StrMap a
-fromFoldable l = pureST (do
+fromFoldable l = pureST do
   s <- SM.new
-  for_ l (\(Tuple k v) -> SM.poke s k v)
-  pure s)
+  foreachE (A.fromFoldable l) \(Tuple k v) -> void (SM.poke s k v)
+  pure s
 
 foreign import _lookupST :: forall a h r z. Fn4 z (a -> z) String (SM.STStrMap h a) (Eff (st :: ST.ST h | r) z)