From 8303c9cab6bc403dfc209f65287b67e883a35711 Mon Sep 17 00:00:00 2001
From: Emilio Jesus Gallego Arias
Date: Wed, 17 Oct 2018 23:03:14 +0200
Subject: [clib] Provide `filter_range` function.

This is very useful to compute efficiently a list of prefixes. Will be
used in conjunction with the nametab to provide completion.

Example of use:

```
let cprefix x y = String.(compare x (sub y 0 (min (length x) (length y)))) in
M.filter_range (cprefix "foo") m
```

We could of course maintain a trie, but this is less invasive an
should work at our scale.
---
 clib/cMap.ml  | 26 ++++++++++++++++++++++++--
 clib/cMap.mli |  6 ++++++
 clib/hMap.ml  |  4 ++++
 3 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/clib/cMap.ml b/clib/cMap.ml
index 040dede0a2..e4ce6c7c02 100644
--- a/clib/cMap.ml
+++ b/clib/cMap.ml
@@ -35,6 +35,7 @@ sig
   val fold_left : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
   val fold_right : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
   val height : 'a t -> int
+  val filter_range : (key -> int) -> 'a t -> 'a t
   module Smart :
   sig
     val map : ('a -> 'a) -> 'a t -> 'a t
@@ -62,6 +63,7 @@ sig
   val fold_left : (M.t -> 'a -> 'b -> 'b) -> 'a map -> 'b -> 'b
   val fold_right : (M.t -> 'a -> 'b -> 'b) -> 'a map -> 'b -> 'b
   val height : 'a map -> int
+  val filter_range : (M.t -> int) -> 'a map -> 'a map
   module Smart :
   sig
     val map : ('a -> 'a) -> 'a map -> 'a map
@@ -85,8 +87,11 @@ struct
       if this happens, we can still implement a less clever version of [domain].
   *)
 
-  type 'a map = 'a Map.Make(M).t
-  type set = Set.Make(M).t
+  module F = Map.Make(M)
+  type 'a map = 'a F.t
+
+  module S = Set.Make(M)
+  type set = S.t
 
   type 'a _map =
   | MEmpty
@@ -164,6 +169,23 @@ struct
   | MEmpty -> 0
   | MNode (_, _, _, _, h) -> h
 
+  (* Filter based on a range *)
+  let filter_range in_range m =
+    let rec aux m = function
+      | MEmpty -> m
+      | MNode (l, k, v, r, _) ->
+        let vr = in_range k in
+        (* the range is below the current value *)
+        if vr < 0 then aux m (map_prj l)
+        (* the range is above the current value *)
+        else if vr > 0 then aux m (map_prj r)
+        (* The current value is in the range *)
+        else
+          let m = aux m (map_prj l) in
+          let m = aux m (map_prj r) in
+          F.add k v m
+    in aux F.empty (map_prj m)
+
   module Smart =
   struct
 
diff --git a/clib/cMap.mli b/clib/cMap.mli
index f5496239f6..ca6ddb2f4e 100644
--- a/clib/cMap.mli
+++ b/clib/cMap.mli
@@ -60,6 +60,12 @@ sig
   val height : 'a t -> int
   (** An indication of the logarithmic size of a map *)
 
+  val filter_range : (key -> int) -> 'a t -> 'a t
+  (** [find_range in_range m] Given a comparison function [in_range x],
+      that tests if [x] is below, above, or inside a given range
+      [filter_range] returns the submap of [m] whose keys are in
+      range. Note that [in_range] has to define a continouous range. *)
+
   module Smart :
   sig
     val map : ('a -> 'a) -> 'a t -> 'a t
diff --git a/clib/hMap.ml b/clib/hMap.ml
index 33cb6d0131..9c80398e4d 100644
--- a/clib/hMap.ml
+++ b/clib/hMap.ml
@@ -398,6 +398,10 @@ struct
 
   let height s = Int.Map.height s
 
+  (* Not as efficient as the original version *)
+  let filter_range f s =
+    filter (fun x _ -> f x = 0) s
+
   module Unsafe =
   struct
     let map f s =
-- 
cgit v1.2.3