remove many more shims

This commit is contained in:
Simon Cruanes 2022-02-21 21:52:06 -05:00
parent 26ab8229e1
commit b837509de9
No known key found for this signature in database
GPG key ID: 4AC01D0849AA62B6
22 changed files with 167 additions and 160 deletions

View file

@ -720,12 +720,11 @@ module Infix = struct
let (--) = (--)
let (--^) = (--^)
include CCShimsMkLet_.Make(struct
type 'a t = 'a array
let (>>=) = (>>=)
let (>|=) = (>|=)
let monoid_product a1 a2 = monoid_product (fun x y->x,y) a1 a2
end)
type 'a t = 'a array
let ( let* ) = (>>=)
let (let+) = (>|=)
let[@inline] (and+) a1 a2 = monoid_product (fun x y->x,y) a1 a2
let ( and* ) = (and+)
end
include Infix

View file

@ -317,10 +317,14 @@ module Infix : sig
(** [x --^ y] creates an array containing integers in the range [x .. y]. Right bound excluded.
@since 0.17 *)
[@@@ifge 4.8]
include CCShims_syntax.LET with type 'a t := 'a array
(** Let operators on OCaml >= 4.08.0, nothing otherwise
@since 2.8
@inline *)
include CCShimsMkLet_.S with type 'a t_let := 'a array
[@@@endif]
end
include module type of Infix

View file

@ -334,10 +334,14 @@ module Infix : sig
(** [x --^ y] creates an array containing integers in the range [x .. y]. Right bound excluded.
@since 0.17 *)
[@@@ifge 4.8]
include CCShims_syntax.LET with type 'a t := 'a array
(** Let operators on OCaml >= 4.08.0, nothing otherwise
@since 2.8
@inline *)
include CCShimsMkLet_.S with type 'a t_let := 'a array
[@@@endif]
end
include module type of Infix

View file

@ -2001,16 +2001,16 @@ module Infix = struct
let (--) = (--)
let (--^) = (--^)
include CCShimsMkLet_.Make(struct
type 'a t = 'a list
let (>|=) = (>|=)
let (>>=) = (>>=)
let[@inline] monoid_product l1 l2 = product (fun x y -> x,y) l1 l2
end)
[@@@ifge 4.8]
include CCShimsMkLetList_.Make(struct
let combine_shortest=combine_shortest
end)
let (let+) = (>|=)
let (let*) = (>>=)
let[@inline] (and+) l1 l2 = product (fun x y -> x,y) l1 l2
let (and*) = (and+)
let (and&) = combine_shortest
[@@@endif]
end
include Infix

View file

@ -938,13 +938,29 @@ module Infix : sig
(** [i --^ j] is the infix alias for [range']. Second bound [j] excluded.
@since 0.17 *)
(** Let operators on OCaml >= 4.08.0, nothing otherwise
@since 2.8
@inline *)
include CCShimsMkLet_.S with type 'a t_let := 'a list
[@@@ifge 4.08]
include CCShimsMkLetList_.S
include CCShims_syntax.LET with type 'a t := 'a t
(** @inline *)
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
*)
[@@@endif]
end
include module type of Infix

View file

