diff --git a/src/core/CCArray.ml b/src/core/CCArray.ml index 245d431b..c02ccfdb 100644 --- a/src/core/CCArray.ml +++ b/src/core/CCArray.ml @@ -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 diff --git a/src/core/CCArray.mli b/src/core/CCArray.mli index 9aa126c0..34f95264 100644 --- a/src/core/CCArray.mli +++ b/src/core/CCArray.mli @@ -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 diff --git a/src/core/CCArrayLabels.mli b/src/core/CCArrayLabels.mli index 4bbedbc7..8be4f679 100644 --- a/src/core/CCArrayLabels.mli +++ b/src/core/CCArrayLabels.mli @@ -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 diff --git a/src/core/CCList.ml b/src/core/CCList.ml index da2d9648..aa777a27 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -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 diff --git a/src/core/CCList.mli b/src/core/CCList.mli index a918bb05..bda8c72b 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -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 = + # f [1;2] [5;6;7] [10;10];; + - : int list = [16; 18] + ]} + @since 3.1 + *) + + [@@@endif] end include module type of Infix diff --git a/src/core/CCListLabels.mli b/src/core/CCListLabels.mli index ef937b2e..6b85dfdf 100644 --- a/src/core/CCListLabels.mli +++ b/src/core/CCListLabels.mli @@ -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 diff --git a/src/core/CCOption.ml b/src/core/CCOption.ml index 327278f4..81a522ca 100644 --- a/src/core/CCOption.ml +++ b/src/core/CCOption.ml @@ -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 diff --git a/src/core/CCOption.mli b/src/core/CCOption.mli index 81b8884c..0c46ddbf 100644 --- a/src/core/CCOption.mli +++ b/src/core/CCOption.mli @@ -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 diff --git a/src/core/CCParse.ml b/src/core/CCParse.ml index 0d33f9ea..5849a6ac 100644 --- a/src/core/CCParse.ml +++ b/src/core/CCParse.ml @@ -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 diff --git a/src/core/CCParse.mli b/src/core/CCParse.mli index 86d59a9d..f34bc00a 100644 --- a/src/core/CCParse.mli +++ b/src/core/CCParse.mli @@ -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 diff --git a/src/core/CCRandom.ml b/src/core/CCRandom.ml index 0f24d77b..c1567b65 100644 --- a/src/core/CCRandom.ml +++ b/src/core/CCRandom.ml @@ -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 () diff --git a/src/core/CCRandom.mli b/src/core/CCRandom.mli index b8a86626..f351f8e7 100644 --- a/src/core/CCRandom.mli +++ b/src/core/CCRandom.mli @@ -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} *) diff --git a/src/core/CCResult.ml b/src/core/CCResult.ml index 90e6159d..469c143a 100644 --- a/src/core/CCResult.ml +++ b/src/core/CCResult.ml @@ -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 diff --git a/src/core/CCResult.mli b/src/core/CCResult.mli index 78f21ef8..ac6b19d4 100644 --- a/src/core/CCResult.mli +++ b/src/core/CCResult.mli @@ -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 diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 719ea85e..5a906b46 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -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] + + diff --git a/src/core/CCVector.mli b/src/core/CCVector.mli index c631a721..9858048a 100644 --- a/src/core/CCVector.mli +++ b/src/core/CCVector.mli @@ -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] diff --git a/src/core/cpp/cpp.ml b/src/core/cpp/cpp.ml index de808207..d3581859 100644 --- a/src/core/cpp/cpp.ml +++ b/src/core/cpp/cpp.ml @@ -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 diff --git a/src/core/dune b/src/core/dune index 2d804bf1..6b86380d 100644 --- a/src/core/dune +++ b/src/core/dune @@ -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) diff --git a/src/core/mkshims.ml b/src/core/mkshims.ml index 1134f9d6..9e2c4330 100644 --- a/src/core/mkshims.ml +++ b/src/core/mkshims.ml @@ -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 = - # 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); ) diff --git a/src/threads/CCPool.ml b/src/threads/CCPool.ml index eee1dd73..60e8687d 100644 --- a/src/threads/CCPool.ml +++ b/src/threads/CCPool.ml @@ -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 diff --git a/src/threads/CCPool.mli b/src/threads/CCPool.mli index 603cc1e3..b9892fc2 100644 --- a/src/threads/CCPool.mli +++ b/src/threads/CCPool.mli @@ -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 diff --git a/src/threads/dune b/src/threads/dune index f27b5e65..1959f433 100644 --- a/src/threads/dune +++ b/src/threads/dune @@ -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))