feat: on 4.08, support let operators

close #276

src/core/CCArray.ml

@@ -739,3 +739,8 @@ end
   ignore (module CCArray : LL)
 *)
 
+include CCShimsMkLet_.Make(struct
+    type 'a t = 'a array
+    include Infix
+    let monoid_product a1 a2 = monoid_product (fun x y->x,y) a1 a2
+  end)

src/core/CCArray.mli

@@ -377,3 +377,7 @@ module Infix : sig
   (** [x --^ y] creates an array containing integers in the range [x .. y]. Right bound excluded.
       @since 0.17 *)
 end
+
+(** Let operators on OCaml >= 4.08.0, nothing otherwise
+    @since NEXT_RELEASE *)
+include CCShimsMkLet_.S with type 'a t_let := 'a array

src/core/CCArrayLabels.mli

@@ -378,3 +378,7 @@ module Infix : sig
   (** [x --^ y] creates an array containing integers in the range [x .. y]. Right bound excluded.
       @since 0.17 *)
 end
+
+(** Let operators on OCaml >= 4.08.0, nothing otherwise
+    @since NEXT_RELEASE *)
+include CCShimsMkLet_.S with type 'a t_let := 'a array

src/core/CCList.ml

@@ -1719,6 +1719,12 @@ module Infix = struct
   let (--^) = (--^)
 end
 
+include CCShimsMkLet_.Make(struct
+    type 'a t = 'a list
+    include Infix
+    let monoid_product l1 l2 = product (fun x y -> x,y) l1 l2
+  end)
+
 (** {2 IO} *)
 
 let pp ?(start="") ?(stop="") ?(sep=", ") pp_item fmt l =

src/core/CCList.mli

@@ -743,6 +743,10 @@ module Infix : sig
   (** @since 0.17 *)
 end
 
+(** Let operators on OCaml >= 4.08.0, nothing otherwise
+    @since NEXT_RELEASE *)
+include CCShimsMkLet_.S with type 'a t_let := 'a list
+
 (** {2 IO} *)
 
 val pp : ?start:string -> ?stop:string -> ?sep:string ->

src/core/CCListLabels.mli

@@ -741,6 +741,10 @@ module Infix : sig
   (** @since 0.17 *)
 end
 
+(** Let operators on OCaml >= 4.08.0, nothing otherwise
+    @since NEXT_RELEASE *)
+include CCShimsMkLet_.S with type 'a t_let := 'a list
+
 (** {2 IO} *)
 
 val pp : ?start:string -> ?stop:string -> ?sep:string ->

src/core/CCOpt.ml

@@ -105,6 +105,7 @@ let fold f acc o = match o with
 let get_or ~default x = match x with
   | None -> default
   | Some y -> y
+
 let value x ~default = match x with
   | None -> default
   | Some y -> y
@@ -237,3 +238,11 @@ let return_if b x =
   return_if false 1 = None
   return_if true 1 = Some 1
 *)
+
+include CCShimsMkLet_.Make(struct
+    type 'a t = 'a option
+    include Infix
+    let monoid_product o1 o2 = match o1, o2 with
+      | Some x, Some y -> Some (x,y)
+      | _ -> None
+  end)

src/core/CCOpt.mli

@@ -199,3 +199,7 @@ val to_seq : 'a t -> 'a sequence
     @deprecated use {!to_iter} instead *)
 
 val pp : 'a printer -> 'a t printer
+
+(** Let operators on OCaml >= 4.08.0, nothing otherwise
+    @since NEXT_RELEASE *)
+include CCShimsMkLet_.S with type 'a t_let := 'a option

src/core/CCParse.ml

@@ -527,3 +527,9 @@ module U = struct
       p3 >>= fun x3 ->
     string stop *> return (x1,x2,x3)
 end
+
+include CCShimsMkLet_.Make(struct
+    type nonrec 'a t = 'a t
+    include Infix
+    let monoid_product a1 a2 = pure (fun x y ->x,y) <*> a1 <*> a2
+  end)

src/core/CCParse.mli

@@ -323,3 +323,7 @@ module U : sig
   (** Parse a triple using OCaml whitespace conventions.
       The default is "(a, b, c)". *)
 end
+
+(** Let operators on OCaml >= 4.08.0, nothing otherwise
+    @since NEXT_RELEASE *)
+include CCShimsMkLet_.S with type 'a t_let := 'a t

src/core/CCRandom.ml

@@ -201,6 +201,13 @@ 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)
+
 let __default_state = Random.State.make_self_init ()
 
 let run ?(st=__default_state) g = g st

src/core/CCRandom.mli

@@ -158,6 +158,10 @@ val pure : 'a -> 'a t
 
 val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
 
+(** Let operators on OCaml >= 4.08.0, nothing otherwise
+    @since NEXT_RELEASE *)
+include CCShimsMkLet_.S with type 'a t_let := 'a t
+
 (** {4 Run a generator} *)
 
 val run : ?st:state -> 'a t -> 'a