@ -852,38 +852,7 @@ val of_gen : 'a gen -> 'a t
@since 0.16 *)
module Infix : sig
val (>|=) : 'a t -> ('a -> 'b) -> 'b t
(** [l >|= f] is the infix version of [map] with reversed arguments. *)
val (@) : 'a t -> 'a t -> 'a t
(** [l1 @ l2] concatenates two lists [l1] and [l2].
As {!append}. *)
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
(** [f <$> l] is like {!map}. *)
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
(** [l >>= f] is [flat_map f l]. *)
val (--) : int -> int -> int t
(** [i -- j] is the infix alias for [range]. Bounds included. *)
val (--^) : int -> int -> int t
(** [i --^ j] is the infix alias for [range']. Second bound [j] excluded.
@since 0.17 *)
(** Let operators on OCaml >= 4.08.0, nothing otherwise
@since 2.8
@inline *)
include CCShimsMkLet_.S with type 'a t_let := 'a list
include CCShimsMkLetList_.S
(** @inline *)
end
module Infix : module type of CCList.Infix
include module type of Infix

View file

@ -176,14 +176,16 @@ module Infix = struct
let (<$>) = map
let (<+>) = (<+>)
include CCShimsMkLet_.Make(struct
type 'a t = 'a option
let (>|=) = (>|=)
let (>>=) = (>>=)
let[@inline] monoid_product o1 o2 = match o1, o2 with
| Some x, Some y -> Some (x,y)
| _ -> None
end)
[@@@ifge 4.8]
let (let+) = (>|=)
let (let*) = (>>=)
let[@inline] (and+) o1 o2 = match o1, o2 with
| Some x, Some y -> Some (x,y)
| _ -> None
let (and*) = (and+)
[@@@endif]
end
include Infix

View file

@ -171,11 +171,15 @@ module Infix : sig
val (<+>) : 'a t -> 'a t -> 'a t
(** [o1 <+> o2] is [o1] if [o1] is [Some _], [o2] if [o1] is [None]. *)
[@@@ifge 4.08]
include CCShims_syntax.LET with type 'a t := 'a t
(** Let operators on OCaml >= 4.08.0, nothing otherwise
@since 2.8
@inline *)
include CCShimsMkLet_.S with type 'a t_let := 'a option
[@@@endif]
end
include module type of Infix

View file

@ -355,12 +355,14 @@ module Infix = struct
let (|||) = both
let[@inline] (<?>) p msg = set_error_message msg p
include CCShimsMkLet_.Make(struct
type nonrec 'a t = 'a t
let (>>=) = (>>=)
let (>|=) = (>|=)
let monoid_product = both
end)
[@@@ifge 4.8]
let (let+) = (>|=)
let (let*) = (>>=)
let (and+) = both
let (and*) = (and+)
[@@@endif]
end
include Infix

View file

@ -665,10 +665,14 @@ module Infix : sig
[a ||| b] parses [a], then [b], then returns the pair of their results.
@since 3.6 *)
[@@@ifge 4.08]
include CCShims_syntax.LET with type 'a t := 'a t
(** Let operators on OCaml >= 4.08.0, nothing otherwise
@since 2.8
@inline *)
include CCShimsMkLet_.S with type 'a t_let := 'a t
[@@@endif]
end
include module type of Infix

View file

@ -196,12 +196,14 @@ let pure x _st = x
let (<*>) f g st = f st (g st)
include CCShimsMkLet_.Make(struct
type nonrec 'a t = 'a t
let (>>=) = (>>=)
let (>|=) = (>|=)
let monoid_product a1 a2 st = a1 st, a2 st
end)
[@@@ifge 4.8]
let (let+) = (>|=)
let (let*) = (>>=)
let[@inline] (and+) a1 a2 st = a1 st, a2 st
let (and*) = (and+)
[@@@endif]
let __default_state = Random.State.make_self_init ()

View file

@ -150,10 +150,14 @@ val pure : 'a -> 'a t
val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
[@@@ifge 4.08]
include CCShims_syntax.LET with type 'a t := 'a t
(** Let operators on OCaml >= 4.08.0, nothing otherwise
@since 2.8
@inline *)
include CCShimsMkLet_.S with type 'a t_let := 'a t
[@@@endif]
(** {4 Run a generator} *)

View file

