aboutsummaryrefslogtreecommitdiffhomepage
path: root/lib
diff options
context:
space:
mode:
authorGravatar Guillaume Melquiond <guillaume.melquiond@inria.fr>2016-08-09 16:29:41 +0200
committerGravatar Guillaume Melquiond <guillaume.melquiond@inria.fr>2016-08-09 16:34:39 +0200
commitc35ad7b248b59964a55d6e5be86a604e4268bf4c (patch)
treecfab63128164277f1ded5c37924dd08e7a986b9e /lib
parentdabe6d0e1d1782d3e9647e04aa1bf161765ad882 (diff)
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).
Diffstat (limited to 'lib')
-rw-r--r--lib/cList.ml40
1 files changed, 28 insertions, 12 deletions
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
| [], [] -> []