aboutsummaryrefslogtreecommitdiff
path: root/clib
diff options
context:
space:
mode:
Diffstat (limited to 'clib')
-rw-r--r--clib/cArray.ml83
-rw-r--r--clib/cArray.mli35
-rw-r--r--clib/cEphemeron.ml163
-rw-r--r--clib/cEphemeron.mli6
-rw-r--r--clib/cList.ml20
-rw-r--r--clib/cList.mli15
-rw-r--r--clib/cMap.ml37
-rw-r--r--clib/cMap.mli12
-rw-r--r--clib/cString.ml40
-rw-r--r--clib/cString.mli10
-rw-r--r--clib/hMap.ml7
-rw-r--r--clib/hashcons.ml4
-rw-r--r--clib/option.ml4
-rw-r--r--clib/option.mli7
14 files changed, 161 insertions, 282 deletions
diff --git a/clib/cArray.ml b/clib/cArray.ml
index d509c55b9a..c3a693ff16 100644
--- a/clib/cArray.ml
+++ b/clib/cArray.ml
@@ -17,9 +17,7 @@ sig
val equal : ('a -> 'a -> bool) -> 'a array -> 'a array -> bool
val equal_norefl : ('a -> 'a -> bool) -> 'a array -> 'a array -> bool
val is_empty : 'a array -> bool
- val exists : ('a -> bool) -> 'a array -> bool
val exists2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool
- val for_all : ('a -> bool) -> 'a array -> bool
val for_all2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool
val for_all3 : ('a -> 'b -> 'c -> bool) ->
'a array -> 'b array -> 'c array -> bool
@@ -37,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 :
@@ -49,28 +49,16 @@ sig
val map_to_list : ('a -> 'b) -> 'a array -> 'b list
val map_of_list : ('a -> 'b) -> 'a list -> 'b array
val chop : int -> 'a array -> 'a array * 'a array
- val smartmap : ('a -> 'a) -> 'a array -> 'a array
- [@@ocaml.deprecated "Same as [Smart.map]"]
- val smartfoldmap : ('r -> 'a -> 'r * 'a) -> 'r -> 'a array -> 'r * 'a array
- [@@ocaml.deprecated "Same as [Smart.fold_left_map]"]
- val map2 : ('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array
val map2_i : (int -> 'a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array
val map3 :
('a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array
val map_left : ('a -> 'b) -> 'a array -> 'b array
- val iter2 : ('a -> 'b -> unit) -> 'a array -> 'b array -> unit
val iter2_i : (int -> 'a -> 'b -> unit) -> 'a array -> 'b array -> unit
val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
val fold_right_map : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array
+ val fold_left2_map_i : (int -> 'a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array
val fold_right2_map : ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c
- val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
- [@@ocaml.deprecated "Same as [fold_left_map]"]
- val fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
- [@@ocaml.deprecated "Same as [fold_right_map]"]
- val fold_map2' :
- ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c
- [@@ocaml.deprecated "Same as [fold_right2_map]"]
val distinct : 'a array -> bool
val rev_of_list : 'a list -> 'a array
val rev_to_list : 'a array -> 'a list
@@ -85,8 +73,6 @@ sig
module Fun1 :
sig
val map : ('r -> 'a -> 'b) -> 'r -> 'a array -> 'b array
- val smartmap : ('r -> 'a -> 'a) -> 'r -> 'a array -> 'a array
- [@@ocaml.deprecated "Same as [Fun1.Smart.map]"]
val iter : ('r -> 'a -> unit) -> 'r -> 'a array -> unit
val iter2 : ('r -> 'a -> 'b -> unit) -> 'r -> 'a array -> 'b array -> unit
module Smart :
@@ -138,13 +124,6 @@ let equal cmp t1 t2 =
let is_empty array = Int.equal (Array.length array) 0
-let exists f v =
- let rec exrec = function
- | -1 -> false
- | n -> f (uget v n) || (exrec (n-1))
- in
- exrec ((Array.length v)-1)
-
let exists2 f v1 v2 =
let rec exrec = function
| -1 -> false
@@ -153,15 +132,6 @@ let exists2 f v1 v2 =
let lv1 = Array.length v1 in
lv1 = Array.length v2 && exrec (lv1-1)
-let for_all f v =
- let rec allrec = function
- | -1 -> true
- | n ->
- let ans = f (uget v n) in
- ans && (allrec (n-1))
- in
- allrec ((Array.length v)-1)
-
let for_all2 f v1 v2 =
let rec allrec = function
| -1 -> true
@@ -284,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 =
@@ -348,20 +328,6 @@ let chop n v =
if n > vlen then failwith "Array.chop";
(Array.sub v 0 n, Array.sub v n (vlen-n))
-let map2 f v1 v2 =
- let len1 = Array.length v1 in
- let len2 = Array.length v2 in
- let () = if not (Int.equal len1 len2) then invalid_arg "Array.map2" in
- if Int.equal len1 0 then
- [| |]
- else begin
- let res = Array.make len1 (f (uget v1 0) (uget v2 0)) in
- for i = 1 to pred len1 do
- Array.unsafe_set res i (f (uget v1 i) (uget v2 i))
- done;
- res
- end
-
let map2_i f v1 v2 =
let len1 = Array.length v1 in
let len2 = Array.length v2 in
@@ -402,12 +368,6 @@ let map_left f a = (* Ocaml does not guarantee Array.map is LR *)
r
end
-let iter2 f v1 v2 =
- let len1 = Array.length v1 in
- let len2 = Array.length v2 in
- let () = if not (Int.equal len2 len1) then invalid_arg "Array.iter2" in
- for i = 0 to len1 - 1 do f (uget v1 i) (uget v2 i) done
-
let iter2_i f v1 v2 =
let len1 = Array.length v1 in
let len2 = Array.length v2 in
@@ -428,15 +388,11 @@ else
let v' = Array.map (fun x -> let (y,e) = f x !e' in e' := e; y) v in
(v',!e')
-let fold_map' = fold_right_map
-
let fold_left_map f e v =
let e' = ref e in
let v' = Array.map (fun x -> let (e,y) = f !e' x in e' := e; y) v in
(!e',v')
-let fold_map = fold_left_map
-
let fold_right2_map f v1 v2 e =
let e' = ref e in
let v' =
@@ -444,13 +400,16 @@ let fold_right2_map f v1 v2 e =
in
(v',!e')
-let fold_map2' = fold_right2_map
-
let fold_left2_map f e v1 v2 =
let e' = ref e in
let v' = map2 (fun x1 x2 -> let (e,y) = f !e' x1 x2 in e' := e; y) v1 v2 in
(!e',v')
+let fold_left2_map_i f e v1 v2 =
+ let e' = ref e in
+ let v' = map2_i (fun idx x1 x2 -> let (e,y) = f idx !e' x1 x2 in e' := e; y) v1 v2 in
+ (!e',v')
+
let distinct v =
let visited = Hashtbl.create 23 in
try
@@ -611,10 +570,6 @@ struct
end
-(* Deprecated aliases *)
-let smartmap = Smart.map
-let smartfoldmap = Smart.fold_left_map
-
module Fun1 =
struct
@@ -681,6 +636,4 @@ struct
end
- let smartmap = Smart.map
-
end
diff --git a/clib/cArray.mli b/clib/cArray.mli
index 5c7e09eeac..21479d2b45 100644
--- a/clib/cArray.mli
+++ b/clib/cArray.mli
@@ -27,12 +27,8 @@ sig
val is_empty : 'a array -> bool
(** True whenever the array is empty. *)
- val exists : ('a -> bool) -> 'a array -> bool
- (** As [List.exists] but on arrays. *)
-
val exists2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool
- val for_all : ('a -> bool) -> 'a array -> bool
val for_all2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool
val for_all3 : ('a -> 'b -> 'c -> bool) ->
'a array -> 'b array -> 'c array -> bool
@@ -62,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 :
@@ -82,15 +80,6 @@ sig
(** [chop i a] returns [(a1, a2)] s.t. [a = a1 + a2] and [length a1 = n].
Raise [Failure "Array.chop"] if [i] is not a valid index. *)
- val smartmap : ('a -> 'a) -> 'a array -> 'a array
- [@@ocaml.deprecated "Same as [Smart.map]"]
-
- val smartfoldmap : ('r -> 'a -> 'r * 'a) -> 'r -> 'a array -> 'r * 'a array
- [@@ocaml.deprecated "Same as [Smart.fold_left_map]"]
-
- val map2 : ('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array
- (** See also [Smart.map2] *)
-
val map2_i : (int -> 'a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array
val map3 :
('a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array
@@ -98,9 +87,6 @@ sig
val map_left : ('a -> 'b) -> 'a array -> 'b array
(** As [map] but guaranteed to be left-to-right. *)
- val iter2 : ('a -> 'b -> unit) -> 'a array -> 'b array -> unit
- (** Iter on two arrays. Raise [Invalid_argument "Array.iter2"] if sizes differ. *)
-
val iter2_i : (int -> 'a -> 'b -> unit) -> 'a array -> 'b array -> unit
(** Iter on two arrays. Raise [Invalid_argument "Array.iter2_i"] if sizes differ. *)
@@ -114,19 +100,13 @@ sig
val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array
(** Same with two arrays, folding on the left; see also [Smart.fold_left2_map] *)
+ val fold_left2_map_i :
+ (int -> 'a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array
+ (** Same than [fold_left2_map] but passing the index of the array *)
+
val fold_right2_map : ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c
(** Same with two arrays, folding on the left *)
- val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
- [@@ocaml.deprecated "Same as [fold_left_map]"]
-
- val fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
- [@@ocaml.deprecated "Same as [fold_right_map]"]
-
- val fold_map2' :
- ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c
- [@@ocaml.deprecated "Same as [fold_right2_map]"]
-
val distinct : 'a array -> bool
(** Return [true] if every element of the array is unique (for default
equality). *)
@@ -171,9 +151,6 @@ sig
val map : ('r -> 'a -> 'b) -> 'r -> 'a array -> 'b array
(** [Fun1.map f x v = map (f x) v] *)
- val smartmap : ('r -> 'a -> 'a) -> 'r -> 'a array -> 'a array
- [@@ocaml.deprecated "Same as [Fun1.Smart.map]"]
-
val iter : ('r -> 'a -> unit) -> 'r -> 'a array -> unit
(** [Fun1.iter f x v = iter (f x) v] *)
diff --git a/clib/cEphemeron.ml b/clib/cEphemeron.ml
index 3136d66e34..d7cc0a4dc2 100644
--- a/clib/cEphemeron.ml
+++ b/clib/cEphemeron.ml
@@ -8,84 +8,103 @@
(* * (see LICENSE file for the text of the license) *)
(************************************************************************)
-type key_type = int
-
-type boxed_key = key_type ref ref
-
-let mk_key : unit -> boxed_key =
- (* TODO: take a random value here. Is there a random function in OCaml? *)
- let bid = ref 0 in
- (* According to OCaml Gc module documentation, Pervasives.ref is one of the
- few ways of getting a boxed value the compiler will never alias. *)
- fun () -> incr bid; Pervasives.ref (Pervasives.ref !bid)
-
-(* A phantom type to preserve type safety *)
-type 'a key = boxed_key
-
-(* Comparing keys with == grants that if a key is unmarshalled (in the same
- process where it was created or in another one) it is not mistaken for
- an already existing one (unmarshal has no right to alias). If the initial
- value of bid is taken at random, then one also avoids potential collisions *)
-module HT = Hashtbl.Make(struct
- type t = key_type ref
- let equal k1 k2 = k1 == k2
- let hash id = !id
+(* Type-safe implementation by whitequark *)
+
+(* An extensible variant has an internal representation equivalent
+ to the following:
+
+ type constr = {
+ name: string,
+ id: int
+ }
+ type value = (*Object_tag*) constr * v1 * v2...
+
+ and the code generated by the compiler looks like:
+
+ (* type X += Y *)
+ let constr_Y = alloc { "Y", %caml_fresh_oo_id () }
+ (* match x with Y -> a | _ -> b *)
+ if x.0 == constr_Y then a else b
+
+ and the polymorphic comparison function works like:
+
+ let equal = fun (c1, ...) (c2, ...) ->
+ c1.id == c2.id
+
+ In every new extension constructor, the name field is a constant
+ string and the id field is filled with an unique[1] value returned
+ by %caml_fresh_oo_id. Moreover, every value of an extensible variant
+ type is allocated as a new block.
+
+ [1]: On 64-bit systems. On 32-bit systems, calling %caml_fresh_oo_id
+ 2**30 times will result in a wraparound. Note that this does
+ not affect soundness because constructors are compared by
+ physical equality during matching. See OCaml PR7809 for code
+ demonstrating this.
+
+ An extensible variant can be marshalled and unmarshalled, and
+ is guaranteed to not be equal to itself after unmarshalling,
+ since the id field is filled with another unique value.
+
+ Note that the explanation above is purely informative and we
+ do not depend on the exact representation of extensible variants,
+ only on the fact that no two constructor representations ever
+ alias. In particular, if the definition of constr is replaced with:
+
+ type constr = int
+
+ (where the value is truly unique for every created constructor),
+ correctness is preserved.
+ *)
+type 'a typ = ..
+
+(* Erases the contained type so that the key can be put in a hash table. *)
+type boxkey = Box : 'a typ -> boxkey [@@unboxed]
+
+(* Carry the type we just erased with the actual key. *)
+type 'a key = 'a typ * boxkey
+
+module EHashtbl = Ephemeron.K1.Make(struct
+ type t = boxkey
+ let equal = (==)
+ let hash = Hashtbl.hash
end)
-(* A key is the (unique) value inside a boxed key, hence it does not
- keep its corresponding boxed key reachable (replacing key_type by boxed_key
- would make the key always reachable) *)
-let values : Obj.t HT.t = HT.create 1001
-
-(* To avoid a race condition between the finalization function and
- get/create on the values hashtable, the finalization function just
- enqueues in an imperative list the item to be collected. Being the list
- imperative, even if the Gc enqueues an item while run_collection is operating,
- the tail of the list is eventually set to Empty on completion.
- Kudos to the authors of Why3 that came up with this solution for their
- implementation of weak hash tables! *)
-type imperative_list = cell ref
-and cell = Empty | Item of key_type ref * imperative_list
-
-let collection_queue : imperative_list ref = ref (ref Empty)
-
-let enqueue x = collection_queue := ref (Item (!x, !collection_queue))
-
-let run_collection () =
- let rec aux l = match !l with
- | Empty -> ()
- | Item (k, tl) -> HT.remove values k; aux tl in
- let l = !collection_queue in
- aux l;
- l := Empty
-
-(* The only reference to the boxed key is the one returned, when the user drops
- it the value eventually disappears from the values table above *)
-let create (v : 'a) : 'a key =
- run_collection ();
- let k = mk_key () in
- HT.add values !k (Obj.repr v);
- Gc.finalise enqueue k;
- k
+type value = { get : 'k. 'k typ -> 'k } [@@unboxed]
+
+let values : value EHashtbl.t =
+ EHashtbl.create 1001
+
+let create : type v. v -> v key =
+ fun value ->
+ let module M = struct
+ type _ typ += Typ : v typ
+
+ let get : type k. k typ -> k =
+ fun typ ->
+ match typ with
+ | Typ -> value
+ | _ -> assert false
+
+ let boxkey = Box Typ
+ let key = Typ, boxkey
+ let value = { get }
+ end in
+ EHashtbl.add values M.boxkey M.value;
+ M.key
(* Avoid raising Not_found *)
exception InvalidKey
-let get (k : 'a key) : 'a =
- run_collection ();
- try Obj.obj (HT.find values !k)
+let get (typ, boxkey) =
+ try (EHashtbl.find values boxkey).get typ
with Not_found -> raise InvalidKey
-(* Simple utils *)
-let default k v =
- try get k
- with InvalidKey -> v
+let default (typ, boxkey) default =
+ try (EHashtbl.find values boxkey).get typ
+ with Not_found -> default
-let iter_opt k f =
- match
- try Some (get k)
- with InvalidKey -> None
- with
- | None -> ()
- | Some v -> f v
+let iter_opt (typ, boxkey) f =
+ try f ((EHashtbl.find values boxkey).get typ)
+ with Not_found -> ()
-let clear () = run_collection ()
+let clean () = EHashtbl.clean values
diff --git a/clib/cEphemeron.mli b/clib/cEphemeron.mli
index 8e753d0b62..96391e10fa 100644
--- a/clib/cEphemeron.mli
+++ b/clib/cEphemeron.mli
@@ -33,7 +33,7 @@
An ['a key] can always be marshalled. When marshalled, a key loses its
value. The function [get] raises Not_found on unmarshalled keys.
-
+
If a key is garbage collected, the corresponding value is garbage
collected too (unless extra references to it exist).
In short no memory management hassle, keys can just replace their
@@ -48,7 +48,7 @@ exception InvalidKey
val get : 'a key -> 'a
(* These never fail. *)
-val iter_opt : 'a key -> ('a -> unit) -> unit
val default : 'a key -> 'a -> 'a
+val iter_opt : 'a key -> ('a -> unit) -> unit
-val clear : unit -> unit
+val clean : unit -> unit
diff --git a/clib/cList.ml b/clib/cList.ml
index dc59ff2970..aba3e46bd5 100644
--- a/clib/cList.ml
+++ b/clib/cList.ml
@@ -36,16 +36,12 @@ sig
val filteri :
(int -> 'a -> bool) -> 'a list -> 'a list
val filter_with : bool list -> 'a list -> 'a list
- val smartfilter : ('a -> bool) -> 'a list -> 'a list
- [@@ocaml.deprecated "Same as [filter]"]
val map_filter : ('a -> 'b option) -> 'a list -> 'b list
val map_filter_i : (int -> 'a -> 'b option) -> 'a list -> 'b list
val partitioni :
(int -> 'a -> bool) -> 'a list -> 'a list * 'a list
val map : ('a -> 'b) -> 'a list -> 'b list
val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
- val smartmap : ('a -> 'a) -> 'a list -> 'a list
- [@@ocaml.deprecated "Same as [Smart.map]"]
val map_left : ('a -> 'b) -> 'a list -> 'b list
val map_i : (int -> 'a -> 'b) -> int -> 'a list -> 'b list
val map2_i :
@@ -75,10 +71,6 @@ sig
val fold_right2_map : ('b -> 'c -> 'a -> 'd * 'a) -> 'b list -> 'c list -> 'a -> 'd list * 'a
val fold_left3_map : ('a -> 'b -> 'c -> 'd -> 'a * 'e) -> 'a -> 'b list -> 'c list -> 'd list -> 'a * 'e list
val fold_left4_map : ('a -> 'b -> 'c -> 'd -> 'e -> 'a * 'r) -> 'a -> 'b list -> 'c list -> 'd list -> 'e list -> 'a * 'r list
- val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
- [@@ocaml.deprecated "Same as [fold_left_map]"]
- val fold_map' : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
- [@@ocaml.deprecated "Same as [fold_right_map]"]
val except : 'a eq -> 'a -> 'a list -> 'a list
val remove : 'a eq -> 'a -> 'a list -> 'a list
val remove_first : ('a -> bool) -> 'a list -> 'a list
@@ -116,8 +108,6 @@ sig
val unionq : 'a list -> 'a list -> 'a list
val subtract : 'a eq -> 'a list -> 'a list -> 'a list
val subtractq : 'a list -> 'a list -> 'a list
- val merge_uniq : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
- [@@ocaml.deprecated "Same as [merge_set]"]
val distinct : 'a list -> bool
val distinct_f : 'a cmp -> 'a list -> bool
val duplicates : 'a eq -> 'a list -> 'a list
@@ -337,8 +327,6 @@ let filteri p =
in
filter_i_rec 0
-let smartfilter = filter (* Alias *)
-
let rec filter_with_loop filter p l = match filter, l with
| [], [] -> ()
| b :: filter, x :: l' ->
@@ -618,8 +606,6 @@ let rec fold_left_map f e = function
let e'',t' = fold_left_map f e' t in
e'',h' :: t'
-let fold_map = fold_left_map
-
(* (* tail-recursive version of the above function *)
let fold_left_map f e l =
let g (e,b') h =
@@ -634,8 +620,6 @@ let fold_left_map f e l =
let fold_right_map f l e =
List.fold_right (fun x (l,e) -> let (y,e) = f x e in (y::l,e)) l ([],e)
-let fold_map' = fold_right_map
-
let on_snd f (x,y) = (x,f y)
let fold_left2_map f e l l' =
@@ -905,8 +889,6 @@ let rec merge_set cmp l1 l2 = match l1, l2 with
then h1 :: merge_set cmp t1 l2
else h2 :: merge_set cmp l1 t2
-let merge_uniq = merge_set
-
let intersect cmp l1 l2 =
filter (fun x -> mem_f cmp x l2) l1
@@ -1047,8 +1029,6 @@ struct
end
-let smartmap = Smart.map
-
module type MonoS = sig
type elt
val equal : elt list -> elt list -> bool
diff --git a/clib/cList.mli b/clib/cList.mli
index 39d9a5e535..8582e6cd65 100644
--- a/clib/cList.mli
+++ b/clib/cList.mli
@@ -91,9 +91,6 @@ sig
(** [filter_with bl l] selects elements of [l] whose corresponding element in
[bl] is [true]. Raise [Invalid_argument _] if sizes differ. *)
- val smartfilter : ('a -> bool) -> 'a list -> 'a list
- [@@ocaml.deprecated "Same as [filter]"]
-
val map_filter : ('a -> 'b option) -> 'a list -> 'b list
(** Like [map] but keeping only non-[None] elements *)
@@ -111,9 +108,6 @@ sig
val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
(** Like OCaml [List.map2] but tail-recursive *)
- val smartmap : ('a -> 'a) -> 'a list -> 'a list
- [@@ocaml.deprecated "Same as [Smart.map]"]
-
val map_left : ('a -> 'b) -> 'a list -> 'b list
(** As [map] but ensures the left-to-right order of evaluation. *)
@@ -208,12 +202,6 @@ sig
val fold_left4_map : ('a -> 'b -> 'c -> 'd -> 'e -> 'a * 'r) -> 'a -> 'b list -> 'c list -> 'd list -> 'e list -> 'a * 'r list
(** Same with four lists, folding on the left *)
- val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
- [@@ocaml.deprecated "Same as [fold_left_map]"]
-
- val fold_map' : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
- [@@ocaml.deprecated "Same as [fold_right_map]"]
-
(** {6 Splitting} *)
val except : 'a eq -> 'a -> 'a list -> 'a list
@@ -357,9 +345,6 @@ sig
val subtractq : 'a list -> 'a list -> 'a list
(** [subtract] specialized to physical equality *)
- val merge_uniq : 'a cmp -> 'a list -> 'a list -> 'a list
- [@@ocaml.deprecated "Same as [merge_set]"]
-
(** {6 Uniqueness and duplication} *)
val distinct : 'a list -> bool
diff --git a/clib/cMap.ml b/clib/cMap.ml
index 54a8b25851..e4ce6c7c02 100644
--- a/clib/cMap.ml
+++ b/clib/cMap.ml
@@ -34,11 +34,8 @@ sig
val bind : (key -> 'a) -> Set.t -> 'a t
val fold_left : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
val fold_right : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
- val smartmap : ('a -> 'a) -> 'a t -> 'a t
- [@@ocaml.deprecated "Same as [Smart.map]"]
- val smartmapi : (key -> 'a -> 'a) -> 'a t -> 'a t
- [@@ocaml.deprecated "Same as [Smart.mapi]"]
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
@@ -65,11 +62,8 @@ sig
val bind : (M.t -> 'a) -> Set.Make(M).t -> 'a map
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 smartmap : ('a -> 'a) -> 'a map -> 'a map
- [@@ocaml.deprecated "Same as [Smart.map]"]
- val smartmapi : (M.t -> 'a -> 'a) -> 'a map -> 'a map
- [@@ocaml.deprecated "Same as [Smart.mapi]"]
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
@@ -93,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
@@ -172,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
@@ -195,9 +209,6 @@ struct
end
- let smartmap = Smart.map
- let smartmapi = Smart.mapi
-
module Unsafe =
struct
diff --git a/clib/cMap.mli b/clib/cMap.mli
index 127bf23ab6..ca6ddb2f4e 100644
--- a/clib/cMap.mli
+++ b/clib/cMap.mli
@@ -57,15 +57,15 @@ sig
val fold_right : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
(** Folding keys in decreasing order. *)
- val smartmap : ('a -> 'a) -> 'a t -> 'a t
- [@@ocaml.deprecated "Same as [Smart.map]"]
-
- val smartmapi : (key -> 'a -> 'a) -> 'a t -> 'a t
- [@@ocaml.deprecated "Same as [Smart.mapi]"]
-
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/cString.ml b/clib/cString.ml
index dd33562f16..111be3da82 100644
--- a/clib/cString.ml
+++ b/clib/cString.ml
@@ -13,14 +13,12 @@ module type S = module type of String
module type ExtS =
sig
include S
- [@@@ocaml.warning "-3"] (* [@@noalloc] since 4.03.0 GPR#240 *)
- external equal : string -> string -> bool = "caml_string_equal" "noalloc"
- [@@@ocaml.warning "+3"]
val hash : string -> int
val is_empty : string -> bool
val explode : string -> string list
val implode : string list -> string
val strip : string -> string
+ [@@ocaml.deprecated "Use [trim]"]
val drop_simple_quotes : string -> string
val string_index_from : string -> int -> string -> int
val string_contains : where:string -> what:string -> bool
@@ -28,6 +26,7 @@ sig
val conjugate_verb_to_be : int -> string
val ordinal : int -> string
val split : char -> string -> string list
+ [@@ocaml.deprecated "Use [split_on_char]"]
val is_sub : string -> string -> int -> bool
module Set : Set.S with type elt = t
module Map : CMap.ExtS with type key = t and module Set := Set
@@ -37,10 +36,6 @@ end
include String
-[@@@ocaml.warning "-3"] (* [@@noalloc] since 4.03.0 GPR#240 *)
-external equal : string -> string -> bool = "caml_string_equal" "noalloc"
-[@@@ocaml.warning "+3"]
-
let rec hash len s i accu =
if i = len then accu
else
@@ -62,26 +57,9 @@ let explode s =
let implode sl = String.concat "" sl
-let is_blank = function
- | ' ' | '\r' | '\t' | '\n' -> true
- | _ -> false
-
let is_empty s = String.length s = 0
-let strip s =
- let n = String.length s in
- let rec lstrip_rec i =
- if i < n && is_blank s.[i] then
- lstrip_rec (i+1)
- else i
- in
- let rec rstrip_rec i =
- if i >= 0 && is_blank s.[i] then
- rstrip_rec (i-1)
- else i
- in
- let a = lstrip_rec 0 and b = rstrip_rec (n-1) in
- String.sub s a (b-a+1)
+let strip = String.trim
let drop_simple_quotes s =
let n = String.length s in
@@ -146,17 +124,7 @@ let ordinal n =
(* string parsing *)
-let split c s =
- let len = String.length s in
- let rec split n =
- try
- let pos = String.index_from s n c in
- let dir = String.sub s n (pos-n) in
- dir :: split (succ pos)
- with
- | Not_found -> [String.sub s n (len-n)]
- in
- if Int.equal len 0 then [] else split 0
+let split = String.split_on_char
module Self =
struct
diff --git a/clib/cString.mli b/clib/cString.mli
index 2000dfafb5..a73c2729d0 100644
--- a/clib/cString.mli
+++ b/clib/cString.mli
@@ -16,10 +16,6 @@ sig
include S
(** We include the standard library *)
- [@@@ocaml.warning "-3"] (* [@@noalloc] since 4.03.0 GPR#240 *)
- external equal : string -> string -> bool = "caml_string_equal" "noalloc"
- [@@@ocaml.warning "+3"]
-
(** Equality on strings *)
val hash : string -> int
@@ -35,7 +31,8 @@ sig
(** [implode [s1; ...; sn]] returns [s1 ^ ... ^ sn] *)
val strip : string -> string
- (** Remove the surrounding blank characters from a string *)
+ (** Alias for [String.trim] *)
+ [@@ocaml.deprecated "Use [trim]"]
val drop_simple_quotes : string -> string
(** Remove the eventual first surrounding simple quotes of a string. *)
@@ -56,7 +53,8 @@ sig
(** Generate the ordinal number in English. *)
val split : char -> string -> string list
- (** [split c s] splits [s] into sequences separated by [c], excluded. *)
+ (** [split c s] alias of [String.split_on_char] *)
+ [@@ocaml.deprecated "Use [split_on_char]"]
val is_sub : string -> string -> int -> bool
(** [is_sub p s off] tests whether [s] contains [p] at offset [off]. *)
diff --git a/clib/hMap.ml b/clib/hMap.ml
index b2cf474304..9c80398e4d 100644
--- a/clib/hMap.ml
+++ b/clib/hMap.ml
@@ -396,11 +396,12 @@ struct
end
- let smartmap = Smart.map
- let smartmapi = Smart.mapi
-
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 =
diff --git a/clib/hashcons.ml b/clib/hashcons.ml
index 39969ebf75..4e5d6212a0 100644
--- a/clib/hashcons.ml
+++ b/clib/hashcons.ml
@@ -131,9 +131,7 @@ module Hstring = Make(
type u = unit
let hashcons () s =(* incr accesstr;*) s
- [@@@ocaml.warning "-3"] (* [@@noalloc] since 4.03.0 GPR#240 *)
- external eq : string -> string -> bool = "caml_string_equal" "noalloc"
- [@@@ocaml.warning "+3"]
+ let eq = String.equal
(** Copy from CString *)
let rec hash len s i accu =
diff --git a/clib/option.ml b/clib/option.ml
index 7a3d5f934f..3e57fd5c85 100644
--- a/clib/option.ml
+++ b/clib/option.ml
@@ -131,8 +131,6 @@ let fold_right_map f x a =
| Some y -> let z, a = f y a in Some z, a
| _ -> None, a
-let fold_map = fold_left_map
-
(** [cata f a x] is [a] if [x] is [None] and [f y] if [x] is [Some y]. *)
let cata f a = function
| Some c -> f c
@@ -183,8 +181,6 @@ struct
end
-let smartmap = Smart.map
-
(** {6 Operations with Lists} *)
module List =
diff --git a/clib/option.mli b/clib/option.mli
index 8f82bf090b..e99c8015c4 100644
--- a/clib/option.mli
+++ b/clib/option.mli
@@ -75,9 +75,6 @@ val iter2 : ('a -> 'b -> unit) -> 'a option -> 'b option -> unit
(** [map f x] is [None] if [x] is [None] and [Some (f y)] if [x] is [Some y]. *)
val map : ('a -> 'b) -> 'a option -> 'b option
-val smartmap : ('a -> 'a) -> 'a option -> 'a option
-[@@ocaml.deprecated "Same as [Smart.map]"]
-
(** [fold_left f a x] is [f a y] if [x] is [Some y], and [a] otherwise. *)
val fold_left : ('b -> 'a -> 'b) -> 'b -> 'a option -> 'b
@@ -95,10 +92,6 @@ val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b option -> 'a * 'c option
(** Same as [fold_left_map] on the right *)
val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b option -> 'a -> 'c option * 'a
-(** @deprecated Same as [fold_left_map] *)
-val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b option -> 'a * 'c option
-[@@ocaml.deprecated "Same as [fold_left_map]"]
-
(** [cata f e x] is [e] if [x] is [None] and [f a] if [x] is [Some a] *)
val cata : ('a -> 'b) -> 'b -> 'a option -> 'b
generated by cgit v1.2.3 (git 2.25.1) at 2026-05-01 04:41:17 +0000