From 3c446b45b2d9e81bc72b57ada168fe7923f9b02c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fr=C3=A9d=C3=A9ric=20Bour?= <fred@tarides.com>
Date: Mon, 5 Sep 2022 17:46:27 +0900
Subject: [PATCH] Fix compilation with different versions of OCaml

---
 lib/lwd/dune                                  | 21 +++++------
 lib/lwd/{lwd_infix_letop.ml => lwd_infix.ml}  |  2 ++
 .../{lwd_infix_letop.mli => lwd_infix.mli}    |  2 ++
 lib/lwd/lwd_infix_compat.ml                   |  2 --
 lib/lwd/lwd_infix_compat.mli                  |  2 --
 lib/lwd/lwd_seq.ml                            |  4 +++
 lib/lwd/lwd_seq.mli                           |  6 ++++
 lib/lwd/pp.ml                                 | 36 +++++++++++++++++++
 8 files changed, 58 insertions(+), 17 deletions(-)
 rename lib/lwd/{lwd_infix_letop.ml => lwd_infix.ml} (92%)
 rename lib/lwd/{lwd_infix_letop.mli => lwd_infix.mli} (95%)
 delete mode 100644 lib/lwd/lwd_infix_compat.ml
 delete mode 100644 lib/lwd/lwd_infix_compat.mli
 create mode 100644 lib/lwd/pp.ml

diff --git a/lib/lwd/dune b/lib/lwd/dune
index 8aca6ae..4dc3876 100644
--- a/lib/lwd/dune
+++ b/lib/lwd/dune
@@ -4,17 +4,12 @@
   (modules lwd lwd_seq lwd_table lwd_infix lwd_utils) 
   (libraries seq)
   (inline_tests (backend qtest.lib))
-  (wrapped false))
+  (wrapped false)
+  (preprocess (per_module 
+                ; use full to path to pp.exe to work around
+                ; https://github.com/ocaml/dune/issues/6106
+               ((action (run lib/lwd/pp.exe %{input-file})) lwd_infix lwd_seq))))
 
-(rule
- (targets lwd_infix.ml lwd_infix.mli)
- (deps lwd_infix_compat.ml lwd_infix_compat.mli 
-       lwd_infix_letop.ml lwd_infix_letop.mli)
- (action
-  (progn
-   (with-stdout-to lwd_infix.mli (run ./select_version.exe intf))
-   (with-stdout-to lwd_infix.ml (run ./select_version.exe impl)))))
-
-(executable
- (modules select_version)
- (name select_version))
+(executable 
+  (name pp)
+  (modules pp))
diff --git a/lib/lwd/lwd_infix_letop.ml b/lib/lwd/lwd_infix.ml
similarity index 92%
rename from lib/lwd/lwd_infix_letop.ml
rename to lib/lwd/lwd_infix.ml
index 1293589..28f12a6 100644
--- a/lib/lwd/lwd_infix_letop.ml
+++ b/lib/lwd/lwd_infix.ml
@@ -1,6 +1,8 @@
+(*BEGIN LETOP*)
 let (let$) : 'a Lwd.t -> ('a -> 'b) -> 'b Lwd.t = Lwd.Infix.(>|=)
 let (and$) : 'a Lwd.t -> 'b Lwd.t -> ('a * 'b) Lwd.t = Lwd.pair
 let (let$*) : 'a Lwd.t -> ('a -> 'b Lwd.t) -> 'b Lwd.t = Lwd.Infix.(>>=)
+(*END*)
 
 let ($=) : 'a Lwd.var -> 'a -> unit = Lwd.set
 let ($<-) : 'a Lwd_table.row -> 'a -> unit = Lwd_table.set
