diff --git a/bench/Bench/Data/List.purs b/bench/Bench/Data/List.purs new file mode 100644 index 0000000..e232f49 --- /dev/null +++ b/bench/Bench/Data/List.purs @@ -0,0 +1,48 @@ +module Bench.Data.List where + +import Prelude +import Effect (Effect) +import Effect.Console (log) +import Performance.Minibench (bench) + +import Data.List as L + +benchList :: Effect 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..7fa5459 --- /dev/null +++ b/bench/Main.purs @@ -0,0 +1,13 @@ +module Bench.Main where + +import Prelude +import Effect (Effect) +import Effect.Console (log) + +import Bench.Data.List (benchList) + +main :: Effect Unit +main = do + log "List" + log "====" + benchList diff --git a/bower.json b/bower.json index efc9e90..d22f398 100644 --- a/bower.json +++ b/bower.json @@ -36,6 +36,7 @@ "purescript-arrays": "^5.0.0", "purescript-assert": "^4.0.0", "purescript-console": "^4.0.0", - "purescript-math": "^2.1.1" + "purescript-math": "^2.1.1", + "purescript-minibench": "^2.0.0" } } diff --git a/package.json b/package.json index 6b258fe..1d8559c 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 --check-main-type Effect.Effect" + "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": "^12.2.0", diff --git a/src/Data/List/Types.purs b/src/Data/List/Types.purs index cfafbf6..acd5aa1 100644 --- a/src/Data/List/Types.purs +++ b/src/Data/List/Types.purs @@ -1,4 +1,10 @@ -module Data.List.Types where +module Data.List.Types + ( List(..) + , (:) + , NonEmptyList(..) + , toList + , nelCons + ) where import Prelude @@ -67,7 +73,29 @@ 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 = 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 + 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 = + reverseUnrolledMap cs (f x1 : f x2 : f x3 : acc) + reverseUnrolledMap _ acc = acc instance functorWithIndexList :: FunctorWithIndex Int List where mapWithIndex f = foldrWithIndex (\i x acc -> f i x : acc) Nil diff --git a/test/Test/Data/List.purs b/test/Test/Data/List.purs index f725ed5..764196d 100644 --- a/test/Test/Data/List.purs +++ b/test/Test/Data/List.purs @@ -364,6 +364,12 @@ testList = do log "map should maintain order" assert $ (1..5) == map identity (1..5) + log "map should be stack-safe" + void $ pure $ map identity (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]])