From f6e1d81ed7d45a52aadff910abcd947978c16296 Mon Sep 17 00:00:00 2001 From: Christopher Zimmermann Date: Sun, 10 Jun 2018 18:26:46 +0200 Subject: [PATCH] Generate unlabelled interfaces from labelled ones * add unlabel.ml which parses interfaces and removes labels in function declarations and docstrings. This is a quick hack, but it does the job. * an attribute [@keep_label] can be added to the labelled arguments to mark labels like ~cmp which should stay in the "unlabelled" interface * While augmenting the labelled interfaces I stumbled across some inconsistencies between the currend labelled / non-labelled interfaces. I used the labelling that made most sense to me and added a "FIXME" comment. * Maybe we should break backwards compatibility at some point and name the comparison arguments to the sorting functions in CCArrayLabels.ml ~cmp instead of ~f ? --- Makefile | 8 +- qtest/make.ml | 1 + src/core/CCArray.mli | 118 ++++++++++-------- src/core/CCArrayLabels.mli | 40 +++--- src/core/CCList.ml | 14 +-- src/core/CCList.mli | 96 ++++++++++----- src/core/CCListLabels.mli | 212 +++++++++++++++++++++++--------- src/core/dune | 11 ++ src/dune | 8 +- src/unlabel.ml | 246 +++++++++++++++++++++++++++++++++++++ 10 files changed, 582 insertions(+), 172 deletions(-) create mode 100644 src/unlabel.ml diff --git a/Makefile b/Makefile index 1528836e..85893647 100644 --- a/Makefile +++ b/Makefile @@ -1,8 +1,10 @@ +PROMOTE=$(if $(shell ocamlc -version |grep '4\.0[012]\.[0-9][0-9]*'), \ + --ignore-promoted-rules, ) all: build test build: - dune build @install + dune build $(PROMOTE) @install test: build dune runtest --no-buffer --force @@ -11,12 +13,12 @@ clean: dune clean doc: - dune build @doc + dune build $(PROMOTE) @doc BENCH_TARGETS=run_benchs.exe run_bench_hash.exe benchs: - dune build $(addprefix benchs/, $(BENCH_TARGETS)) + dune build $(PROMOTE) $(addprefix benchs/, $(BENCH_TARGETS)) examples: dune build examples/id_sexp.exe diff --git a/qtest/make.ml b/qtest/make.ml index 42b1bfd4..c8c7c3d6 100644 --- a/qtest/make.ml +++ b/qtest/make.ml @@ -20,6 +20,7 @@ let do_not_test file = is_suffix ~sub:"containers.ml" file || is_suffix ~sub:"containers_top.ml" file || is_suffix ~sub:"mkflags.ml" file || + is_suffix ~sub:"unlabel.ml" file || is_suffix ~sub:"utop.ml" file let prefix = "src" diff --git a/src/core/CCArray.mli b/src/core/CCArray.mli index e7d1260b..0b138167 100644 --- a/src/core/CCArray.mli +++ b/src/core/CCArray.mli @@ -1,3 +1,4 @@ +(* AUTOGENERATED FROM CCArrayLabels.mli *) (* This file is free software, part of containers. See file "license" for more details. *) @@ -13,6 +14,10 @@ type 'a printer = Format.formatter -> 'a -> unit (** {2 Arrays} *) +(**/**) +external make_float : int -> float array = "caml_make_float_vect" (* compat *) +(**/**) + include module type of Array type 'a t = 'a array @@ -57,28 +62,30 @@ val length : _ t -> int (** [length a] returns the length (number of elements) of the given array [a]. *) val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a -(** [fold f acc a] computes [f (... (f (f acc a.(0)) a.(1)) ...) a.(n-1)], +(** [fold f init a] computes [f (... (f (f init a.(0)) a.(1)) ...) a.(n-1)], where [n] is the length of the array [a]. *) val foldi : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a -(** [foldi f acc a] is just like {!fold}, but it also passes in the index +(** [foldi f init a] is just like {!fold}, but it also passes in the index of each element as the second argument to the folded function [f]. *) val fold_while : ('a -> 'b -> 'a * [`Stop | `Continue]) -> 'a -> 'b t -> 'a -(** [fold_while f acc a] folds left on array [a] until a stop condition via [('a, `Stop)] +(** [fold_while f init a] folds left on array [a] until a stop condition via [('a, `Stop)] is indicated by the accumulator. @since 0.8 *) val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a t -> 'acc * 'b t -(** [fold_map f acc a] is a [fold_left]-like function, but it also maps the +(** [fold_map f init a] is a [fold_left]-like function, but it also maps the array to another array. - @since 1.2 *) + @since 1.2, but only + @since 2.1 with labels *) val scan_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a t -> 'acc t -(** [scan_left f acc a] returns the array - [ [|acc; f acc x0; f (f acc a.(0)) a.(1); …|] ]. +(** [scan_left f init a] returns the array + [ [|init; f init x0; f (f init a.(0)) a.(1); …|] ]. - @since 1.2 *) + @since 1.2, but only + @since 2.1 with labels *) val iter : ('a -> unit) -> 'a t -> unit (** [iter f a] applies function [f] in turn to all elements of [a]. @@ -103,24 +110,27 @@ val reverse_in_place : 'a t -> unit (** [reverse_in_place a] reverses the array [a] in place. *) val sorted : ('a -> 'a -> int) -> 'a t -> 'a array -(** [sorted cmp a] makes a copy of [a] and sorts it with [cmp]. + (* FIXME: better label this ~cmp ?? *) +(** [sorted f a] makes a copy of [a] and sorts it with [f]. @since 1.0 *) val sort_indices : ('a -> 'a -> int) -> 'a t -> int array -(** [sort_indices cmp a] returns a new array [b], with the same length as [a], - such that [b.(i)] is the index at which the [i]-th element of [sorted cmp a] + (* FIXME: better label this ~cmp ?? *) +(** [sort_indices f a] returns a new array [b], with the same length as [a], + such that [b.(i)] is the index at which the [i]-th element of [sorted f a] appears in [a]. [a] is not modified. - In other words, [map (fun i -> a.(i)) (sort_indices cmp a) = sorted cmp a]. + In other words, [map (fun i -> a.(i)) (sort_indices f a) = sorted f a]. [sort_indices] yields the inverse permutation of {!sort_ranking}. @since 1.0 *) val sort_ranking : ('a -> 'a -> int) -> 'a t -> int array -(** [sort_ranking cmp a] returns a new array [b], with the same length as [a], + (* FIXME: better label this ~cmp ?? *) +(** [sort_ranking f a] returns a new array [b], with the same length as [a], such that [b.(i)] is the index at which the [i]-th element of [a] appears - in [sorted cmp a]. [a] is not modified. + in [sorted f a]. [a] is not modified. - In other words, [map (fun i -> (sorted cmp a).(i)) (sort_ranking cmp a) = a]. + In other words, [map (fun i -> (sorted f a).(i)) (sort_ranking f a) = a]. [sort_ranking] yields the inverse permutation of {!sort_indices}. In the absence of duplicate elements in [a], we also have @@ -130,97 +140,103 @@ val sort_ranking : ('a -> 'a -> int) -> 'a t -> int array val find_map : ('a -> 'b option) -> 'a t -> 'b option (** [find_map f a] returns [Some y] if there is an element [x] such that [f x = Some y]. Otherwise returns [None]. - @since 1.3 *) + @since 1.3, but only + @since 2.1 with labels *) val find : ('a -> 'b option) -> 'a t -> 'b option (** [find f a] is an alias to {!find_map}. - @deprecated since 1.3, use {!find_map} instead. *) + @deprecated since 1.3, use {!find_map} instead. + The version with labels is + @deprecated since 2.1, use {!find_map} instead. *) val find_map_i : (int -> 'a -> 'b option) -> 'a t -> 'b option (** [find_map_i f a] is like {!find_map}, but the index of the element is also passed to the predicate function [f]. - @since 1.3 *) + @since 1.3, but only + @since 2.1 with labels *) val findi : (int -> 'a -> 'b option) -> 'a t -> 'b option (** [findi f a] is an alias to {!find_map_i}. @since 0.3.4 - @deprecated since 1.3, use {!find_map_i} instead. *) + @deprecated since 1.3, use {!find_map} instead. + The version with labels is + @deprecated since 2.1, use {!find_map} instead. *) val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option -(** [find_idx p a] returns [Some (i,x)] where [x] is the [i]-th element of [a], - and [p x] holds. Otherwise returns [None]. +(** [find_idx f a] returns [Some (i,x)] where [x] is the [i]-th element of [a], + and [f x] holds. Otherwise returns [None]. @since 0.3.4 *) val lookup : cmp:'a ord -> 'a -> 'a t -> int option -(** [lookup cmp x a] lookups the index of some key [x] in a sorted array [a]. - Undefined behavior if the array [a] is not sorted wrt [cmp]. +(** [lookup ~cmp key a] lookups the index of some key [key] in a sorted array [a]. + Undefined behavior if the array [a] is not sorted wrt [~cmp]. Complexity: [O(log (n))] (dichotomic search). - @return [None] if the key [x] is not present, or + @return [None] if the key [key] is not present, or [Some i] ([i] the index of the key) otherwise. *) val lookup_exn : cmp:'a ord -> 'a -> 'a t -> int -(** [lookup_exn cmp x a] is like {!lookup}, but - @raise Not_found if the key [x] is not present. *) +(** [lookup_exn ~cmp key a] is like {!lookup}, but + @raise Not_found if the key [key] is not present. *) val bsearch : cmp:('a -> 'a -> int) -> 'a -> 'a t -> [ `All_lower | `All_bigger | `Just_after of int | `Empty | `At of int ] -(** [bsearch ~cmp x a] finds the index of the object [x] in the array [a], - provided [a] is {b sorted} using [cmp]. If the array is not sorted, +(** [bsearch ~cmp key a] finds the index of the object [key] in the array [a], + provided [a] is {b sorted} using [~cmp]. If the array is not sorted, the result is not specified (may raise Invalid_argument). Complexity: [O(log n)] where n is the length of the array [a] (dichotomic search). @return - - [`At i] if [cmp a.(i) x = 0] (for some i). - - [`All_lower] if all elements of [a] are lower than [x]. - - [`All_bigger] if all elements of [a] are bigger than [x]. - - [`Just_after i] if [a.(i) < x < a.(i+1)]. + - [`At i] if [cmp a.(i) key = 0] (for some i). + - [`All_lower] if all elements of [a] are lower than [key]. + - [`All_bigger] if all elements of [a] are bigger than [key]. + - [`Just_after i] if [a.(i) < key < a.(i+1)]. - [`Empty] if the array [a] is empty. @raise Invalid_argument if the array is found to be unsorted w.r.t [cmp]. @since 0.13 *) val for_all : ('a -> bool) -> 'a t -> bool -(** [for_all p [|a1; ...; an|]] is [true] if all elements of the array - satisfy the predicate [p]. That is, it returns - [(p a1) && (p a2) && ... && (p an)]. *) +(** [for_all f [|a1; ...; an|]] is [true] if all elements of the array + satisfy the predicate [f]. That is, it returns + [(f a1) && (f a2) && ... && (f an)]. *) val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool -(** [for_all2 p [|a1; ...; an|] [|b1; ...; bn|]] is [true] if each pair of elements [ai bi] - satisfies the predicate [p]. - That is, it returns [(p a1 b1) && (p a2 b2) && ... && (p an bn)]. +(** [for_all2 f [|a1; ...; an|] [|b1; ...; bn|]] is [true] if each pair of elements [ai bi] + satisfies the predicate [f]. + That is, it returns [(f a1 b1) && (f a2 b2) && ... && (f an bn)]. @raise Invalid_argument if arrays have distinct lengths. Allow different types. @since 0.20 *) val exists : ('a -> bool) -> 'a t -> bool -(** [exists p [|a1; ...; an|]] is [true] if at least one element of - the array satisfies the predicate [p]. That is, it returns - [(p a1) || (p a2) || ... || (p an)]. *) +(** [exists f [|a1; ...; an|]] is [true] if at least one element of + the array satisfies the predicate [f]. That is, it returns + [(f a1) || (f a2) || ... || (f an)]. *) val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool -(** [exists2 p [|a1; ...; an|] [|b1; ...; bn|]] is [true] if any pair of elements [ai bi] - satisfies the predicate [p]. - That is, it returns [(p a1 b1) || (p a2 b2) || ... || (p an bn)]. +(** [exists2 f [|a1; ...; an|] [|b1; ...; bn|]] is [true] if any pair of elements [ai bi] + satisfies the predicate [f]. + That is, it returns [(f a1 b1) || (f a2 b2) || ... || (f an bn)]. @raise Invalid_argument if arrays have distinct lengths. Allow different types. @since 0.20 *) val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc -(** [fold2 f acc a b] fold on two arrays [a] and [b] stepwise. - It computes [f (... (f acc a1 b1)...) an bn]. +(** [fold2 f init a b] fold on two arrays [a] and [b] stepwise. + It computes [f (... (f init a1 b1)...) an bn]. - @raise Invalid_argument if arrays have distinct lengths. + @raise Invalid_argument if [a] and [b] have distinct lengths. @since 0.20 *) val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit (** [iter2 f a b] iterates on the two arrays [a] and [b] stepwise. It is equivalent to [f a0 b0; ...; f a.(length a - 1) b.(length b - 1); ()]. - @raise Invalid_argument if arrays have distinct lengths. + @raise Invalid_argument if [a] and [b] have distinct lengths. @since 0.20 *) val shuffle : 'a t -> unit @@ -275,8 +291,8 @@ val rev : 'a t -> 'a t @since 0.20 *) val filter : ('a -> bool) -> 'a t -> 'a t -(** [filter p a] filters elements out of the array [a]. Only the elements satisfying - the given predicate [p] will be kept. *) +(** [filter f a] filters elements out of the array [a]. Only the elements satisfying + the given predicate [f] will be kept. *) val filter_map : ('a -> 'b option) -> 'a t -> 'b t (** [filter_map f [|a1; ...; an|]] calls [(f a1) ... (f an)] and returns an array [b] consisting @@ -328,6 +344,6 @@ end val sort_generic : (module MONO_ARRAY with type t = 'arr and type elt = 'elt) -> cmp:('elt -> 'elt -> int) -> 'arr -> unit -(** [sort_generic (module M) cmp a] sorts the array [a], without allocating (eats stack space though). +(** [sort_generic (module M) ~cmp a] sorts the array [a], without allocating (eats stack space though). Performance might be lower than {!Array.sort}. @since 0.14 *) diff --git a/src/core/CCArrayLabels.mli b/src/core/CCArrayLabels.mli index 074965ef..c53ae79b 100644 --- a/src/core/CCArrayLabels.mli +++ b/src/core/CCArrayLabels.mli @@ -75,22 +75,24 @@ val fold_while : f:('a -> 'b -> 'a * [`Stop | `Continue]) -> init:'a -> 'b t -> val fold_map : f:('acc -> 'a -> 'acc * 'b) -> init:'acc -> 'a t -> 'acc * 'b t (** [fold_map ~f ~init a] is a [fold_left]-like function, but it also maps the array to another array. - @since 2.1 *) + @since 1.2, but only + @since 2.1 with labels *) val scan_left : f:('acc -> 'a -> 'acc) -> init:'acc -> 'a t -> 'acc t (** [scan_left ~f ~init a] returns the array [ [|~init; ~f ~init x0; ~f (~f ~init a.(0)) a.(1); …|] ]. - @since 2.1 *) - + @since 1.2, but only + @since 2.1 with labels *) + val iter : f:('a -> unit) -> 'a t -> unit -(** [iter ~f a] applies function [~f] in turn to all elements of [a]. +(** [iter ~f a] applies function [~f] in turn to all elements of [a]. It is equivalent to [~f a.(0); ~f a.(1); ...; ~f a.(length a - 1); ()]. *) val iteri : f:(int -> 'a -> unit) -> 'a t -> unit (** [iteri ~f a] is like {!iter}, but the function [~f] is applied with the index of the element as first argument, and the element itself as second argument. *) - + val blit : 'a t -> int -> 'a t -> int -> int -> unit (** [blit a1 o1 a2 o2 len] copies [len] elements from array [a1], starting at element number [o1], to array [a2], @@ -106,10 +108,12 @@ val reverse_in_place : 'a t -> unit (** [reverse_in_place a] reverses the array [a] in place. *) val sorted : f:('a -> 'a -> int) -> 'a t -> 'a array + (* FIXME: better label this ~cmp ?? *) (** [sorted ~f a] makes a copy of [a] and sorts it with [~f]. @since 1.0 *) val sort_indices : f:('a -> 'a -> int) -> 'a t -> int array + (* FIXME: better label this ~cmp ?? *) (** [sort_indices ~f a] returns a new array [b], with the same length as [a], such that [b.(i)] is the index at which the [i]-th element of [sorted ~f a] appears in [a]. [a] is not modified. @@ -119,6 +123,7 @@ val sort_indices : f:('a -> 'a -> int) -> 'a t -> int array @since 1.0 *) val sort_ranking : f:('a -> 'a -> int) -> 'a t -> int array + (* FIXME: better label this ~cmp ?? *) (** [sort_ranking ~f a] returns a new array [b], with the same length as [a], such that [b.(i)] is the index at which the [i]-th element of [a] appears in [sorted ~f a]. [a] is not modified. @@ -133,39 +138,45 @@ val sort_ranking : f:('a -> 'a -> int) -> 'a t -> int array val find_map : f:('a -> 'b option) -> 'a t -> 'b option (** [find_map ~f a] returns [Some y] if there is an element [x] such that [~f x = Some y]. Otherwise returns [None]. - @since 2.1 *) + @since 1.3, but only + @since 2.1 with labels *) val find : f:('a -> 'b option) -> 'a t -> 'b option (** [find ~f a] is an alias to {!find_map}. + @deprecated since 1.3, use {!find_map} instead. + The version with labels is @deprecated since 2.1, use {!find_map} instead. *) val find_map_i : f:(int -> 'a -> 'b option) -> 'a t -> 'b option (** [find_map_i ~f a] is like {!find_map}, but the index of the element is also passed to the predicate function [~f]. - @since 2.1 *) + @since 1.3, but only + @since 2.1 with labels *) val findi : f:(int -> 'a -> 'b option) -> 'a t -> 'b option (** [findi ~f a] is an alias to {!find_map_i}. @since 0.3.4 - @deprecated since 2.1, use {!find_map_i} instead. *) + @deprecated since 1.3, use {!find_map} instead. + The version with labels is + @deprecated since 2.1, use {!find_map} instead. *) val find_idx : f:('a -> bool) -> 'a t -> (int * 'a) option (** [find_idx ~f a] returns [Some (i,x)] where [x] is the [i]-th element of [a], and [~f x] holds. Otherwise returns [None]. @since 0.3.4 *) -val lookup : cmp:'a ord -> key:'a -> 'a t -> int option +val lookup : cmp:('a ord [@keep_label]) -> key:'a -> 'a t -> int option (** [lookup ~cmp ~key a] lookups the index of some key [~key] in a sorted array [a]. Undefined behavior if the array [a] is not sorted wrt [~cmp]. Complexity: [O(log (n))] (dichotomic search). @return [None] if the key [~key] is not present, or [Some i] ([i] the index of the key) otherwise. *) -val lookup_exn : cmp:'a ord -> key:'a -> 'a t -> int +val lookup_exn : cmp:('a ord [@keep_label]) -> key:'a -> 'a t -> int (** [lookup_exn ~cmp ~key a] is like {!lookup}, but @raise Not_found if the key [~key] is not present. *) -val bsearch : cmp:('a -> 'a -> int) -> key:'a -> 'a t -> +val bsearch : cmp:(('a -> 'a -> int) [@keep_label]) -> key:'a -> 'a t -> [ `All_lower | `All_bigger | `Just_after of int | `Empty | `At of int ] (** [bsearch ~cmp ~key a] finds the index of the object [~key] in the array [a], provided [a] is {b sorted} using [~cmp]. If the array is not sorted, @@ -270,8 +281,8 @@ val map2 : f:('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t and builds an array with the results returned by [~f]: [[| ~f a.(0) b.(0); ...; ~f a.(length a - 1) b.(length b - 1)|]]. - @raise Invalid_argument if [a] and [b] have distinct lengths. - @since 0.20 *) + @raise Invalid_argument if [a] and [b] have distinct lengths. + @since 0.20 *) val rev : 'a t -> 'a t (** [rev a] copies the array [a] and reverses it in place. @@ -330,8 +341,7 @@ end val sort_generic : (module MONO_ARRAY with type t = 'arr and type elt = 'elt) -> - cmp:('elt -> 'elt -> int) -> 'arr -> unit + cmp:(('elt -> 'elt -> int) [@keep_label]) -> 'arr -> unit (** [sort_generic (module M) ~cmp a] sorts the array [a], without allocating (eats stack space though). Performance might be lower than {!Array.sort}. @since 0.14 *) - diff --git a/src/core/CCList.ml b/src/core/CCList.ml index af60128c..395e9df7 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -968,7 +968,7 @@ let find_idx p l = find_mapi (fun i x -> if p x then Some (i, x) else None) l find_map (fun x -> if x=3 then Some "a" else None) [1;2;4;5] = None *) -let remove ~eq ~x l = +let remove ~eq x l = let rec remove' eq x acc l = match l with | [] -> List.rev acc | y :: tail when eq x y -> remove' eq x acc tail @@ -977,8 +977,8 @@ let remove ~eq ~x l = remove' eq x [] l (*$T - remove ~eq:CCInt.equal ~x:1 [2;1;3;3;2;1] = [2;3;3;2] - remove ~eq:CCInt.equal ~x:10 [1;2;3] = [1;2;3] + remove ~eq:CCInt.equal 1 [2;1;3;3;2;1] = [2;3;3;2] + remove ~eq:CCInt.equal 10 [1;2;3] = [1;2;3] *) let filter_map f l = @@ -1483,7 +1483,7 @@ module Assoc = struct not (Assoc.mem ~eq:CCInt.equal 4 [1,"1"; 2,"2"; 3, "3"]) *) - let update ~eq ~f x l = + let update ~eq f x l = search_set eq [] l x ~f:(fun x opt_y rest -> match f opt_y with @@ -1492,13 +1492,13 @@ module Assoc = struct (*$= [1,"1"; 2,"22"] \ (Assoc.update ~eq:CCInt.equal \ - ~f:(function Some "2" -> Some "22" | _ -> assert false) 2 [1,"1"; 2,"2"] |> lsort) + (function Some "2" -> Some "22" | _ -> assert false) 2 [1,"1"; 2,"2"] |> lsort) [1,"1"; 3,"3"] \ (Assoc.update ~eq:CCInt.equal \ - ~f:(function Some "2" -> None | _ -> assert false) 2 [1,"1"; 2,"2"; 3,"3"] |> lsort) + (function Some "2" -> None | _ -> assert false) 2 [1,"1"; 2,"2"; 3,"3"] |> lsort) [1,"1"; 2,"2"; 3,"3"] \ (Assoc.update ~eq:CCInt.equal \ - ~f:(function None -> Some "3" | _ -> assert false) 3 [1,"1"; 2,"2"] |> lsort) + (function None -> Some "3" | _ -> assert false) 3 [1,"1"; 2,"2"] |> lsort) *) let remove ~eq x l = diff --git a/src/core/CCList.mli b/src/core/CCList.mli index b8277b92..b0146c5a 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -1,3 +1,5 @@ +(* AUTOGENERATED FROM CCListLabels.mli *) + (* This file is free software, part of containers. See file "license" for more details. *) @@ -61,14 +63,15 @@ val fold_while : ('a -> 'b -> 'a * [`Stop | `Continue]) -> 'a -> 'b t -> 'a @since 0.8 *) val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a list -> 'acc * 'b list -(** [fold_map f acc l] is a [fold_left]-like function, but it also maps the +(** [fold_map f init l] is a [fold_left]-like function, but it also maps the list to another list. @since 0.14 *) val scan_left : ('acc -> 'a -> 'acc) -> 'acc -> 'a list -> 'acc list -(** [scan_left f acc l] returns the list [[acc; f acc x0; f (f acc x0) x1; ...]] +(** [scan_left f init l] returns the list [[init; f init x0; f (f init x0) x1; ...]] where [x0], [x1], etc. are the elements of [l]. - @since 1.2 *) + @since 1.2, but only + @since 2.2 with labels *) val fold_map2 : ('acc -> 'a -> 'b -> 'acc * 'c) -> 'acc -> 'a list -> 'b list -> 'acc * 'c list (** [fold_map2] is to [fold_map] what [List.map2] is to [List.map]. @@ -76,7 +79,7 @@ val fold_map2 : ('acc -> 'a -> 'b -> 'acc * 'c) -> 'acc -> 'a list -> 'b list -> @since 0.16 *) val fold_filter_map : ('acc -> 'a -> 'acc * 'b option) -> 'acc -> 'a list -> 'acc * 'b list -(** [fold_filter_map f acc l] is a [fold_left]-like function, but also +(** [fold_filter_map f init l] is a [fold_left]-like function, but also generates a list of output in a way similar to {!filter_map}. @since 0.17 *) @@ -87,12 +90,11 @@ val fold_flat_map : ('acc -> 'a -> 'acc * 'b list) -> 'acc -> 'a list -> 'acc * val count : ('a -> bool) -> 'a list -> int (** [count p l] counts how many elements of [l] satisfy predicate [p]. - @since 1.5 *) + @since 1.5, but only + @since 2.2 with labels *) val count_true_false : ('a -> bool) -> 'a list -> int * int -(** [let ok_count, ko_count = count_true_false p l in ...] - count_true_false how many elements of [l] satisfy (resp. violate) predicate [p]. - @since NEXT_RELEASE *) +(** @since NEXT_RELEASE *) val init : int -> (int -> 'a) -> 'a t (** [init len f] is [f 0; f 1; ...; f (len-1)]. @@ -105,31 +107,37 @@ val combine : 'a list -> 'b list -> ('a * 'b) list [combine [a1; ...; an] [b1; ...; bn]] is [[(a1,b1); ...; (an,bn)]]. @raise Invalid_argument if the lists have distinct lengths. - @since 1.2 *) + @since 1.2, but only + @since 2.2 with labels *) val combine_gen : 'a list -> 'b list -> ('a * 'b) gen (** Lazy version of {!combine}. Unlike {!combine}, it does not fail if the lists have different lengths; instead, the output has as many pairs as the smallest input list. - @since 1.2 *) + @since 1.2, but only + @since 2.2 with labels *) val split : ('a * 'b) t -> 'a t * 'b t (** A tail-recursive version of {!List.split}. Transform a list of pairs into a pair of lists: - [split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])]. *) + [split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])]. + @since 1.2, but only + @since 2.2 with labels *) val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int val compare_lengths : 'a t -> 'b t -> int (** Equivalent to [compare (length l1) (length l2)] but more efficient. Compare the lengths of two lists. - @since 1.5 *) + @since 1.5, but only + @since 2.2 with labels *) val compare_length_with : 'a t -> int -> int (** Equivalent to [compare (length l) x] but more efficient. Compare the length of a list to an integer. - @since 1.5 *) + @since 1.5, but only + @since 2.2 with labels *) val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool @@ -158,14 +166,16 @@ val cartesian_product : 'a t t -> 'a t t [[1;3;4;5;6];[2;3;4;5;6]];; ]} invariant: [cartesian_product l = map_product id l]. - @since 1.2 *) + @since 1.2, but only + @since 2.2 with labels *) val map_product_l : ('a -> 'b list) -> 'a list -> 'b list list (** [map_product_l f l] maps each element of [l] to a list of objects of type ['b] using [f]. We obtain [[l1;l2;...;ln]] where [length l=n] and [li : 'b list]. Then, it returns all the ways of picking exactly one element per [li]. - @since 1.2 *) + @since 1.2, but only + @since 2.2 with labels *) val diagonal : 'a t -> ('a * 'a) t (** All pairs of distinct positions of the list. [list_diagonal l] will @@ -263,16 +273,21 @@ val sublists_of_len : If [last = CCOpt.return], it will simply keep the last group. By default, [last = fun _ -> None], i.e. the last group is dropped if shorter than [n]. @raise Invalid_argument if [offset <= 0] or [n <= 0]. - @since 1.0 *) + See {!CCList.sublists_of_len} for more details. + + @since 1.0, but only + @since 1.5 with labels *) val intersperse : 'a -> 'a list -> 'a list (** Insert the first argument between every element of the list. - @since 2.1 *) + @since 2.1, but only + @since 2.2 with labels *) val interleave : 'a list -> 'a list -> 'a list (** [interleave [x1…xn] [y1…ym]] is [x1,y1,x2,y2,…] and finishes with the suffix of the longest list. - @since 2.1 *) + @since 2.1, but only + @since 2.2 with labels *) val pure : 'a -> 'a t (** [pure] is [return]. *) @@ -281,7 +296,7 @@ val (<*>) : ('a -> 'b) t -> 'a t -> 'b t (** [funs <*> l] is [product (fun f x -> f x) funs l]. *) val (<$>) : ('a -> 'b) -> 'a t -> 'b t -(** [(<$>)] = [map]. *) +(** [(<$>)] is [map]. *) val return : 'a -> 'a t (** [return x] is [x]. *) @@ -314,7 +329,8 @@ val drop_while : ('a -> bool) -> 'a t -> 'a t val take_drop_while : ('a -> bool) -> 'a t -> 'a t * 'a t (** [take_drop_while p l] = [take_while p l, drop_while p l]. - @since 1.2 *) + @since 1.2, but only + @since 2.2 with labels *) val last : int -> 'a t -> 'a t (** [last n l] takes the last [n] elements of [l] (or less if @@ -339,7 +355,8 @@ val find_pred : ('a -> bool) -> 'a t -> 'a option val find_opt : ('a -> bool) -> 'a t -> 'a option (** Safe version of {!find}. - @since 1.5 *) + @since 1.5, but only + @since 2.2 with labels *) val find_pred_exn : ('a -> bool) -> 'a t -> 'a (** Unsafe version of {!find_pred}. @@ -360,8 +377,9 @@ val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option (** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l], and [p x] holds. Otherwise returns [None]. *) -val remove : eq:('a -> 'a -> bool) -> x:'a -> 'a t -> 'a t -(** [remove ~x l] removes every instance of [x] from [l]. Tail-recursive. +val remove : eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t + (* FIXME: the original CCList.mli uses ~x instead of ~key !! *) +(** [remove key l] removes every instance of [key] from [l]. Tail-recursive. @param eq equality function. @since 0.11 *) @@ -373,21 +391,25 @@ val filter_map : ('a -> 'b option) -> 'a t -> 'b t val keep_some : 'a option t -> 'a t (** [keep_some l] retains only elements of the form [Some x]. Like [filter_map CCFun.id]. - @since 1.3 *) + @since 1.3, but only + @since 2.2 with labels *) val keep_ok : ('a, _) Result.result t -> 'a t (** [keep_ok l] retains only elements of the form [Ok x]. - @since 1.3 *) + @since 1.3, but only + @since 2.2 with labels *) val all_some : 'a option t -> 'a t option (** [all_some l] returns [Some l'] if all elements of [l] are of the form [Some x], or [None] otherwise. - @since 1.3 *) + @since 1.3, but only + @since 2.2 with labels *) val all_ok : ('a, 'err) Result.result t -> ('a t, 'err) Result.result (** [all_ok l] returns [Ok l'] if all elements of [l] are of the form [Ok x], or [Error e] otherwise (with the first error met). - @since 1.3 *) + @since 1.3, but only + @since 2.2 with labels *) val sorted_merge : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list (** Merge elements from both sorted list. *) @@ -439,7 +461,8 @@ val iteri : (int -> 'a -> unit) -> 'a t -> unit val iteri2 : (int -> 'a -> 'b -> unit) -> 'a t -> 'b t -> unit (** Iter on two lists. @raise Invalid_argument when lists do not have the same length. - @since 2.0 *) + @since 2.0, but only + @since 2.2 with labels *) val foldi : ('b -> int -> 'a -> 'b) -> 'b -> 'a t -> 'b (** Like [fold] but it also passes in the index of each element to the folded function. Tail-recursive. *) @@ -447,7 +470,8 @@ val foldi : ('b -> int -> 'a -> 'b) -> 'b -> 'a t -> 'b val foldi2 : ('c -> int -> 'a -> 'b -> 'c) -> 'c -> 'a t -> 'b t -> 'c (** Fold on two lists, with index. @raise Invalid_argument when lists do not have the same length. - @since 2.0 *) + @since 2.0, but only + @since 2.2 with labels *) val get_at_idx : int -> 'a t -> 'a option (** Get by index in the list. @@ -457,7 +481,8 @@ val get_at_idx : int -> 'a t -> 'a option val nth_opt : 'a t -> int -> 'a option (** Safe version of {!nth}. @raise Invalid_argument if the int is negative. - @since 1.5 *) + @since 1.5, but only + @since 2.2 with labels *) val get_at_idx_exn : int -> 'a t -> 'a (** Get the i-th element, or @@ -564,8 +589,9 @@ module Assoc : sig @since 0.16 *) val update : - eq:('a->'a->bool) -> f:('b option -> 'b option) -> 'a -> ('a,'b) t -> ('a,'b) t - (** [update k ~f l] updates [l] on the key [k], by calling [f (get l k)] + eq:('a->'a->bool) -> ('b option -> 'b option) -> 'a -> ('a,'b) t -> ('a,'b) t + (* FIXME: the original no labels mli kept the ~f label ! *) + (** [update k f l] updates [l] on the key [k], by calling [f (get l k)] and removing [k] if it returns [None], mapping [k] to [v'] if it returns [Some v']. @since 0.16 *) @@ -581,11 +607,13 @@ val assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> 'b val assoc_opt : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> 'b option (** Like [Assoc.get]. - @since 1.5 *) + @since 1.5, but only + @since 2.0 with labels *) val assq_opt : 'a -> ('a * 'b) t -> 'b option (** Safe version of {!assq}. - @since 1.5 *) + @since 1.5, but only + @since 2.0 with labels *) val mem_assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * _) t -> bool (** Like [Assoc.mem]. diff --git a/src/core/CCListLabels.mli b/src/core/CCListLabels.mli index c3372361..e1c96192 100644 --- a/src/core/CCListLabels.mli +++ b/src/core/CCListLabels.mli @@ -66,7 +66,10 @@ val fold_map : f:('acc -> 'a -> 'acc * 'b) -> init:'acc -> 'a list -> 'acc * 'b @since 0.14 *) val scan_left : f:('acc -> 'a -> 'acc) -> init:'acc -> 'a list -> 'acc list -(** @since 2.2 *) +(** [scan_left ~f ~init l] returns the list [[init; f init x0; f (f init x0) x1; ...]] + where [x0], [x1], etc. are the elements of [l]. + @since 1.2, but only + @since 2.2 with labels *) val fold_map2 : f:('acc -> 'a -> 'b -> 'acc * 'c) -> init:'acc -> 'a list -> 'b list -> 'acc * 'c list (** [fold_map2] is to [fold_map] what [List.map2] is to [List.map]. @@ -84,7 +87,9 @@ val fold_flat_map : f:('acc -> 'a -> 'acc * 'b list) -> init:'acc -> 'a list -> @since 0.14 *) val count : f:('a -> bool) -> 'a list -> int -(** @since 2.2 *) +(** [count p l] counts how many elements of [l] satisfy predicate [p]. + @since 1.5, but only + @since 2.2 with labels *) val count_true_false : f:('a -> bool) -> 'a list -> int * int (** @since NEXT_RELEASE *) @@ -95,21 +100,42 @@ val init : int -> f:(int -> 'a) -> 'a t @since 0.6 *) val combine : 'a list -> 'b list -> ('a * 'b) list -(** @since 2.2 *) +(** Like {!List.combine} but tail-recursive. + Transform a pair of lists into a list of pairs: + [combine [a1; ...; an] [b1; ...; bn]] is + [[(a1,b1); ...; (an,bn)]]. + @raise Invalid_argument if the lists have distinct lengths. + @since 1.2, but only + @since 2.2 with labels *) val combine_gen : 'a list -> 'b list -> ('a * 'b) gen -(** @since 2.2 *) +(** Lazy version of {!combine}. + Unlike {!combine}, it does not fail if the lists have different + lengths; + instead, the output has as many pairs as the smallest input list. + @since 1.2, but only + @since 2.2 with labels *) val split : ('a * 'b) t -> 'a t * 'b t -(** @since 2.2 *) +(** A tail-recursive version of {!List.split}. + Transform a list of pairs into a pair of lists: + [split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])]. + @since 1.2, but only + @since 2.2 with labels *) val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int val compare_lengths : 'a t -> 'b t -> int -(** @since 2.2 *) +(** Equivalent to [compare (length l1) (length l2)] but more efficient. + Compare the lengths of two lists. + @since 1.5, but only + @since 2.2 with labels *) val compare_length_with : 'a t -> int -> int -(** @since 2.2 *) +(** Equivalent to [compare (length l) x] but more efficient. + Compare the length of a list to an integer. + @since 1.5, but only + @since 2.2 with labels *) val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool @@ -126,10 +152,28 @@ val fold_product : f:('c -> 'a -> 'b -> 'c) -> init:'c -> 'a t -> 'b t -> 'c (** Fold on the cartesian product. *) val cartesian_product : 'a t t -> 'a t t -(** @since 2.2 *) +(** Produce the cartesian product of this list of lists, + by returning all the ways of picking one element per sublist. + {b NOTE} the order of the returned list is unspecified. + For example: + {[ + # cartesian_product [[1;2];[3];[4;5;6]] |> sort = + [[1;3;4];[1;3;5];[1;3;6];[2;3;4];[2;3;5];[2;3;6]];; + # cartesian_product [[1;2];[];[4;5;6]] = [];; + # cartesian_product [[1;2];[3];[4];[5];[6]] |> sort = + [[1;3;4;5;6];[2;3;4;5;6]];; + ]} + invariant: [cartesian_product l = map_product id l]. + @since 1.2, but only + @since 2.2 with labels *) val map_product_l : f:('a -> 'b list) -> 'a list -> 'b list list -(** @since 2.2 *) +(** [map_product_l f l] maps each element of [l] to a list of + objects of type ['b] using [f]. + We obtain [[l1;l2;...;ln]] where [length l=n] and [li : 'b list]. + Then, it returns all the ways of picking exactly one element per [li]. + @since 1.2, but only + @since 2.2 with labels *) val diagonal : 'a t -> ('a * 'a) t (** All pairs of distinct positions of the list. [list_diagonal l] will @@ -149,7 +193,7 @@ val group_by : ?hash:('a -> int) -> ?eq:('a -> 'a -> bool) -> precondition: for any [x] and [y], if [eq x y] then [hash x=hash y] must hold. @since 2.3 *) -val join : join_row:('a -> 'b -> 'c option) -> 'a t -> 'b t -> 'c t +val join : join_row:(('a -> 'b -> 'c option) [@keep_label]) -> 'a t -> 'b t -> 'c t (** [join ~join_row a b] combines every element of [a] with every element of [b] using [join_row]. If [join_row] returns None, then the two elements do not combine. Assume that [b] allows for multiple @@ -158,7 +202,7 @@ val join : join_row:('a -> 'b -> 'c option) -> 'a t -> 'b t -> 'c t val join_by : ?eq:('key -> 'key -> bool) -> ?hash:('key -> int) -> ('a -> 'key) -> ('b -> 'key) -> - merge:('key -> 'a -> 'b -> 'c option) -> + merge:(('key -> 'a -> 'b -> 'c option) [@keep_label]) -> 'a t -> 'b t -> 'c t @@ -173,7 +217,7 @@ val join_by : ?eq:('key -> 'key -> bool) -> ?hash:('key -> int) -> val join_all_by : ?eq:('key -> 'key -> bool) -> ?hash:('key -> int) -> ('a -> 'key) -> ('b -> 'key) -> - merge:('key -> 'a list -> 'b list -> 'c option) -> + merge:(('key -> 'a list -> 'b list -> 'c option) [@keep_label]) -> 'a t -> 'b t -> 'c t @@ -201,7 +245,6 @@ val group_join_by : ?eq:('a -> 'a -> bool) -> ?hash:('a -> int) -> precondition: for any [x] and [y], if [eq x y] then [hash x=hash y] must hold. @since 2.3 *) - val sublists_of_len : ?last:('a list -> 'a list option) -> ?offset:int -> @@ -212,24 +255,43 @@ val sublists_of_len : By default, these sub-lists are non overlapping: [sublists_of_len 2 [1;2;3;4;5;6]] returns [[1;2]; [3;4]; [5;6]]. + Examples: + + - [sublists_of_len 2 [1;2;3;4;5;6] = [[1;2]; [3;4]; [5;6]]]. + - [sublists_of_len 2 ~offset:3 [1;2;3;4;5;6] = [1;2];[4;5]]. + - [sublists_of_len 3 ~last:CCOpt.return [1;2;3;4] = [1;2;3];[4]]. + - [sublists_of_len 2 [1;2;3;4;5] = [[1;2]; [3;4]]]. + + @param offset the number of elements skipped between two consecutive + sub-lists. By default it is [n]. If [offset < n], the sub-lists + will overlap; if [offset > n], some elements will not appear at all. + @param last if provided and the last group of elements [g] is such + that [length g < n], [last g] is called. If [last g = Some g'], + [g'] is appended; otherwise [g] is dropped. + If [last = CCOpt.return], it will simply keep the last group. + By default, [last = fun _ -> None], i.e. the last group is dropped if shorter than [n]. + @raise Invalid_argument if [offset <= 0] or [n <= 0]. See {!CCList.sublists_of_len} for more details. - @since 1.5 *) + @since 1.0, but only + @since 1.5 with labels *) val intersperse : x:'a -> 'a list -> 'a list (** Insert the first argument between every element of the list. - @since 2.2 *) + @since 2.1, but only + @since 2.2 with labels *) val interleave : 'a list -> 'a list -> 'a list (** [interleave [x1…xn] [y1…ym]] is [x1,y1,x2,y2,…] and finishes with the suffix of the longest list. - @since 2.2 *) + @since 2.1, but only + @since 2.2 with labels *) val pure : 'a -> 'a t (** [pure] is [return]. *) val (<*>) : ('a -> 'b) t -> 'a t -> 'b t -(** [funs <*> l] is [product fun f x -> f x) funs l]. *) +(** [funs <*> l] is [product (fun f x -> f x) funs l]. *) val (<$>) : ('a -> 'b) -> 'a t -> 'b t (** [(<$>)] is [map]. *) @@ -264,7 +326,9 @@ val drop_while : f:('a -> bool) -> 'a t -> 'a t @since 0.13 *) val take_drop_while : f:('a -> bool) -> 'a t -> 'a t * 'a t -(** @since 2.2 *) +(** [take_drop_while p l] = [take_while p l, drop_while p l]. + @since 1.2, but only + @since 2.2 with labels *) val last : int -> 'a t -> 'a t (** [last n l] takes the last [n] elements of [l] (or less if @@ -288,7 +352,9 @@ val find_pred : f:('a -> bool) -> 'a t -> 'a option @since 0.11 *) val find_opt : f:('a -> bool) -> 'a t -> 'a option -(** @since 2.2 *) +(** Safe version of {!find}. + @since 1.5, but only + @since 2.2 with labels *) val find_pred_exn : f:('a -> bool) -> 'a t -> 'a (** Unsafe version of {!find_pred}. @@ -309,7 +375,8 @@ val find_idx : f:('a -> bool) -> 'a t -> (int * 'a) option (** [find_idx p x] returns [Some (i,x)] where [x] is the [i]-th element of [l], and [p x] holds. Otherwise returns [None]. *) -val remove : eq:('a -> 'a -> bool) -> key:'a -> 'a t -> 'a t +val remove : eq:(('a -> 'a -> bool) [@keep_label]) -> key:'a -> 'a t -> 'a t + (* FIXME: the original CCList.mli uses ~x instead of ~key !! *) (** [remove ~key l] removes every instance of [key] from [l]. Tail-recursive. @param eq equality function. @since 0.11 *) @@ -320,48 +387,59 @@ val filter_map : f:('a -> 'b option) -> 'a t -> 'b t Map and remove elements at the same time. *) val keep_some : 'a option t -> 'a t -(** @since 2.2 *) +(** [keep_some l] retains only elements of the form [Some x]. + Like [filter_map CCFun.id]. + @since 1.3, but only + @since 2.2 with labels *) val keep_ok : ('a, _) Result.result t -> 'a t -(** @since 2.2 *) +(** [keep_ok l] retains only elements of the form [Ok x]. + @since 1.3, but only + @since 2.2 with labels *) val all_some : 'a option t -> 'a t option -(** @since 2.2 *) +(** [all_some l] returns [Some l'] if all elements of [l] are of the form [Some x], + or [None] otherwise. + @since 1.3, but only + @since 2.2 with labels *) val all_ok : ('a, 'err) Result.result t -> ('a t, 'err) Result.result -(** @since 2.2 *) +(** [all_ok l] returns [Ok l'] if all elements of [l] are of the form [Ok x], + or [Error e] otherwise (with the first error met). + @since 1.3, but only + @since 2.2 with labels *) -val sorted_merge : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list -(** Merges elements from both sorted list. *) +val sorted_merge : cmp:(('a -> 'a -> int) [@keep_label]) -> 'a list -> 'a list -> 'a list +(** Merge elements from both sorted list. *) -val sort_uniq : cmp:('a -> 'a -> int) -> 'a list -> 'a list +val sort_uniq : cmp:(('a -> 'a -> int) [@keep_label]) -> 'a list -> 'a list (** Sort the list and remove duplicate elements. *) -val sorted_merge_uniq : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list +val sorted_merge_uniq : cmp:(('a -> 'a -> int) [@keep_label]) -> 'a list -> 'a list -> 'a list (** [sorted_merge_uniq l1 l2] merges the sorted lists [l1] and [l2] and removes duplicates. @since 0.10 *) -val is_sorted : cmp:('a -> 'a -> int) -> 'a list -> bool +val is_sorted : cmp:(('a -> 'a -> int) [@keep_label]) -> 'a list -> bool (** [is_sorted l] returns [true] iff [l] is sorted (according to given order). @param cmp the comparison function (default [Pervasives.compare]). @since 0.17 *) -val sorted_insert : cmp:('a -> 'a -> int) -> ?uniq:bool -> 'a -> 'a list -> 'a list +val sorted_insert : cmp:(('a -> 'a -> int) [@keep_label]) -> ?uniq:bool -> 'a -> 'a list -> 'a list (** [sorted_insert x l] inserts [x] into [l] such that, if [l] was sorted, then [sorted_insert x l] is sorted too. @param uniq if true and [x] is already in sorted position in [l], then [x] is not duplicated. Default [false] ([x] will be inserted in any case). @since 0.17 *) -val uniq_succ : eq:('a -> 'a -> bool) -> 'a list -> 'a list +val uniq_succ : eq:(('a -> 'a -> bool) [@keep_label]) -> 'a list -> 'a list (** [uniq_succ l] removes duplicate elements that occur one next to the other. Examples: [uniq_succ [1;2;1] = [1;2;1]]. [uniq_succ [1;1;2] = [1;2]]. @since 0.10 *) -val group_succ : eq:('a -> 'a -> bool) -> 'a list -> 'a list list +val group_succ : eq:(('a -> 'a -> bool) [@keep_label]) -> 'a list -> 'a list list (** [group_succ ~eq l] groups together consecutive elements that are equal according to [eq]. @since 0.11 *) @@ -379,13 +457,19 @@ val iteri : f:(int -> 'a -> unit) -> 'a t -> unit itself as second argument. *) val iteri2 : f:(int -> 'a -> 'b -> unit) -> 'a t -> 'b t -> unit -(** @since 2.2 *) +(** Iter on two lists. + @raise Invalid_argument when lists do not have the same length. + @since 2.0, but only + @since 2.2 with labels *) val foldi : f:('b -> int -> 'a -> 'b) -> init:'b -> 'a t -> 'b (** Like [fold] but it also passes in the index of each element to the folded function. Tail-recursive. *) val foldi2 : f:('c -> int -> 'a -> 'b -> 'c) -> init:'c -> 'a t -> 'b t -> 'c -(** @since 2.2 *) +(** Fold on two lists, with index. + @raise Invalid_argument when lists do not have the same length. + @since 2.0, but only + @since 2.2 with labels *) val get_at_idx : int -> 'a t -> 'a option (** Get by index in the list. @@ -393,7 +477,10 @@ val get_at_idx : int -> 'a t -> 'a option of the list. *) val nth_opt : 'a t -> int -> 'a option -(** @since 2.2 *) +(** Safe version of {!nth}. + @raise Invalid_argument if the int is negative. + @since 1.5, but only + @since 2.2 with labels *) val get_at_idx_exn : int -> 'a t -> 'a (** Get the i-th element, or @@ -424,38 +511,38 @@ val remove_at_idx : int -> 'a t -> 'a t Those operations maintain the invariant that the list does not contain duplicates (if it already satisfies it). *) -val add_nodup : eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t +val add_nodup : eq:(('a -> 'a -> bool) [@keep_label]) -> 'a -> 'a t -> 'a t (** [add_nodup x set] adds [x] to [set] if it was not already present. Linear time. @since 0.11 *) -val remove_one : eq:('a -> 'a -> bool) -> 'a -> 'a t -> 'a t +val remove_one : eq:(('a -> 'a -> bool) [@keep_label]) -> 'a -> 'a t -> 'a t (** [remove_one x set] removes one occurrence of [x] from [set]. Linear time. @since 0.11 *) -val mem : eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool +val mem : eq:(('a -> 'a -> bool) [@keep_label]) -> 'a -> 'a t -> bool (** Membership to the list. Linear time. *) -val subset : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool +val subset : eq:(('a -> 'a -> bool) [@keep_label]) -> 'a t -> 'a t -> bool (** Test for inclusion. *) -val uniq : eq:('a -> 'a -> bool) -> 'a t -> 'a t +val uniq : eq:(('a -> 'a -> bool) [@keep_label]) -> 'a t -> 'a t (** Remove duplicates w.r.t the equality predicate. Complexity is quadratic in the length of the list, but the order of elements is preserved. If you wish for a faster de-duplication but do not care about the order, use {!sort_uniq}. *) -val union : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t +val union : eq:(('a -> 'a -> bool) [@keep_label]) -> 'a t -> 'a t -> 'a t (** List union. Complexity is product of length of inputs. *) -val inter : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t +val inter : eq:(('a -> 'a -> bool) [@keep_label]) -> 'a t -> 'a t -> 'a t (** List intersection. Complexity is product of length of inputs. *) (** {2 Other Constructors} *) -val range_by : step:int -> int -> int -> int t +val range_by : step:(int [@keep_label]) -> int -> int -> int t (** [range_by ~step i j] iterates on integers from [i] to [j] included, where the difference between successive elements is [step]. - use a negative [step] for a decreasing list. + Use a negative [step] for a decreasing list. @raise Invalid_argument if [step=0]. @since 0.18 *) @@ -485,49 +572,52 @@ val repeat : int -> 'a t -> 'a t module Assoc : sig type ('a, 'b) t = ('a*'b) list - val get : eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b option + val get : eq:(('a->'a->bool) [@keep_label]) -> 'a -> ('a,'b) t -> 'b option (** Find the element. *) - val get_exn : eq:('a->'a->bool) -> 'a -> ('a,'b) t -> 'b + val get_exn : eq:(('a->'a->bool) [@keep_label]) -> 'a -> ('a,'b) t -> 'b (** Like [get], but unsafe. @raise Not_found if the element is not present. *) - val set : eq:('a->'a->bool) -> 'a -> 'b -> ('a,'b) t -> ('a,'b) t + val set : eq:(('a->'a->bool) [@keep_label]) -> 'a -> 'b -> ('a,'b) t -> ('a,'b) t (** Add the binding into the list (erase it if already present). *) - val mem : eq:('a->'a->bool) -> 'a -> ('a,_) t -> bool + val mem : eq:(('a->'a->bool) [@keep_label]) -> 'a -> ('a,_) t -> bool (** [mem x l] returns [true] iff [x] is a key in [l]. @since 0.16 *) val update : - eq:('a->'a->bool) -> f:('b option -> 'b option) -> 'a -> ('a,'b) t -> ('a,'b) t + eq:(('a->'a->bool) [@keep_label]) -> f:('b option -> 'b option) -> 'a -> ('a,'b) t -> ('a,'b) t + (* FIXME: the original no labels mli kept the ~f label ! *) (** [update k ~f l] updates [l] on the key [k], by calling [f (get l k)] and removing [k] if it returns [None], mapping [k] to [v'] if it returns [Some v']. @since 0.16 *) - val remove : eq:('a->'a->bool) -> 'a -> ('a,'b) t -> ('a,'b) t + val remove : eq:(('a->'a->bool) [@keep_label]) -> 'a -> ('a,'b) t -> ('a,'b) t (** [remove x l] removes the first occurrence of [k] from [l]. @since 0.17 *) end -val assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> 'b +val assoc : eq:(('a -> 'a -> bool) [@keep_label]) -> 'a -> ('a * 'b) t -> 'b (** Like [Assoc.get_exn]. @since 2.0 *) -val assoc_opt : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> 'b option +val assoc_opt : eq:(('a -> 'a -> bool) [@keep_label]) -> 'a -> ('a * 'b) t -> 'b option (** Like [Assoc.get]. - @since 2.0 *) + @since 1.5, but only + @since 2.0 with labels *) val assq_opt : 'a -> ('a * 'b) t -> 'b option (** Safe version of {!assq}. - @since 2.0 *) + @since 1.5, but only + @since 2.0 with labels *) -val mem_assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * _) t -> bool +val mem_assoc : eq:(('a -> 'a -> bool) [@keep_label]) -> 'a -> ('a * _) t -> bool (** Like [Assoc.mem]. @since 2.0 *) -val remove_assoc : eq:('a -> 'a -> bool) -> 'a -> ('a * 'b) t -> ('a * 'b) t +val remove_assoc : eq:(('a -> 'a -> bool) [@keep_label]) -> 'a -> ('a * 'b) t -> ('a * 'b) t (** Like [Assoc.remove]. @since 2.0 *) @@ -567,7 +657,6 @@ module type MONAD = sig val (>>=) : 'a t -> ('a -> 'b t) -> 'b t (** Monadic [bind]. *) - end module Traverse(M : MONAD) : sig @@ -599,19 +688,22 @@ val to_seq : 'a t -> 'a sequence (** Return a [sequence] of the elements of the list. *) val of_seq : 'a sequence -> 'a t -(** Build a list from a given [sequence]. *) +(** Build a list from a given [sequence]. + In the result, elements appear in the same order as they did in the source [sequence]. *) val to_gen : 'a t -> 'a gen (** Return a [gen] of the elements of the list. *) val of_gen : 'a gen -> 'a t -(** Build a list from a given [gen]. *) +(** Build a list from a given [gen]. + In the result, elements appear in the same order as they did in the source [gen]. *) val to_klist : 'a t -> 'a klist (** Return a [klist] of the elements of the list. *) val of_klist : 'a klist -> 'a t -(** Build a list from a given [klist]. *) +(** Build a list from a given [klist]. + In the result, elements appear in the same order as they did in the source [klist]. *) (** {2 Infix Operators} It is convenient to {!open CCList.Infix} to access the infix operators diff --git a/src/core/dune b/src/core/dune index 00101fdf..ad4b8831 100644 --- a/src/core/dune +++ b/src/core/dune @@ -1,3 +1,14 @@ +(rule + (targets CCArray.mli) + (deps CCArrayLabels.mli) + (mode promote) + (action (run ../unlabel.exe %{deps} %{targets}))) + +(rule + (targets CCList.mli) + (deps CCListLabels.mli) + (mode promote) + (action (run ../unlabel.exe %{deps} %{targets}))) (library (name containers) diff --git a/src/dune b/src/dune index 001e66a9..853054a2 100644 --- a/src/dune +++ b/src/dune @@ -1,12 +1,16 @@ - (executable (name mkflags) + (modules mkflags) (libraries dune.configurator)) +(executable + (name unlabel) + (modules unlabel) + (libraries str compiler-libs.common)) + (rule (targets flambda.flags) (mode fallback) (action (run ./mkflags.exe)) ) - diff --git a/src/unlabel.ml b/src/unlabel.ml new file mode 100644 index 00000000..a39d5d76 --- /dev/null +++ b/src/unlabel.ml @@ -0,0 +1,246 @@ +(* search for first occurence of pat in s *) +let rec search pat s pos = + let rec compare i = + if i >= String.length pat + then true + else if pat.[i] = s.[pos+i] + then compare (i+1) + else false + in + if pos > String.length s - String.length pat + then raise Not_found + else if compare 0 + then pos + else search pat s (pos+1) +;; + +(* search all non-overlapping occurences of pat in s *) +let search_all pat s = + let rec search_rest acc pos = + let next = + try Some (search pat s pos) with + Not_found -> None + in + match next with + | None -> acc + | Some pos -> search_rest (pos::acc) (pos + String.length pat) + in + List.rev (search_rest [] 0) +;; + +(* replase first occurence of pat with subst in s *) +let replace_first pat subst s = + let pos = search pat s 0 in + let patl = String.length pat + and substl = String.length subst in + let buf = Bytes.create (String.length s - patl + substl) in + Bytes.blit_string s 0 buf 0 pos; + Bytes.blit_string subst 0 buf pos substl; + Bytes.blit_string + s (pos + patl) + buf (pos + substl) + (String.length s - pos - patl); + Bytes.unsafe_to_string buf +;; + +(* replase first occurence of pat with subst in s *) +let replace_all pat subst s = + let pos = search_all pat s in + let patl = String.length pat + and substl = String.length subst in + let len = String.length s + List.length pos * (substl - patl) in + let buf = Bytes.create len in + let rec loop src_pos dst_pos = function + | [] -> + Bytes.blit_string s src_pos buf dst_pos (String.length s - src_pos) + | pat_pos :: tail -> + let headl = pat_pos - src_pos in + Bytes.blit_string s src_pos buf dst_pos headl; + Bytes.blit_string subst 0 buf (dst_pos + headl) substl; + loop + (src_pos + headl + patl) + (dst_pos + headl + substl) + tail + in loop 0 0 pos; + Bytes.unsafe_to_string buf +;; + +let match_closeparen s i = + assert (s.[i] = ')'); + let rec loop i count = + match s.[i] with + | '(' when count = 0 -> i + | '(' -> loop (i-1) (count-1) + | ')' -> loop (i-1) (count+1) + | _ -> loop (i-1) count + in loop (i-1) 0 +;; + +let slurp_file file = + let ch = open_in file in + let buf = Buffer.create (min 1024 (in_channel_length ch)) in + try + while true do Buffer.add_channel buf ch 4096 done; + assert false + with + | End_of_file -> + close_in ch; + Bytes.unsafe_to_string (Buffer.to_bytes buf) +;; + +let () = + assert (Array.length Sys.argv = 3); + let labelled_filename = Sys.argv.(1) in (* CCArrayLabels.mli *) + let unlabelled_filename = Sys.argv.(2) in (* CCArray.ml *) + let labelled_name = (* ArrayLabels *) + let basename = + Compenv.module_of_filename Format.err_formatter + labelled_filename + labelled_filename + in + assert (basename.[0] = 'C' && basename.[1] = 'C'); + String.sub basename 2 (String.length basename - 2) + in + let unlabelled_name = (* Array *) + replace_first "Labels" "" labelled_name + in + let labelled_text = slurp_file labelled_filename in + let lexbuf = Lexing.from_string labelled_text in + Location.init lexbuf labelled_filename; + let labelled_ast = Parse.interface lexbuf in + (* stack of replacements to perform on the labelled_text. + * perform them in one run later so that the character counts + * won't be affected by earlier replacements. *) + let replacements = ref [] in + (* function removing '~' from docstring attributes where appropriate. *) + let strip_attributes labels attributes = + List.iter + begin function + | ({ Asttypes.txt = "ocaml.doc"; _ }, + Parsetree.PStr [{pstr_loc = + { loc_start = {pos_cnum = start; _} + ; loc_end = {pos_cnum = stop; _} + ; _} + ; _ + }]) -> + let docstring = + List.fold_left + (fun docstring label -> + replace_all ("~" ^ label) label docstring) + (String.sub labelled_text start (stop-start)) + labels + in + replacements := (start, stop-start, docstring) :: !replacements + | _ -> () + end + attributes + in + let iterator = + let open Ast_iterator in + let open Parsetree in + { Ast_iterator.default_iterator with + value_description = begin fun iterator + { pval_name = { txt = _name; _ } + ; pval_type + ; pval_prim = _ + ; pval_attributes + ; pval_loc + } -> + let rec loop = function + (* match function type with label *) + | { ptyp_desc = Ptyp_arrow (Labelled label, left, right) + ; ptyp_loc = {loc_start = {Lexing.pos_cnum = start; _}; _} + ; ptyp_attributes + ; _} + when + (* check that the argument type is not marked with [@keep_label] *) + List.for_all + (fun ({Asttypes.txt; _}, _) -> txt <> "keep_label") + left.ptyp_attributes + -> + assert (label = String.sub labelled_text start (String.length label)); + let colon = String.index_from labelled_text start ':' in + (* remove label *) + replacements := (start, colon+1-start, "") :: !replacements; + (* remove labels from associated docstrings *) + strip_attributes [label] ptyp_attributes; + label :: loop right + | { ptyp_desc = Ptyp_arrow (_, _left, right); _} -> + loop right + | _ -> [] + in + let labels = loop pval_type in + strip_attributes labels pval_attributes; + iterator.attributes iterator pval_attributes; + iterator.location iterator pval_loc; + iterator.typ iterator pval_type; + end + ; attribute = begin fun iterator + ({Asttypes.txt + ; loc = + { loc_start = {pos_cnum = start; _} + ; loc_end = {pos_cnum = stop; _} + ; _} as loc + }, _) -> + if txt = "keep_label" + then begin + (* start and stop positions mark the location of only the label name. + * Therefore search for enclosing brackets. *) + let start = String.rindex_from labelled_text start '[' + and stop = String. index_from labelled_text stop ']' in + (* remove leading ' ', too *) + let start = + if labelled_text.[start-1] = ' ' then start-1 else start + in + (* if a closing paren follows, remove this and the matching paren, + * this will hopefully be the right thing to do. *) + let stop = + if labelled_text.[stop+1] = ')' + then + let openp = match_closeparen labelled_text (stop+1) in + replacements := (openp, 1, "") :: !replacements; + stop+1 + else + stop + in + replacements := (start, stop-start+1, "") :: !replacements; + end; + iterator.location iterator loc + end + } + in + iterator.signature iterator labelled_ast; + + (* sort replacements in ascending order. *) + let replacements = + List.sort (fun (p1,_,_) (p2,_,_) -> compare p1 p2) !replacements + in + + (* perform the replacements by blitting to a buffer. *) + let unlabelled_text = Buffer.create (String.length labelled_text) in + List.fold_left begin fun start (pos,len,subst) -> + assert (pos >= start); + Buffer.add_substring unlabelled_text labelled_text start (pos - start); + Buffer.add_string unlabelled_text subst; + pos+len + end + 0 + replacements + |> fun start -> + Buffer.add_substring unlabelled_text + labelled_text start (String.length labelled_text - start); + + let unlabelled_text = + Buffer.contents unlabelled_text + (* CCArrayLabels -> CCArray *) + |> replace_all labelled_name unlabelled_name + in + + let out = open_out unlabelled_filename in + output_string out ( + "(* AUTOGENERATED FROM " ^ + labelled_filename + ^ " *)\n\n"); + output_string out unlabelled_text; + close_out out; +;;