diff --git a/lib/lwd/lwd_infix_letop.mli b/lib/lwd/lwd_infix.mli
similarity index 95%
rename from lib/lwd/lwd_infix_letop.mli
rename to lib/lwd/lwd_infix.mli
index 9d6fbbb..a075710 100644
--- a/lib/lwd/lwd_infix_letop.mli
+++ b/lib/lwd/lwd_infix.mli
@@ -1,3 +1,4 @@
+(*BEGIN LETOP*)
 val (let$) : 'a Lwd.t -> ('a -> 'b) -> 'b Lwd.t
 (** Alias to {!Lwd.map'} suitable for let-op bindings *)
 
@@ -6,6 +7,7 @@ val (let$*) : 'a Lwd.t -> ('a -> 'b Lwd.t) -> 'b Lwd.t
 
 val (and$) : 'a Lwd.t -> 'b Lwd.t -> ('a * 'b) Lwd.t
 (** Alias to {!Lwd.pair} suitable for let-op bindings *)
+(*END*)
 
 val ($=) : 'a Lwd.var -> 'a -> unit
 (** Infix alias to {!Lwd.set} *)
diff --git a/lib/lwd/lwd_infix_compat.ml b/lib/lwd/lwd_infix_compat.ml
deleted file mode 100644
index e17b50e..0000000
--- a/lib/lwd/lwd_infix_compat.ml
+++ /dev/null
@@ -1,2 +0,0 @@
-let ($=) : 'a Lwd.var -> 'a -> unit = Lwd.set
-let ($<-) : 'a Lwd_table.row -> 'a -> unit = Lwd_table.set
diff --git a/lib/lwd/lwd_infix_compat.mli b/lib/lwd/lwd_infix_compat.mli
deleted file mode 100644
index 654bed2..0000000
--- a/lib/lwd/lwd_infix_compat.mli
+++ /dev/null
@@ -1,2 +0,0 @@
-val ($=) : 'a Lwd.var -> 'a -> unit
-val ($<-) : 'a Lwd_table.row -> 'a -> unit
diff --git a/lib/lwd/lwd_seq.ml b/lib/lwd/lwd_seq.ml
index 410e939..aac46df 100644
--- a/lib/lwd/lwd_seq.ml
+++ b/lib/lwd/lwd_seq.ml
@@ -1,4 +1,8 @@
+(*BEGIN INJECTIVITY*)
 type !+'a t =
+(*ELSE*)
+type +'a t =
+(*END*)
   | Nil
   | Leaf of { mutable mark: int; v: 'a; }
   | Join of { mutable mark: int; l: 'a t; r: 'a t; }
diff --git a/lib/lwd/lwd_seq.mli b/lib/lwd/lwd_seq.mli
index f3e8c14..f760703 100644
--- a/lib/lwd/lwd_seq.mli
+++ b/lib/lwd/lwd_seq.mli
@@ -12,8 +12,14 @@
     element.
 *)
 
+(*BEGIN INJECTIVITY*)
 type !+'a t
 type !+'a seq = 'a t
+(*ELSE*)
+type +'a t
+type +'a seq = 'a t
+(*END*)
+
 (** The type of sequences *)
 
 (** {2 Primitive constructors} *)
diff --git a/lib/lwd/pp.ml b/lib/lwd/pp.ml
new file mode 100644
index 0000000..8623ca6
--- /dev/null
+++ b/lib/lwd/pp.ml
@@ -0,0 +1,36 @@
+let version =
+  Scanf.sscanf Sys.ocaml_version "%d.%d" (fun major minor -> (major, minor))
+
+let ic =
+  if Array.length Sys.argv = 1 then (
+    Printf.eprintf
+      "Usage: %s <input-file>\n\
+       Expecting a filename as argument.\n"
+      Sys.argv.(0);
+    exit 1
+  ) else if not (Sys.file_exists Sys.argv.(1)) then (
+    Printf.eprintf
+      "Usage: %s <input-file>\n\
+       Cannot find file %S.\n"
+      Sys.argv.(0)
+      Sys.argv.(1);
+    exit 1
+  ) else
+    open_in_bin Sys.argv.(1)
+
+let () =
+  let enable_output = ref true in
+  let change_output v =
+    print_newline ();
+    enable_output := v
+  in
+  try
+    while true do
+      match input_line ic with
+      | "(*BEGIN LETOP*)"       -> change_output (version >= (4, 08))
+      | "(*BEGIN INJECTIVITY*)" -> change_output (version >= (4, 12))
+      | "(*ELSE*)"              -> change_output (not !enable_output)
+      | "(*END*)"               -> change_output true
+      | line -> if !enable_output then print_endline line
+    done
+  with End_of_file -> ()