From c35ad7b248b59964a55d6e5be86a604e4268bf4c Mon Sep 17 00:00:00 2001
From: Guillaume Melquiond <guillaume.melquiond@inria.fr>
Date: Tue, 9 Aug 2016 16:29:41 +0200
Subject: Make List.map_filter(_i) tail-recursive.

While the performance gain should go unnoticed in most cases, in some
degenerate situations, e.g. the evar-stressing test-case of bug #4964,
this commit speeds up coq by 10% since most of the time is spent scanning
long lists with most of the elements filtered out.

Note that this commit also changes the scanning order to front-to-back,
which is a bit less surprising (though no code should ever depend on the
scanning order).
---
 lib/cList.ml | 40 ++++++++++++++++++++++++++++------------
 1 file changed, 28 insertions(+), 12 deletions(-)

(limited to 'lib')

diff --git a/lib/cList.ml b/lib/cList.ml
index 602bba6a5..c8283e3c7 100644
--- a/lib/cList.ml
+++ b/lib/cList.ml
@@ -601,19 +601,35 @@ let filter2 f l1 l2 =
   filter2_loop f c1 c2 l1 l2;
   (c1.tail, c2.tail)
 
-let rec map_filter f = function
-  | [] -> []
-  | x::l ->
-      let l' = map_filter f l in
-      match f x with None -> l' | Some y -> y::l'
+let rec map_filter_loop f p = function
+  | [] -> ()
+  | x :: l ->
+    match f x with
+    | None -> map_filter_loop f p l
+    | Some y ->
+      let c = { head = y; tail = [] } in
+      p.tail <- cast c;
+      map_filter_loop f c l
+
+let map_filter f l =
+  let c = { head = Obj.magic 0; tail = [] } in
+  map_filter_loop f c l;
+  c.tail
 
-let map_filter_i f =
-  let rec aux i = function
-    | [] -> []
-    | x::l ->
-      let l' = aux (succ i) l in
-        match f i x with None -> l' | Some y -> y::l'
-  in aux 0
+let rec map_filter_i_loop f i p = function
+  | [] -> ()
+  | x :: l ->
+    match f i x with
+    | None -> map_filter_i_loop f (succ i) p l
+    | Some y ->
+      let c = { head = y; tail = [] } in
+      p.tail <- cast c;
+      map_filter_i_loop f (succ i) c l
+
+let map_filter_i f l =
+  let c = { head = Obj.magic 0; tail = [] } in
+  map_filter_i_loop f 0 c l;
+  c.tail
 
 let rec filter_with filter l = match filter, l with
 | [], [] -> []
-- 
cgit v1.2.3