From 8d3f8e52a461af2037e40fea314514a81476fc57 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Tue, 21 Nov 2017 09:38:47 -0500 Subject: [PATCH 01/13] initial benchmarks for List.map MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 2017 MacBook Pro 2.3 GHz Intel Core i5, 8 GB 2133 MHz LPDDR3 Node v8.9.1 List ==== map --- map: empty list mean = 1.31 μs stddev = 11.87 μs min = 799.00 ns max = 375.82 μs map: singleton list mean = 2.40 μs stddev = 11.03 μs min = 1.03 μs max = 342.18 μs map: list (1000 elems) mean = 143.41 μs stddev = 225.12 μs min = 97.16 μs max = 2.03 ms map: list (2000 elems) mean = 274.16 μs stddev = 295.84 μs min = 199.66 μs max = 2.06 ms map: list (5000 elems) mean = 531.84 μs stddev = 512.61 μs min = 229.45 μs max = 2.95 ms map: list (10000 elems) mean = 895.24 μs stddev = 777.87 μs min = 464.59 μs max = 2.94 ms map: list (100000 elems) mean = 33.45 ms stddev = 7.65 ms min = 22.07 ms max = 63.47 ms --- bench/Bench/Data/List.purs | 48 ++++++++++++++++++++++++++++++++++++++ bench/Main.purs | 13 +++++++++++ bower.json | 3 ++- package.json | 6 ++++- 4 files changed, 68 insertions(+), 2 deletions(-) create mode 100644 bench/Bench/Data/List.purs create mode 100644 bench/Main.purs diff --git a/bench/Bench/Data/List.purs b/bench/Bench/Data/List.purs new file mode 100644 index 0000000..d496d6c --- /dev/null +++ b/bench/Bench/Data/List.purs @@ -0,0 +1,48 @@ +module Bench.Data.List where + +import Prelude +import Control.Monad.Eff (Eff) +import Control.Monad.Eff.Console (CONSOLE, log) +import Performance.Minibench (bench) + +import Data.List as L + +benchList :: Eff (console :: CONSOLE) Unit +benchList = do + log "map" + log "---" + benchMap + + where + + benchMap = do + let nats = L.range 0 999999 + mapFn = map (_ + 1) + list1000 = L.take 1000 nats + list2000 = L.take 2000 nats + list5000 = L.take 5000 nats + list10000 = L.take 10000 nats + list100000 = L.take 100000 nats + + log "map: empty list" + let emptyList = L.Nil + bench \_ -> mapFn emptyList + + log "map: singleton list" + let singletonList = L.Cons 0 L.Nil + bench \_ -> mapFn singletonList + + log $ "map: list (" <> show (L.length list1000) <> " elems)" + bench \_ -> mapFn list1000 + + log $ "map: list (" <> show (L.length list2000) <> " elems)" + bench \_ -> mapFn list2000 + + log $ "map: list (" <> show (L.length list5000) <> " elems)" + bench \_ -> mapFn list5000 + + log $ "map: list (" <> show (L.length list10000) <> " elems)" + bench \_ -> mapFn list10000 + + log $ "map: list (" <> show (L.length list100000) <> " elems)" + bench \_ -> mapFn list100000 diff --git a/bench/Main.purs b/bench/Main.purs new file mode 100644 index 0000000..1cc93cf --- /dev/null +++ b/bench/Main.purs @@ -0,0 +1,13 @@ +module Bench.Main where + +import Prelude +import Control.Monad.Eff (Eff) +import Control.Monad.Eff.Console (CONSOLE, log) + +import Bench.Data.List (benchList) + +main :: Eff (console :: CONSOLE) Unit +main = do + log "List" + log "====" + benchList diff --git a/bower.json b/bower.json index 157b396..d960b08 100644 --- a/bower.json +++ b/bower.json @@ -31,6 +31,7 @@ "purescript-arrays": "^4.0.0", "purescript-assert": "^3.0.0", "purescript-console": "^3.0.0", - "purescript-math": "^2.0.0" + "purescript-math": "^2.0.0", + "purescript-minibench": "matthewleon/purescript-minibench#gc" } } diff --git a/package.json b/package.json index f1deb35..d3e806f 100644 --- a/package.json +++ b/package.json @@ -3,7 +3,11 @@ "scripts": { "clean": "rimraf output && rimraf .pulp-cache", "build": "pulp build -- --censor-lib --strict", - "test": "pulp test" + "test": "pulp test", + + "bench:build": "purs compile 'bench/**/*.purs' 'src/**/*.purs' 'bower_components/*/src/**/*.purs'", + "bench:run": "node --expose-gc -e 'require(\"./output/Bench.Main/index.js\").main()'", + "bench": "npm run bench:build && npm run bench:run" }, "devDependencies": { "pulp": "^11.0.0", From 39bb1c3c86bdfc5613f47f9c7be6f746ddbcce3b Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Tue, 21 Nov 2017 09:24:10 -0500 Subject: [PATCH 02/13] List Functor: mix unrolled and reverse map MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Addresses #131 The relevant chunk sizes (5 for the initial list segment), (3 for the tail-recursive remainder) were arrived at through benchmarked experimentation, mapping a simple (_ + 1) through lists of various sizes. Relevant figures: list of 1000 elems: 142.61 μs -> 36.97 μs list of 2000 elems: 275.17 μs -> 55.33 μs list of 10000 elems: 912.73 μs -> 208.39 μs list of 100000 elems: 34.56 ms -> 1.24 ms The ~30x speed increase for long lists is probably explained by the lack of GC thrashing with this approach. Benchmarked on 2017 Macbook Pro, 2.3 GHz Intel Core i5, 8 GB RAM. macOS Sierra 10.12.6 node v8.9.1 --- src/Data/List/Types.purs | 48 ++++++++++++++++++++++++++++++++++++++-- 1 file changed, 46 insertions(+), 2 deletions(-) diff --git a/src/Data/List/Types.purs b/src/Data/List/Types.purs index aba3c06..bbfd85a 100644 --- a/src/Data/List/Types.purs +++ b/src/Data/List/Types.purs @@ -1,4 +1,8 @@ -module Data.List.Types where +module Data.List.Types + ( List(..) + , (:) + , NonEmptyList(..) + ) where import Prelude @@ -67,7 +71,47 @@ instance monoidList :: Monoid (List a) where mempty = Nil instance functorList :: Functor List where - map f = foldr (\x acc -> f x : acc) Nil + map = listMap + +-- chunked list Functor inspired by OCaml +-- https://discuss.ocaml.org/t/a-new-list-map-that-is-both-stack-safe-and-fast/865 +-- chunk sizes determined through experimentation +listMap :: forall a b. (a -> b) -> List a -> List b +listMap f = startUnrolledMap unrollLimit + where + -- iterate the unrolled map up to 1000 times, + -- which hits up to 5000 elements + unrollLimit = 1000 + + startUnrolledMap :: Int -> List a -> List b + startUnrolledMap 0 (x : xs) = f x : chunkedRevMap xs + startUnrolledMap n (x1 : x2 : x3 : x4 : x5 : xs) = + f x1 : f x2 : f x3 : f x4 : f x5 : startUnrolledMap (n - 1) xs + startUnrolledMap n (x1 : x2 : x3 : x4 : xs) = + f x1 : f x2 : f x3 : f x4 : startUnrolledMap (n - 1) xs + startUnrolledMap n (x1 : x2 : x3 : xs) = + f x1 : f x2 : f x3 : startUnrolledMap (n - 1) xs + startUnrolledMap n (x1 : x2 : xs) = + f x1 : f x2 : startUnrolledMap (n - 1) xs + startUnrolledMap n (x : xs) = f x : startUnrolledMap (n - 1) xs + + startUnrolledMap _ Nil = Nil + + chunkedRevMap :: List a -> List b + chunkedRevMap = go Nil + where + go :: List (List a) -> List a -> List b + go chunksAcc chunk@(x1 : x2 : x3 : x4 : x5 : xs) = + go (chunk : chunksAcc) xs + go chunksAcc finalChunk = + reverseUnrolledMap chunksAcc $ startUnrolledMap 0 finalChunk + + reverseUnrolledMap :: List (List a) -> List b -> List b + reverseUnrolledMap ((x1 : x2 : x3 : _) : cs) acc = + reverseUnrolledMap cs (f x1 : f x2 : f x3 : acc) + -- if we pattern match on Nil, we need a Partial constraint, + -- which kills TCO + reverseUnrolledMap _ acc = acc instance functorWithIndexList :: FunctorWithIndex Int List where mapWithIndex f = foldrWithIndex (\i x acc -> f i x : acc) Nil From 87c5a16deb418d1d97e687f46f8f73ea6e365300 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Wed, 29 Nov 2017 23:32:35 -0500 Subject: [PATCH 03/13] style tweak --- src/Data/List/Types.purs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Data/List/Types.purs b/src/Data/List/Types.purs index bbfd85a..5a6ee4a 100644 --- a/src/Data/List/Types.purs +++ b/src/Data/List/Types.purs @@ -77,8 +77,7 @@ instance functorList :: Functor List where -- https://discuss.ocaml.org/t/a-new-list-map-that-is-both-stack-safe-and-fast/865 -- chunk sizes determined through experimentation listMap :: forall a b. (a -> b) -> List a -> List b -listMap f = startUnrolledMap unrollLimit - where +listMap f = startUnrolledMap unrollLimit where -- iterate the unrolled map up to 1000 times, -- which hits up to 5000 elements unrollLimit = 1000 From 677342a04f5eacf22b0c8b18b83ea1865724ba68 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Thu, 30 Nov 2017 15:38:45 -0500 Subject: [PATCH 04/13] test stack-safety of strict map --- test/Test/Data/List.purs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/test/Test/Data/List.purs b/test/Test/Data/List.purs index f2130f3..3bfb695 100644 --- a/test/Test/Data/List.purs +++ b/test/Test/Data/List.purs @@ -360,6 +360,9 @@ testList = do log "map should maintain order" assert $ (1..5) == map id (1..5) + log "map should be stack-safe" + void $ pure $ map id (1..100000) + log "transpose" assert $ transpose (l [l [1,2,3], l[4,5,6], l [7,8,9]]) == (l [l [1,4,7], l[2,5,8], l [3,6,9]]) From bc5d4aa48ab4881e80625aeb5f19d2113c5980eb Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Thu, 30 Nov 2017 15:40:08 -0500 Subject: [PATCH 05/13] lower unrolled map iteration limit this lower the probability of stack-size troubles --- src/Data/List/Types.purs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Data/List/Types.purs b/src/Data/List/Types.purs index 5a6ee4a..d7d10c2 100644 --- a/src/Data/List/Types.purs +++ b/src/Data/List/Types.purs @@ -78,9 +78,9 @@ instance functorList :: Functor List where -- chunk sizes determined through experimentation listMap :: forall a b. (a -> b) -> List a -> List b listMap f = startUnrolledMap unrollLimit where - -- iterate the unrolled map up to 1000 times, - -- which hits up to 5000 elements - unrollLimit = 1000 + -- iterate the unrolled map up to 200 times, + -- which hits up to 1000 elements + unrollLimit = 200 startUnrolledMap :: Int -> List a -> List b startUnrolledMap 0 (x : xs) = f x : chunkedRevMap xs From cadf4812275cfad566de8692951ec7f9159c8e70 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Thu, 30 Nov 2017 15:45:27 -0500 Subject: [PATCH 06/13] restore un-exported functions from Data.List.Types --- bower.json | 2 +- src/Data/List/Types.purs | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/bower.json b/bower.json index d960b08..ece36f6 100644 --- a/bower.json +++ b/bower.json @@ -32,6 +32,6 @@ "purescript-assert": "^3.0.0", "purescript-console": "^3.0.0", "purescript-math": "^2.0.0", - "purescript-minibench": "matthewleon/purescript-minibench#gc" + "purescript-minibench": "^1.0.1" } } diff --git a/src/Data/List/Types.purs b/src/Data/List/Types.purs index d7d10c2..83abfda 100644 --- a/src/Data/List/Types.purs +++ b/src/Data/List/Types.purs @@ -2,6 +2,8 @@ module Data.List.Types ( List(..) , (:) , NonEmptyList(..) + , toList + , nelCons ) where import Prelude From 4fbe0ca6bccb06f72f00d1b31a643b7de1f0e904 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Mon, 11 Dec 2017 20:46:20 -0500 Subject: [PATCH 07/13] add failing map test --- test/Test/Data/List.purs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/test/Test/Data/List.purs b/test/Test/Data/List.purs index 3bfb695..2d49277 100644 --- a/test/Test/Data/List.purs +++ b/test/Test/Data/List.purs @@ -363,6 +363,9 @@ testList = do log "map should be stack-safe" void $ pure $ map id (1..100000) + log "map should be correct" + assert $ (1..1000000) == map (_ + 1) (0..999999) + log "transpose" assert $ transpose (l [l [1,2,3], l[4,5,6], l [7,8,9]]) == (l [l [1,4,7], l[2,5,8], l [3,6,9]]) From e51052007c95e250ee8143c34d26738fe9b201c8 Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Mon, 11 Dec 2017 20:47:51 -0500 Subject: [PATCH 08/13] fix a logic error in List.map chunkedRevMap --- src/Data/List/Types.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/List/Types.purs b/src/Data/List/Types.purs index 83abfda..6657eb5 100644 --- a/src/Data/List/Types.purs +++ b/src/Data/List/Types.purs @@ -102,7 +102,7 @@ listMap f = startUnrolledMap unrollLimit where chunkedRevMap = go Nil where go :: List (List a) -> List a -> List b - go chunksAcc chunk@(x1 : x2 : x3 : x4 : x5 : xs) = + go chunksAcc chunk@(x1 : x2 : x3 : xs) = go (chunk : chunksAcc) xs go chunksAcc finalChunk = reverseUnrolledMap chunksAcc $ startUnrolledMap 0 finalChunk From 5e653a9c294cd7ddeb26b1cb8d6b8c55517d39ea Mon Sep 17 00:00:00 2001 From: Matthew Leon Date: Mon, 11 Dec 2017 20:57:21 -0500 Subject: [PATCH 09/13] make map stack safe(r) again begin with reverse unrolled map --- src/Data/List/Types.purs | 37 +++++++++++-------------------------- 1 file changed, 11 insertions(+), 26 deletions(-) diff --git a/src/Data/List/Types.purs b/src/Data/List/Types.purs index 6657eb5..e217f92 100644 --- a/src/Data/List/Types.purs +++ b/src/Data/List/Types.purs @@ -79,33 +79,18 @@ instance functorList :: Functor List where -- https://discuss.ocaml.org/t/a-new-list-map-that-is-both-stack-safe-and-fast/865 -- chunk sizes determined through experimentation listMap :: forall a b. (a -> b) -> List a -> List b -listMap f = startUnrolledMap unrollLimit where - -- iterate the unrolled map up to 200 times, - -- which hits up to 1000 elements - unrollLimit = 200 - - startUnrolledMap :: Int -> List a -> List b - startUnrolledMap 0 (x : xs) = f x : chunkedRevMap xs - startUnrolledMap n (x1 : x2 : x3 : x4 : x5 : xs) = - f x1 : f x2 : f x3 : f x4 : f x5 : startUnrolledMap (n - 1) xs - startUnrolledMap n (x1 : x2 : x3 : x4 : xs) = - f x1 : f x2 : f x3 : f x4 : startUnrolledMap (n - 1) xs - startUnrolledMap n (x1 : x2 : x3 : xs) = - f x1 : f x2 : f x3 : startUnrolledMap (n - 1) xs - startUnrolledMap n (x1 : x2 : xs) = - f x1 : f x2 : startUnrolledMap (n - 1) xs - startUnrolledMap n (x : xs) = f x : startUnrolledMap (n - 1) xs - - startUnrolledMap _ Nil = Nil - - chunkedRevMap :: List a -> List b - chunkedRevMap = go Nil +listMap f = chunkedRevMap Nil + where + chunkedRevMap :: List (List a) -> List a -> List b + chunkedRevMap chunksAcc chunk@(x1 : x2 : x3 : xs) = + chunkedRevMap (chunk : chunksAcc) xs + chunkedRevMap chunksAcc xs = + reverseUnrolledMap chunksAcc $ unrolledMap xs where - go :: List (List a) -> List a -> List b - go chunksAcc chunk@(x1 : x2 : x3 : xs) = - go (chunk : chunksAcc) xs - go chunksAcc finalChunk = - reverseUnrolledMap chunksAcc $ startUnrolledMap 0 finalChunk + unrolledMap :: List a -> List b + unrolledMap (x1 : x2 : Nil) = f x1 : f x2 : Nil + unrolledMap (x1 : Nil) = f x1 : Nil + unrolledMap _ = Nil reverseUnrolledMap :: List (List a) -> List b -> List b reverseUnrolledMap ((x1 : x2 : x3 : _) : cs) acc = From 1eccc99ca8f4d616f0603048a7ca676b6937d2b6 Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Sun, 10 Mar 2019 16:04:50 +0000 Subject: [PATCH 10/13] Update for 0.12 id -> identity --- test/Test/Data/List.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Test/Data/List.purs b/test/Test/Data/List.purs index bdabd27..764196d 100644 --- a/test/Test/Data/List.purs +++ b/test/Test/Data/List.purs @@ -365,7 +365,7 @@ testList = do assert $ (1..5) == map identity (1..5) log "map should be stack-safe" - void $ pure $ map id (1..100000) + void $ pure $ map identity (1..100000) log "map should be correct" assert $ (1..1000000) == map (_ + 1) (0..999999) From fd34c637a105ab3a9fb8ab60c2d873234d2889b3 Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Sun, 10 Mar 2019 16:07:42 +0000 Subject: [PATCH 11/13] Update benchmark code for 0.12 --- bench/Bench/Data/List.purs | 6 +++--- bench/Main.purs | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/bench/Bench/Data/List.purs b/bench/Bench/Data/List.purs index d496d6c..e232f49 100644 --- a/bench/Bench/Data/List.purs +++ b/bench/Bench/Data/List.purs @@ -1,13 +1,13 @@ module Bench.Data.List where import Prelude -import Control.Monad.Eff (Eff) -import Control.Monad.Eff.Console (CONSOLE, log) +import Effect (Effect) +import Effect.Console (log) import Performance.Minibench (bench) import Data.List as L -benchList :: Eff (console :: CONSOLE) Unit +benchList :: Effect Unit benchList = do log "map" log "---" diff --git a/bench/Main.purs b/bench/Main.purs index 1cc93cf..7fa5459 100644 --- a/bench/Main.purs +++ b/bench/Main.purs @@ -1,12 +1,12 @@ module Bench.Main where import Prelude -import Control.Monad.Eff (Eff) -import Control.Monad.Eff.Console (CONSOLE, log) +import Effect (Effect) +import Effect.Console (log) import Bench.Data.List (benchList) -main :: Eff (console :: CONSOLE) Unit +main :: Effect Unit main = do log "List" log "====" From 6cc565289ac259e1e38beaf37b222daafafe5b46 Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Sun, 10 Mar 2019 16:15:49 +0000 Subject: [PATCH 12/13] Remove outdated comment --- src/Data/List/Types.purs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/Data/List/Types.purs b/src/Data/List/Types.purs index 64fd810..33fc9cb 100644 --- a/src/Data/List/Types.purs +++ b/src/Data/List/Types.purs @@ -95,9 +95,7 @@ listMap f = chunkedRevMap Nil reverseUnrolledMap :: List (List a) -> List b -> List b reverseUnrolledMap ((x1 : x2 : x3 : _) : cs) acc = reverseUnrolledMap cs (f x1 : f x2 : f x3 : acc) - -- if we pattern match on Nil, we need a Partial constraint, - -- which kills TCO - reverseUnrolledMap _ acc = acc + reverseUnrolledMap _ Nil = Nil instance functorWithIndexList :: FunctorWithIndex Int List where mapWithIndex f = foldrWithIndex (\i x acc -> f i x : acc) Nil From ffa70bac978afb36ee337ec4cc99c51331679b03 Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Sun, 10 Mar 2019 16:18:32 +0000 Subject: [PATCH 13/13] :man_facepalming: --- src/Data/List/Types.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/List/Types.purs b/src/Data/List/Types.purs index 33fc9cb..acd5aa1 100644 --- a/src/Data/List/Types.purs +++ b/src/Data/List/Types.purs @@ -95,7 +95,7 @@ listMap f = chunkedRevMap Nil reverseUnrolledMap :: List (List a) -> List b -> List b reverseUnrolledMap ((x1 : x2 : x3 : _) : cs) acc = reverseUnrolledMap cs (f x1 : f x2 : f x3 : acc) - reverseUnrolledMap _ Nil = Nil + reverseUnrolledMap _ acc = acc instance functorWithIndexList :: FunctorWithIndex Int List where mapWithIndex f = foldrWithIndex (\i x acc -> f i x : acc) Nil