From 35c740c31287902f332de222ff38231bea0ef758 Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jdimino@janestreet.com>
Date: Fri, 8 Apr 2016 09:31:37 +0100
Subject: [PATCH] fix 4.01 compatibility

---
 myocamlbuild.ml           | 25 ++++++++++------
 src/lib/uTop.cppo.ml      |  7 +++--
 src/lib/uTop_main.cppo.ml | 62 +++++++++++++++++++++------------------
 3 files changed, 54 insertions(+), 40 deletions(-)

diff --git a/myocamlbuild.ml b/myocamlbuild.ml
index ca98fb1..b07b545 100644
--- a/myocamlbuild.ml
+++ b/myocamlbuild.ml
@@ -92,13 +92,20 @@ let () =
              rule "format lifter"
                ~prod:"src/lib/uTop_cmt_lifter.ml"
                (fun _ _ ->
-                  Cmd (S [ P "ocamlfind"
-                         ; A "ppx_tools/genlifter"
-                         ; A "-I"
-                         ; A "+compiler-libs"
-                         ; A "Cmt_format.cmt_infos"
-                         ; Sh ">"
-                         ; A "src/lib/uTop_cmt_lifter.ml"
-                         ]))
+                  let ocaml_version =
+                    Scanf.sscanf (BaseEnvLight.var_get "ocaml_version" env)
+                      "%u.%u" (fun a b -> (a, b))
+                  in
+                  if ocaml_version < (4, 02) then
+                    Echo ([], "src/lib/uTop_cmt_lifter.ml")
+                  else
+                    Cmd (S [ P "ocamlfind"
+                           ; A "ppx_tools/genlifter"
+                           ; A "-I"
+                           ; A "+compiler-libs"
+                           ; A "Cmt_format.cmt_infos"
+                           ; Sh ">"
+                           ; A "src/lib/uTop_cmt_lifter.ml"
+                           ]))
          | _ ->
-             ())
+           ())
diff --git a/src/lib/uTop.cppo.ml b/src/lib/uTop.cppo.ml
index ef5c710..c7d69c9 100644
--- a/src/lib/uTop.cppo.ml
+++ b/src/lib/uTop.cppo.ml
@@ -77,9 +77,10 @@ let auto_run_async, get_auto_run_async, set_auto_run_async = make_variable true
 let topfind_verbose, get_topfind_verbose, set_topfind_verbose = make_variable false
 let external_editor, get_external_editor, set_external_editor =
   make_variable
-    (match Sys.getenv "EDITOR" with
-     | exception Not_found -> "vi"
-     | s                   -> s)
+    (try
+       Sys.getenv "EDITOR"
+     with Not_found ->
+       "vi")
 
 (* Ugly hack until the action system of lambda-term is improved *)
 let end_and_accept_current_phrase : LTerm_read_line.action =
diff --git a/src/lib/uTop_main.cppo.ml b/src/lib/uTop_main.cppo.ml
index 6399d0b..bee2b38 100644
--- a/src/lib/uTop_main.cppo.ml
+++ b/src/lib/uTop_main.cppo.ml
@@ -1368,6 +1368,13 @@ let main () = main_internal ~initial_env:None
 
 type value = V : string * _ -> value
 
+#if OCAML_VERSION < (4, 02, 0)
+
+let interact ~search_path ~unit ~loc:(fname, lnum, cnum, _) ~values =
+  failwith "UTop_main.interact is not supported on OCaml 4.01"
+
+#else
+
 exception Found of Env.t
 
 let interact ~search_path ~unit ~loc:(fname, lnum, cnum, _) ~values =
@@ -1385,23 +1392,19 @@ let interact ~search_path ~unit ~loc:(fname, lnum, cnum, _) ~values =
       super#lift_Typedtree_expression e;
       match e.exp_desc with
       | Texp_apply (_, args) -> begin
-        match
-          List.find (fun (lab, _, _) -> lab = "loc"   ) args,
-          List.find (fun (lab, _, _) -> lab = "values") args
-        with
-        | (_, Some l, Required), (_, Some v, Required) ->
-          let pos = l.exp_loc.loc_start in
-          Printf.eprintf "%s:%d:%d %s:%d:%d\n%!"
-            fname lnum cnum
-             pos.pos_fname
-             pos.pos_lnum
-             (pos.pos_cnum - pos.pos_bol);
-          if pos.pos_fname = fname &&
-             pos.pos_lnum = lnum   &&
-             pos.pos_cnum - pos.pos_bol = cnum then
-            raise (Found v.exp_env)
-        | _ -> ()
-        | exception Not_found -> ()
+          try
+            match
+              List.find (fun (lab, _, _) -> lab = "loc"   ) args,
+              List.find (fun (lab, _, _) -> lab = "values") args
+            with
+            | (_, Some l, Required), (_, Some v, Required) ->
+              let pos = l.exp_loc.loc_start in
+              if pos.pos_fname = fname &&
+                 pos.pos_lnum = lnum   &&
+                 pos.pos_cnum - pos.pos_bol = cnum then
+                raise (Found v.exp_env)
+            | _ -> ()
+          with Not_found -> ()
         end
       | _ -> ()
 
@@ -1425,17 +1428,18 @@ let interact ~search_path ~unit ~loc:(fname, lnum, cnum, _) ~values =
     method char _ = ()
     method array _ = ()
   end in
-  match search#lift_Cmt_format_cmt_infos cmt_infos with
-  | () -> failwith "Couldn't find location in cmt file"
-  | exception (Found env) ->
-    try
-      List.iter Topdirs.dir_directory (search_path @ cmt_infos.cmt_loadpath);
-      let env = Envaux.env_of_only_summary env in
-      List.iter (fun (V (name, v)) -> Toploop.setvalue name (Obj.repr v)) values;
-      main_internal ~initial_env:(Some env)
-    with exn ->
-      Location.report_exception Format.err_formatter exn;
-      exit 2
+  try
+    search#lift_Cmt_format_cmt_infos cmt_infos;
+    failwith "Couldn't find location in cmt file"
+  with Found env ->
+  try
+    List.iter Topdirs.dir_directory (search_path @ cmt_infos.cmt_loadpath);
+    let env = Envaux.env_of_only_summary env in
+    List.iter (fun (V (name, v)) -> Toploop.setvalue name (Obj.repr v)) values;
+    main_internal ~initial_env:(Some env)
+  with exn ->
+    Location.report_exception Format.err_formatter exn;
+    exit 2
 
 let () =
   Location.register_error_of_exn
@@ -1444,3 +1448,5 @@ let () =
         Some (Location.error_of_printer_file Envaux.report_error err)
       | _ -> None
     )
+
+#endif