remove final shims

qtest/make.ml

@@ -22,10 +22,7 @@ let do_not_test file =
   is_suffix ~sub:".pp.mli" file ||
   is_suffix ~sub:"containers.ml" file ||
   is_suffix ~sub:"_top.ml" file ||
-  is_suffix ~sub:"mkflags.ml" file ||
-  is_suffix ~sub:"mkshims.ml" file ||
   is_suffix ~sub:"cpp.ml" file ||
-  is_suffix ~sub:"unlabel.ml" file ||
   is_suffix ~sub:"check_labelled_mods.ml" file ||
   is_suffix ~sub:"test_random.ml" file ||
   is_suffix ~sub:"test_hash.ml" file ||

src/core/CCFormat.ml

@@ -362,18 +362,45 @@ let mark_close_tag st ~or_else s =
       if !color_enabled then string_of_style_list style else ""
     | exception No_such_style -> or_else s
 
+[@@@ifge 4.8]
+
+
+let pp_open_tag out s = pp_open_stag out (String_tag s)
+let pp_close_tag out () = pp_close_stag out ()
+
+[@@@ocaml.warning "-3"]
+let pp_get_formatter_tag_functions = pp_get_formatter_tag_functions
+let pp_set_formatter_tag_functions = pp_set_formatter_tag_functions
+
+let update_tag_funs_ funs f1 f2 =
+  { funs with
+    mark_open_tag = f1 ~or_else:funs.mark_open_tag;
+    mark_close_tag = f2 ~or_else:funs.mark_close_tag;
+  }
+
+[@@@ocaml.warning "+3"]
+
+[@@@else_]
+
+let update_tag_funs_ funs f1 f2 =
+  { funs with
+    mark_open_tag = f1 funs.mark_open_tag;
+    mark_close_tag = f2 funs.mark_close_tag;
+  }
+
+[@@@endif]
+
 (* add color handling to formatter [ppf] *)
 let set_color_tag_handling ppf =
-  let open Format in
+  let functions = pp_get_formatter_tag_functions ppf () in
-  let functions = CCShimsFormat_.pp_get_formatter_tag_functions ppf () in
   let st = Stack.create () in (* stack of styles *)
   let functions' =
-    CCShimsFormat_.cc_update_funs functions
+    update_tag_funs_ functions
       (mark_open_tag st)
       (mark_close_tag st)
   in
   pp_set_mark_tags ppf true; (* enable tags *)
-  CCShimsFormat_.pp_set_formatter_tag_functions ppf functions'
+  pp_set_formatter_tag_functions ppf functions'
 
 let set_color_default =
   let first = ref true in
@@ -398,14 +425,14 @@ let set_color_default =
 *)
 
 let with_color s pp out x =
-  CCShimsFormat_.pp_open_tag out s;
+  pp_open_tag out s;
   pp out x;
-  CCShimsFormat_.pp_close_tag out ()
+  pp_close_tag out ()
 
 let with_colorf s out fmt =
-  CCShimsFormat_.pp_open_tag out s;
+  pp_open_tag out s;
   Format.kfprintf
-    (fun out -> CCShimsFormat_.pp_close_tag out ())
+    (fun out -> pp_close_tag out ())
     out fmt
 
 (* c: whether colors are enabled *)
@@ -422,10 +449,10 @@ let with_color_ksf ~f s fmt =
   let buf = Buffer.create 64 in
   let out = Format.formatter_of_buffer buf in
   if !color_enabled then set_color_tag_handling out;
-  CCShimsFormat_.pp_open_tag out s;
+  pp_open_tag out s;
   Format.kfprintf
     (fun out ->
-       CCShimsFormat_.pp_close_tag out ();
+       pp_close_tag out ();
        Format.pp_print_flush out ();
        f (Buffer.contents buf))
     out fmt

src/core/dune

@@ -1,20 +1,8 @@
 
-(executable
- (name mkshims)
- (modules mkshims)
- (libraries dune.configurator))
-
-(rule
- (targets CCShimsFormat_.ml)
- (deps ./mkshims.exe)
- (action
-  (run ./mkshims.exe)))
-
 (library
  (name containers)
  (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

src/core/mkshims.ml

@@ -1,102 +0,0 @@
-module C = Configurator.V1
-
-let write_file f s =
-  let out = open_out f in
-  output_string out s; flush out; close_out out
-
-let shims_fmt_pre_408 = "
-include Format
-let cc_update_funs funs f1 f2 =
-  let open Format in
-  {
-    funs with
-    mark_open_tag = f1 funs.mark_open_tag;
-    mark_close_tag = f2 funs.mark_close_tag;
-  }
-
-"
-let shims_fmt_post_408 = "
-open Format
-
-[@@@ocaml.warning \"-3\"]
-
-let pp_open_tag = pp_open_tag
-let pp_close_tag = pp_close_tag
-let pp_get_formatter_tag_functions = pp_get_formatter_tag_functions
-let pp_set_formatter_tag_functions = pp_set_formatter_tag_functions
-
-let cc_update_funs funs f1 f2 =
-  let open Format in
-  {
-    funs with
-    mark_open_tag = f1 ~or_else:funs.mark_open_tag;
-    mark_close_tag = f2 ~or_else:funs.mark_close_tag;
-  }
-"
-
-let shims_let_op_pre_408 =
-  "
-   (** glue code for let-operators on OCaml < 4.08 (auto generated) *)
-   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 =
-  " (** glue code for let-operators on OCaml >= 4.08 (auto generated) *)
-    module type S = sig
-      type 'a t_let
-      val (let+) : 'a t_let -> ('a -> 'b) -> 'b t_let
-      val (and+) : 'a t_let -> 'b t_let -> ('a * 'b) t_let
-      val (let*) : 'a t_let -> ('a -> 'b t_let) -> 'b t_let
-      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) : 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[@@inline]
-
-    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[@@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 () =
-  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);
-  )