fix: use shims again for CCList.(and&)

This commit is contained in:
Simon Cruanes 2020-11-13 12:46:59 -05:00
parent 9068cbc1cc
commit ca7801a854
4 changed files with 54 additions and 33 deletions

View file

@ -1809,10 +1809,12 @@ module Infix = struct
type 'a t = 'a list type 'a t = 'a list
let (>|=) = (>|=) let (>|=) = (>|=)
let (>>=) = (>>=) let (>>=) = (>>=)
let[@inline] monoid_product l1 l2 = product (fun x y -> x,y) l1 l2 let[@inline] monoid_product l1 l2 = product (fun x y -> x,y) l1 l2
end)
include CCShimsMkLetList_.Make(struct
let combine_shortest=combine_shortest
end) end)
let (and&) = combine_shortest
end end
include Infix include Infix

View file

@ -49,7 +49,7 @@ val filter : ('a -> bool) -> 'a t -> 'a t
that satisfy the predicate [p]. The order of the elements that satisfy the predicate [p]. The order of the elements
in the input list [l] is preserved. in the input list [l] is preserved.
Safe version of {!List.filter}. *) Safe version of {!List.filter}. *)
val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b
(** [fold_right f [a1; …; an] b] is (** [fold_right f [a1; …; an] b] is
[f a1 (f a2 ( (f an b) ))]. [f a1 (f a2 ( (f an b) ))].
@ -140,7 +140,7 @@ val combine_gen : 'a list -> 'b list -> ('a * 'b) gen
val combine_shortest : 'a list -> 'b list -> ('a * 'b) list val combine_shortest : 'a list -> 'b list -> ('a * 'b) list
(** [combine_shortest [a1; …; am] [b1; …; bn]] is [[(a1,b1); …; (am,bm)]] if m <= n. (** [combine_shortest [a1; …; am] [b1; …; bn]] is [[(a1,b1); …; (am,bm)]] if m <= n.
Like {!combine} but stops at the shortest list rather than raising. Like {!combine} but stops at the shortest list rather than raising.
@since 3.1 *) @since 3.1 *)
val split : ('a * 'b) t -> 'a t * 'b t val split : ('a * 'b) t -> 'a t * 'b t
@ -178,14 +178,14 @@ val flat_map_i : (int -> 'a -> 'b t) -> 'a t -> 'b t
@since 2.8 *) @since 2.8 *)
val flatten : 'a t t -> 'a t val flatten : 'a t t -> 'a t
(** [flatten [l1]; [l2]; …] concatenates a list of lists. (** [flatten [l1]; [l2]; …] concatenates a list of lists.
Safe version of {!List.flatten}. *) Safe version of {!List.flatten}. *)
val product : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t val product : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** [product comb l1 l2] computes the cartesian product of the two lists, with the given combinator [comb]. *) (** [product comb l1 l2] computes the cartesian product of the two lists, with the given combinator [comb]. *)
val fold_product : ('c -> 'a -> 'b -> 'c) -> 'c -> 'a t -> 'b t -> 'c val fold_product : ('c -> 'a -> 'b -> 'c) -> 'c -> 'a t -> 'b t -> 'c
(** [fold_product f init l1 l2] applies the function [f] with the accumulator [init] on all (** [fold_product f init l1 l2] applies the function [f] with the accumulator [init] on all
the pair of elements of [l1] and [l2]. Fold on the cartesian product. *) the pair of elements of [l1] and [l2]. Fold on the cartesian product. *)
val cartesian_product : 'a t t -> 'a t t val cartesian_product : 'a t t -> 'a t t
@ -328,7 +328,7 @@ val pure : 'a -> 'a t
(** [pure x] is [return x]. *) (** [pure x] is [return x]. *)
val mguard : bool -> unit t val mguard : bool -> unit t
(** [mguard c] is [pure ()] if [c] is true, [[]] otherwise. (** [mguard c] is [pure ()] if [c] is true, [[]] otherwise.
This is useful to define a list by comprehension, e.g.: This is useful to define a list by comprehension, e.g.:
{[ {[
# let square_even xs = # let square_even xs =
@ -386,7 +386,7 @@ val last : int -> 'a t -> 'a t
[l] doesn't have that many elements). *) [l] doesn't have that many elements). *)
val head_opt : 'a t -> 'a option val head_opt : 'a t -> 'a option
(** [head_opt l] returns [Some x] (the first element of the list [l]) (** [head_opt l] returns [Some x] (the first element of the list [l])
or [None] if the list [l] is empty. or [None] if the list [l] is empty.
@since 0.20 *) @since 0.20 *)
@ -396,7 +396,7 @@ val tail_opt : 'a t -> 'a t option
@since 2.0 *) @since 2.0 *)
val last_opt : 'a t -> 'a option val last_opt : 'a t -> 'a option
(** [last_opt l] returns [Some x] (the last element of [l]) or [None] if the list [l] is empty. (** [last_opt l] returns [Some x] (the last element of [l]) or [None] if the list [l] is empty.
@since 0.20 *) @since 0.20 *)
val find_pred : ('a -> bool) -> 'a t -> 'a option val find_pred : ('a -> bool) -> 'a t -> 'a option
@ -601,7 +601,7 @@ val union : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t
val inter : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t val inter : eq:('a -> 'a -> bool) -> 'a t -> 'a t -> 'a t
(** [inter ~eq l1 l2] is the intersection of the lists [l1] and [l2] w.r.t. the equality predicate [eq]. (** [inter ~eq l1 l2] is the intersection of the lists [l1] and [l2] w.r.t. the equality predicate [eq].
Complexity is product of length of inputs. *) Complexity is product of length of inputs. *)
(** {2 Other Constructors} *) (** {2 Other Constructors} *)
val range_by : step:int -> int -> int -> int t val range_by : step:int -> int -> int -> int t
@ -704,11 +704,11 @@ module Ref : sig
val push : 'a t -> 'a -> unit val push : 'a t -> 'a -> unit
(** [push rlist e] adds an element [e] at the head of [rlist]. *) (** [push rlist e] adds an element [e] at the head of [rlist]. *)
val pop : 'a t -> 'a option val pop : 'a t -> 'a option
(** [pop rlist] removes and returns [Some e] (the first element of [rlist]) (** [pop rlist] removes and returns [Some e] (the first element of [rlist])
or [None] if the [rlist] is empty *) or [None] if the [rlist] is empty *)
val pop_exn : 'a t -> 'a val pop_exn : 'a t -> 'a
(** [pop_exn rlist] removes and returns the first element of [rlist]. (** [pop_exn rlist] removes and returns the first element of [rlist].
Unsafe version of {!pop}. Unsafe version of {!pop}.
@ -724,7 +724,7 @@ module Ref : sig
(** [lift f rlist] applies a list function [f] to the content of [rlist]. *) (** [lift f rlist] applies a list function [f] to the content of [rlist]. *)
val push_list : 'a t -> 'a list -> unit val push_list : 'a t -> 'a list -> unit
(** [push_list rlist l] adds elements of the list [l] at the beginning of the list ref [rlist]. (** [push_list rlist l] adds elements of the list [l] at the beginning of the list ref [rlist].
Elements at the end of the list [l] will be at the beginning of the list ref [rlist]. *) Elements at the end of the list [l] will be at the beginning of the list ref [rlist]. *)
end end
@ -860,22 +860,7 @@ module Infix : sig
@since 2.8 *) @since 2.8 *)
include CCShimsMkLet_.S with type 'a t_let := 'a list include CCShimsMkLet_.S with type 'a t_let := 'a list
val (and&) : 'a list -> 'b list -> ('a * 'b) list include CCShimsMkLetList_.S
(** [(and&)] is [combine_shortest]. It allows to perform a synchronized product between two lists,
stopping gently at the shortest. Usable both with [let+] and [let*].
{[
# let f xs ys zs =
let+ x = xs
and& y = ys
and& z = zs in
x + y + z;;
val f : int list -> int list -> int list -> int list = <fun>
# f [1;2] [5;6;7] [10;10];;
- : int list = [16; 18]
]}
@since 3.1
*)
end end
(** Let operators on OCaml >= 4.08.0, nothing otherwise (** Let operators on OCaml >= 4.08.0, nothing otherwise

View file

@ -6,8 +6,8 @@
(rule (rule
(targets CCShims_.ml CCShimsList_.ml CCShimsFun_.ml CCShimsFun_.mli (targets CCShims_.ml CCShimsList_.ml CCShimsFun_.ml CCShimsFun_.mli
CCShimsArray_.ml CCShimsFormat_.ml CCShimsMkLet_.ml CCShimsArrayLabels_.ml CCShimsArray_.ml CCShimsFormat_.ml CCShimsMkLet_.ml CCShimsMkLetList_.ml
CCShimsInt_.ml) CCShimsArrayLabels_.ml CCShimsInt_.ml)
(deps ./mkshims.exe) (deps ./mkshims.exe)
(action (action
(run ./mkshims.exe))) (run ./mkshims.exe)))

View file

@ -114,7 +114,7 @@ let shims_array_label_post_408 = "
let shims_let_op_pre_408 = let shims_let_op_pre_408 =
" "
(** glue code for let-operators on OCaml >= 4.08 (auto generated) *) (** glue code for let-operators on OCaml < 4.08 (auto generated) *)
module type S = sig type 'a t_let end module type S = sig type 'a t_let end
module Make(X:sig type 'a t end) = struct type 'a t_let = 'a X.t end module Make(X:sig type 'a t end) = struct type 'a t_let = 'a X.t end
@ -165,6 +165,39 @@ let shims_let_op_post_408 =
end[@@inline] end[@@inline]
" "
let shims_let_op_list_pre_408 =
"
(** glue code for let-operators on OCaml < 4.08 (auto generated) *)
module type S = sig end
module Make(X:sig end) = struct end
"
let shims_let_op_list_post_408 =
"module type S = sig
val (and&) : 'a list -> 'b list -> ('a * 'b) list
(** [(and&)] is {!combine_shortest}.
It allows to perform a synchronized product between two lists,
stopping gently at the shortest. Usable both with [let+] and [let*].
{[
# let f xs ys zs =
let+ x = xs
and& y = ys
and& z = zs in
x + y + z;;
val f : int list -> int list -> int list -> int list = <fun>
# f [1;2] [5;6;7] [10;10];;
- : int list = [16; 18]
]}
@since 3.1
*)
end
module Make(X:sig
val combine_shortest : 'a list -> 'b list -> ('a*'b) list
end) = struct
let (and&) = X.combine_shortest
end
"
let shims_int_pre_408 = "" let shims_int_pre_408 = ""
let shims_int_post_408 = " let shims_int_post_408 = "
include Int include Int
@ -231,6 +264,7 @@ let () =
write_file "CCShimsFun_.ml" (if (major, minor) >= (4,8) then shims_fun_post_408 else shims_fun_pre_408); write_file "CCShimsFun_.ml" (if (major, minor) >= (4,8) then shims_fun_post_408 else shims_fun_pre_408);
write_file "CCShimsFun_.mli" (if (major, minor) >= (4,8) then shims_fun_mli_post_408 else shims_fun_mli_pre_408); write_file "CCShimsFun_.mli" (if (major, minor) >= (4,8) then shims_fun_mli_post_408 else shims_fun_mli_pre_408);
write_file "CCShimsMkLet_.ml" (if (major, minor) >= (4,8) then shims_let_op_post_408 else shims_let_op_pre_408); write_file "CCShimsMkLet_.ml" (if (major, minor) >= (4,8) then shims_let_op_post_408 else shims_let_op_pre_408);
write_file "CCShimsMkLetList_.ml" (if (major, minor) >= (4,8) then shims_let_op_list_post_408 else shims_let_op_list_pre_408);
write_file "CCShimsInt_.ml" write_file "CCShimsInt_.ml"
((if (major, minor) >= (4,8) then shims_int_post_408 else shims_int_pre_408) ((if (major, minor) >= (4,8) then shims_int_post_408 else shims_int_pre_408)
^ if Sys.word_size=64 then shims_int_64bit else shims_int_non_64bit); ^ if Sys.word_size=64 then shims_int_64bit else shims_int_non_64bit);