src/core/CCResult.ml

@@ -338,3 +338,12 @@ let pp pp_x fmt e = match e with
 let pp' pp_x pp_e fmt e = match e with
   | Ok x -> Format.fprintf fmt "@[ok(@,%a)@]" pp_x x
   | Error s -> Format.fprintf fmt "@[error(@,%a)@]" pp_e s
+
+include CCShimsMkLet_.Make2(struct
+    type ('a,'e) t = ('a,'e) result
+    include Infix
+    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)

src/core/CCResult.mli

@@ -253,3 +253,7 @@ val pp : 'a printer -> ('a, string) t printer
 
 val pp': 'a printer -> 'e printer -> ('a, 'e) t printer
 (** Printer that is generic on the error type. *)
+
+(** Let operators on OCaml >= 4.08.0, nothing otherwise
+    @since NEXT_RELEASE *)
+include CCShimsMkLet_.S2 with type ('a,'e) t_let2 := ('a,'e) result

src/core/CCVector.ml

@@ -1053,3 +1053,10 @@ let pp ?(start="") ?(stop="") ?(sep=", ") pp_item fmt v =
        pp_item fmt x
     ) v;
   Format.pp_print_string fmt stop
+
+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)

src/core/CCVector.mli

@@ -311,3 +311,7 @@ val to_string :
 
 val pp : ?start:string -> ?stop:string -> ?sep:string ->
   'a printer -> ('a,_) t printer
+
+(** Let operators on OCaml >= 4.08.0, nothing otherwise
+    @since NEXT_RELEASE *)
+include CCShimsMkLet_.S2 with type ('a,'e) t_let2 := ('a,'e) t

src/core/dune

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

src/core/mkshims.ml

@@ -81,20 +81,54 @@ let shims_array_pre_408 = "
 let shims_array_post_408 = "include Array"
 
 let shims_let_op_pre_408 =
-  "module Make_let_applicative(X:sig end) = struct end
+  "
-   module Make_let_functor(X:sig end) = struct 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 type S2 = sig type ('a,'b) t_let2 end
+   module Make2(X:sig type ('a,'b) t end) = struct type ('a,'b) t_let2 = ('a,'b) X.t end
 "
 let shims_let_op_post_408 =
-  "module Make_let_applicative(X:sig
+  "
-    type 'a t
+    module type S = sig
-    val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
+      type 'a t_let
-    val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
+      val (let+) : 'a t_let -> ('a -> 'b) -> 'b t_let
-    end) = struct
+      val (and+) : 'a t_let -> 'b t_let -> ('a * 'b) t_let
-  end
+      val (let*) : 'a t_let -> ('a -> 'b t_let) -> 'b t_let
-   module Make_let_functor(X:sig
+      val (and*) : 'a t_let -> 'b t_let -> ('a * 'b) t_let
+    end
+   module Make(X:sig
     type 'a t
+    val (>|=) : 'a t -> ('a -> 'b) -> 'b t
+    val monoid_product : 'a t -> 'b t -> ('a * 'b) t
     val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
-    end) = struct
+    end) : S with type 'a t_let = 'a X.t = struct
+      type 'a t_let = 'a X.t
+      let (let+) = X.(>|=)
+      let (and+) = X.monoid_product
+      let (let*) = X.(>>=)
+      let (and*) = X.monoid_product
+  end
+
+    module type S2 = sig
+      type ('a,'e) t_let2
+      val (let+) : ('a,'e) t_let2 -> ('a -> 'b) -> ('b,'e) t_let2
+      val (and+) : ('a,'e) t_let2 -> ('b,'e) t_let2 -> ('a * 'b, 'e) t_let2
+      val (let*) : ('a,'e) t_let2 -> ('a -> ('b,'e) t_let2) -> ('b,'e) t_let2
+      val (and*) : ('a,'e) t_let2 -> ('b,'e) t_let2 -> ('a * 'b,'e) t_let2
+    end
+
+   module Make2(X:sig
+    type ('a,'b) t
+    val (>|=) : ('a,'e) t -> ('a -> 'b) -> ('b,'e) t
+    val monoid_product : ('a,'e) t -> ('b,'e) t -> ('a * 'b, 'e) t
+    val (>>=) : ('a,'e) t -> ('a -> ('b,'e) t) -> ('b,'e) t
+    end) : S2 with type ('a,'e) t_let2 = ('a,'e) X.t = struct
+      type ('a,'e) t_let2 = ('a,'e) X.t
+      let (let+) = X.(>|=)
+      let (and+) = X.monoid_product
+      let (let*) = X.(>>=)
+      let (and*) = X.monoid_product
   end
 "
 
@@ -108,4 +142,5 @@ let () =
     write_file "CCShimsFormat_.ml" (if (major, minor) >= (4,8) then shims_fmt_post_408 else shims_fmt_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 "CCShimsMkLet_.ml" (if (major, minor) >= (4,8) then shims_let_op_post_408 else shims_let_op_pre_408);
   )