Fold directly

bench/Bench/Data/Map.purs

@@ -1,13 +1,15 @@
 module Bench.Data.Map where
 
 import Prelude
+
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, log)
-import Performance.Minibench (bench, benchWith)
-
-import Data.Tuple (Tuple(..))
+import Data.Foldable (foldl, foldr)
+import Data.List (zipWith)
 import Data.List as L
 import Data.Map as M
+import Data.Tuple (Tuple(..))
+import Performance.Minibench (bench, benchWith)
 
 benchMap :: Eff (console :: CONSOLE) Unit
 benchMap = do
@@ -21,15 +23,26 @@ benchMap = do
   log "------------"
   benchFromFoldable
 
+  log ""
+
+  log "foldl"
+  log "------------"
+  benchFoldl
+
+  log "foldr"
+  log "------------"
+  benchFoldr
+
   where
 
+  nats = L.range 0 999999
+  natPairs = zipWith Tuple nats nats
+  singletonMap = M.singleton 0 0
+  smallMap = M.fromFoldable $ L.take 100 natPairs
+  midMap = M.fromFoldable $ L.take 10000 natPairs
+  bigMap = M.fromFoldable $ natPairs
+
   benchSize = do
-    let nats = L.range 0 999999
-        natPairs = (flip Tuple) unit <$> nats
-        singletonMap = M.singleton 0 unit
-        smallMap = M.fromFoldable $ L.take 100 natPairs
-        midMap = M.fromFoldable $ L.take 10000 natPairs
-        bigMap = M.fromFoldable $ natPairs
 
     log "size: singleton map"
     bench \_ -> M.size singletonMap
@@ -53,3 +66,33 @@ benchMap = do
 
     log $ "fromFoldable (" <> show (L.length natPairs) <> ")"
     benchWith 10 \_ -> M.fromFoldable natPairs
+
+  benchFoldl = do
+    let sum = foldl (+) 0
+
+    log "foldl: singleton map"
+    bench \_ -> sum singletonMap
+
+    log $ "foldl: small map (" <> show (M.size smallMap) <> ")"
+    bench \_ -> sum smallMap
+
+    log $ "foldl: midsize map (" <> show (M.size midMap) <> ")"
+    benchWith 100 \_ -> sum midMap
+
+    log $ "foldl: big map (" <> show (M.size bigMap) <> ")"
+    benchWith 10  \_ -> sum bigMap
+
+  benchFoldr = do
+    let sum = foldr (+) 0
+
+    log "foldr: singleton map"
+    bench \_ -> sum singletonMap
+
+    log $ "foldr: small map (" <> show (M.size smallMap) <> ")"
+    bench \_ -> sum smallMap
+
+    log $ "foldr: midsize map (" <> show (M.size midMap) <> ")"
+    benchWith 100 \_ -> sum midMap
+
+    log $ "foldr: big map (" <> show (M.size bigMap) <> ")"
+    benchWith 10  \_ -> sum bigMap

package.json

@@ -6,7 +6,7 @@
     "test": "pulp test",
 
     "bench:build": "purs compile 'bench/**/*.purs' 'src/**/*.purs' 'bower_components/*/src/**/*.purs'",
-    "bench:run": "node -e 'require(\"./output/Bench.Main/index.js\").main()'",
+    "bench:run": "node --expose-gc -e 'require(\"./output/Bench.Main/index.js\").main()'",
     "bench": "npm run bench:build && npm run bench:run"
   },
   "devDependencies": {

src/Data/Map.purs

@@ -43,8 +43,8 @@ module Data.Map
 import Prelude
 
 import Data.Eq (class Eq1)
-import Data.Foldable (foldl, foldMap, foldr, class Foldable)
-import Data.FoldableWithIndex (class FoldableWithIndex)
+import Data.Foldable (foldl, foldr, foldMapDefaultL, class Foldable)
+import Data.FoldableWithIndex (class FoldableWithIndex, foldlWithIndex, foldrWithIndex, foldMapWithIndexDefaultL)
 import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex)
 import Data.List (List(..), (:), length, nub)
 import Data.List.Lazy as LL
@@ -99,14 +99,26 @@ instance functorWithIndexMap :: FunctorWithIndex k (Map k) where
   mapWithIndex f (Three left k1 v1 mid k2 v2 right) = Three (mapWithIndex f left) k1 (f k1 v1) (mapWithIndex f mid) k2 (f k2 v2) (mapWithIndex f right)
 
 instance foldableMap :: Foldable (Map k) where
-  foldl   f z m = foldl   f z (values m)
-  foldr   f z m = foldr   f z (values m)
-  foldMap f   m = foldMap f   (values m)
+  foldl f = foldlWithIndex (const f)
+  foldr f = foldrWithIndex (const f)
+  foldMap = foldMapDefaultL
 
 instance foldableWithIndexMap :: FoldableWithIndex k (Map k) where
-  foldlWithIndex f z m = foldl (uncurry <<< (flip f)) z $ asList $ toUnfoldable m
+  foldlWithIndex f z m = go z (m : Nil)
+    where
+    go acc Nil = acc
+    go acc (hd : tl) = case hd of
+      Leaf -> go acc tl
+      Two Leaf k v Leaf ->
+        go (f k acc v) tl
+      Two Leaf k v right ->
+        go (f k acc v) (right : tl)
+      Two left k v right ->
+        go acc (left : singleton k v : right : tl)
+      Three left k1 v1 mid k2 v2 right ->
+        go acc (left : singleton k1 v1 : mid : singleton k2 v2 : right : tl)
   foldrWithIndex f z m = foldr (uncurry f) z $ asList $ toUnfoldable m
-  foldMapWithIndex f m = foldMap (uncurry f) $ asList $ toUnfoldable m
+  foldMapWithIndex = foldMapWithIndexDefaultL
 
 asList :: forall k v. List (Tuple k v) -> List (Tuple k v)
 asList = id