@ -295,15 +295,17 @@ module Infix = struct
let (>>=) e f = flat_map f e
let (<*>) = (<*>)
include CCShimsMkLet_.Make2(struct
type ('a,'e) t = ('a,'e) result
let (>>=) = (>>=)
let (>|=) = (>|=)
let monoid_product x1 x2 = match x1, x2 with
| Ok x, Ok y -> Ok (x,y)
| Error e, _ -> Error e
| _, Error e -> Error e
end)
[@@@ifge 4.8]
let (let+) = (>|=)
let (let*) = (>>=)
let[@inline] (and+) x1 x2 = match x1, x2 with
| Ok x, Ok y -> Ok (x,y)
| Error e, _ -> Error e
| _, Error e -> Error e
let (and*) = (and+)
[@@@endif]
end
include Infix

View file

@ -194,10 +194,21 @@ module Infix : sig
[Ok (a b)]. Otherwise, it fails, and the error of [a] is chosen
over the error of [b] if both fail. *)
(** Let operators on OCaml >= 4.08.0, nothing otherwise
@since 2.8
@inline *)
include CCShimsMkLet_.S2 with type ('a,'e) t_let2 := ('a,'e) result
[@@@ifge 4.08]
val (let+) : ('a,'e) t -> ('a -> 'b) -> ('b,'e) t
(** @since 2.8 *)
val (and+) : ('a,'e) t -> ('b,'e) t -> ('a * 'b, 'e) t
(** @since 2.8 *)
val (let*) : ('a,'e) t -> ('a -> ('b,'e) t) -> ('b,'e) t
(** @since 2.8 *)
val (and*) : ('a,'e) t -> ('b,'e) t -> ('a * 'b,'e) t
(** @since 2.8 *)
[@@@endif]
end
include module type of Infix

View file

@ -1141,9 +1141,13 @@ let pp ?(pp_start=fun _ () -> ()) ?(pp_stop=fun _ () -> ())
) v;
pp_stop fmt ()
include CCShimsMkLet_.Make2(struct
type nonrec ('a,'e) t = ('a,'e) t
let (>|=) = (>|=)
let (>>=) = (>>=)
let monoid_product a1 a2 = monoid_product (fun x y->x,y) a1 a2
end)
[@@@ifge 4.8]
let (let+) = (>|=)
let (let*) = (>>=)
let[@inline] (and+) a1 a2 = monoid_product (fun x y->x,y) a1 a2
let (and*) = (and+)
[@@@endif]

View file

@ -383,7 +383,20 @@ val pp : ?pp_start:unit printer -> ?pp_stop:unit printer -> ?pp_sep:unit printer
By defaults [pp_start] and [pp_stop] does nothing and [pp_sep] defaults to
(fun out -> Format.fprintf out ",@ "). *)
(** Let operators on OCaml >= 4.08.0, nothing otherwise
@since 2.8
@inline *)
include CCShimsMkLet_.S2 with type ('a,'e) t_let2 := ('a,'e) t
[@@@ifge 4.08]
val (let+) : ('a,'e) t -> ('a -> 'b) -> ('b,'e) t
(** @since 2.8 *)
val (and+) : ('a,'e) t -> ('b,'e) t -> ('a * 'b, 'e) t
(** @since 2.8 *)
val (let*) : ('a,'e) t -> ('a -> ('b,'e) t) -> ('b,'e) t
(** @since 2.8 *)
val (and*) : ('a,'e) t -> ('b,'e) t -> ('a * 'b,'e) t
(** @since 2.8 *)
[@@@endif]

View file

@ -41,17 +41,18 @@ let preproc_lines ~file ~major ~minor (ic:in_channel) : unit =
match input_line ic with
| exception End_of_file -> Eof
| line ->
let line' = String.trim line in
incr pos;
if prefix line ~pre:"[@@@ifle" then
Scanf.sscanf line "[@@@ifle %d.%d]" (fun x y -> If(Le,x,y))
else if prefix line ~pre:"[@@@ifge" then
Scanf.sscanf line "[@@@ifge %d.%d]" (fun x y -> If(Ge,x,y))
else if prefix line ~pre:"[@@@elifle" then
Scanf.sscanf line "[@@@elifle %d.%d]" (fun x y -> Elseif(Le,x,y))
else if prefix line ~pre:"[@@@elifge" then
Scanf.sscanf line "[@@@elifge %d.%d]" (fun x y -> Elseif(Ge,x,y))
else if line="[@@@else_]" then Else
else if line="[@@@endif]" then Endif
if prefix line' ~pre:"[@@@ifle" then
Scanf.sscanf line' "[@@@ifle %d.%d]" (fun x y -> If(Le,x,y))
else if prefix line' ~pre:"[@@@ifge" then
Scanf.sscanf line' "[@@@ifge %d.%d]" (fun x y -> If(Ge,x,y))
else if prefix line' ~pre:"[@@@elifle" then
Scanf.sscanf line' "[@@@elifle %d.%d]" (fun x y -> Elseif(Le,x,y))
else if prefix line' ~pre:"[@@@elifge" then
Scanf.sscanf line' "[@@@elifge %d.%d]" (fun x y -> Elseif(Ge,x,y))
else if line'="[@@@else_]" then Else
else if line'="[@@@endif]" then Endif
else Raw line
in

View file

@ -5,8 +5,7 @@
(libraries dune.configurator))
(rule
(targets
CCShimsFormat_.ml CCShimsMkLet_.ml CCShimsMkLetList_.ml)
(targets CCShimsFormat_.ml)
(deps ./mkshims.exe)
(action
(run ./mkshims.exe)))
@ -16,6 +15,7 @@
(public_name containers)
(wrapped false)
(modules :standard \ mkshims)
(modules_without_implementation CCShims_syntax)
(preprocess (action (run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
(flags :standard -warn-error -a+8 -w -32-70 -safe-string
-strict-sequence -nolabels -open CCMonomorphic)

View file

@ -93,38 +93,10 @@ let shims_let_op_list_pre_408 =
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 () =
C.main ~name:"mkshims" (fun c ->
let version = C.ocaml_config_var_exn c "version" in
let major, minor = Scanf.sscanf version "%u.%u" (fun maj min -> maj, min) in
write_file "CCShimsFormat_.ml" (if (major, minor) >= (4,8) then shims_fmt_post_408 else shims_fmt_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);
)

View file

@ -710,13 +710,14 @@ module Make(P : PARAM) = struct
let (>|=) a f = map f a
let (<*>) = app
[@@@ifge 4.8]
include CCShimsMkLet_.Make(struct
type nonrec 'a t = 'a t
let (>>=) = (>>=)
let (>|=) = (>|=)
let monoid_product a1 a2 = monoid_product (fun x y->x,y) a1 a2
end)
let (let+) = (>|=)
let (let*) = (>>=)
let[@inline] (and+) a1 a2 = monoid_product (fun x y->x,y) a1 a2
let (and*) = (and+)
[@@@endif]
end
include Infix

View file

@ -154,23 +154,15 @@ module Make(P : PARAM) : sig
val (>|=) : 'a t -> ('a -> 'b) -> 'b t
val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
[@@@ifge 4.08]
include CCShims_syntax.LET with type 'a t := 'a t
(** Let operators on OCaml >= 4.08.0, nothing otherwise
@since 2.8 *)
include CCShimsMkLet_.S with type 'a t_let := 'a t
[@@@endif]
end
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
val (>>) : 'a t -> (unit -> 'b t) -> 'b t
val (>|=) : 'a t -> ('a -> 'b) -> 'b t
(** Alias to {!map}. *)
val (<*>): ('a -> 'b) t -> 'a t -> 'b t
(** Alias to {!app}. *)
(** Let operators on OCaml >= 4.08.0, nothing otherwise
@since 2.8 *)
include CCShimsMkLet_.S with type 'a t_let := 'a t
include module type of Infix
end
end

View file

@ -5,5 +5,6 @@
(wrapped false)
(optional)
(flags :standard -warn-error -a+8 -w -32 -safe-string -open CCShims_)
(preprocess (action (run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
(libraries containers threads))