diff options
Diffstat (limited to 'clib')
| -rw-r--r-- | clib/cArray.ml | 12 | ||||
| -rw-r--r-- | clib/cArray.mli | 2 | ||||
| -rw-r--r-- | clib/cMap.ml | 26 | ||||
| -rw-r--r-- | clib/cMap.mli | 6 | ||||
| -rw-r--r-- | clib/hMap.ml | 4 |
5 files changed, 48 insertions, 2 deletions
diff --git a/clib/cArray.ml b/clib/cArray.ml index 9644834381..c3a693ff16 100644 --- a/clib/cArray.ml +++ b/clib/cArray.ml @@ -35,6 +35,8 @@ sig val fold_left_i : (int -> 'a -> 'b -> 'a) -> 'a -> 'b array -> 'a val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a array -> 'b array -> 'c -> 'c + val fold_right3 : + ('a -> 'b -> 'c -> 'd -> 'd) -> 'a array -> 'b array -> 'c array -> 'd -> 'd val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b array -> 'c array -> 'a val fold_left3 : @@ -252,6 +254,16 @@ let fold_left2_i f a v1 v2 = if Array.length v2 <> lv1 then invalid_arg "Array.fold_left2_i"; fold a 0 +let fold_right3 f v1 v2 v3 a = + let lv1 = Array.length v1 in + let rec fold a n = + if n=0 then a + else + let k = n-1 in + fold (f (uget v1 k) (uget v2 k) (uget v3 k) a) k in + if Array.length v2 <> lv1 || Array.length v3 <> lv1 then invalid_arg "Array.fold_right3"; + fold a lv1 + let fold_left3 f a v1 v2 v3 = let lv1 = Array.length v1 in let rec fold a n = diff --git a/clib/cArray.mli b/clib/cArray.mli index e65a56d15e..21479d2b45 100644 --- a/clib/cArray.mli +++ b/clib/cArray.mli @@ -58,6 +58,8 @@ sig val fold_left_i : (int -> 'a -> 'b -> 'a) -> 'a -> 'b array -> 'a val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a array -> 'b array -> 'c -> 'c + val fold_right3 : + ('a -> 'b -> 'c -> 'd -> 'd) -> 'a array -> 'b array -> 'c array -> 'd -> 'd val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b array -> 'c array -> 'a val fold_left3 : 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 = |