List Functor: mix unrolled and reverse map

Addresses purescript#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.

Author: matthewleon

src/Data/List/Types.purs

@@ -10,7 +10,6 @@ import Control.Extend (class Extend)
 import Control.MonadPlus (class MonadPlus)
 import Control.MonadZero (class MonadZero)
 import Control.Plus (class Plus)
-
 import Data.Eq (class Eq1, eq1)
 import Data.Foldable (class Foldable, foldl, foldr, intercalate)
 import Data.Maybe (Maybe(..))
@@ -65,7 +64,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 naiveMapLimit
+  where
+  -- iterate the naive unrolled map up to 1000 times,
+  -- which hits up to 5000 elements
+  naiveMapLimit = 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 foldableList :: Foldable List where
   foldr f b = foldl (flip f) b <<< rev Nil