From 000c1e636b033c57fc070d323140f9e26296b9c0 Mon Sep 17 00:00:00 2001
From: Arnaud Spiwack
Date: Fri, 17 Oct 2014 17:43:38 +0200
Subject: Small optimisation in the monadic list combinators.

The monadic bind can be costly, so sparing a few can be worth it. Therefore I unrolled the last element of the recursions. I took the opportunity to do some loop unrolling, which is probably more useful for map combinators than for fold.
---
 lib/monad.ml | 31 ++++++++++++++++++++++++-------
 1 file changed, 24 insertions(+), 7 deletions(-)

diff --git a/lib/monad.ml b/lib/monad.ml
index 78cf929d2c..b165ffbfb3 100644
--- a/lib/monad.ml
+++ b/lib/monad.ml
@@ -70,32 +70,49 @@ module Make (M:Def) : S with type +'a t = 'a M.t = struct
 
   module List = struct
 
+    (* The combinators are loop-unrolled to spare a some monadic binds
+       (it is a common optimisation to treat the last of a list of
+       bind specially) and hopefully gain some efficiency using fewer
+       jump. *)
+
     let rec map f = function
       | [] -> return []
-      | a::l ->
+      | [a] ->
+          f a >>= fun a' ->
+          return [a']
+      | a::b::l ->
           f a >>= fun a' ->
+          f b >>= fun b' ->
           map f l >>= fun l' ->
-          return (a'::l')
+          return (a'::b'::l')
 
     let rec map_right f = function
       | [] -> return []
-      | a::l ->
+      | [a] ->
+          f a >>= fun a' ->
+          return [a']
+      | a::b::l ->
           map f l >>= fun l' ->
+          f b >>= fun b' ->
           f a >>= fun a' ->
-          return (a'::l')
+          return (a'::b'::l')
 
     let rec fold_right f l x =
       match l with
       | [] -> return x
-      | a::l ->
+      | [a] -> f a x
+      | a::b::l ->
           fold_right f l x >>= fun acc ->
+          f b acc >>= fun acc ->
           f a acc
 
     let rec fold_left f x = function
       | [] -> return x
-      | a::l ->
+      | [a] -> f x a
+      | a::b::l ->
           f x a >>= fun x' ->
-          fold_left f x' l
+          f x' b >>= fun x'' ->
+          fold_left f x'' l
   end
 
 end
-- 
cgit v1.2.3