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 ++++++++++++++++++++++++--
 1 file changed, 24 insertions(+), 2 deletions(-)

(limited to 'clib/cMap.ml')

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
 
-- 
cgit v1.2.3