fix 4.01 compatibility

myocamlbuild.ml

@@ -92,13 +92,20 @@ let () =
              rule "format lifter"
                ~prod:"src/lib/uTop_cmt_lifter.ml"
                (fun _ _ ->
-                  Cmd (S [ P "ocamlfind"
+                  let ocaml_version =
-                         ; A "ppx_tools/genlifter"
+                    Scanf.sscanf (BaseEnvLight.var_get "ocaml_version" env)
-                         ; A "-I"
+                      "%u.%u" (fun a b -> (a, b))
-                         ; A "+compiler-libs"
+                  in
-                         ; A "Cmt_format.cmt_infos"
+                  if ocaml_version < (4, 02) then
-                         ; Sh ">"
+                    Echo ([], "src/lib/uTop_cmt_lifter.ml")
-                         ; A "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"
+                           ]))
          | _ ->
-             ())
+           ())

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
+    (try
-     | exception Not_found -> "vi"
+       Sys.getenv "EDITOR"
-     | s                   -> s)
+     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 =

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
+          try
-          List.find (fun (lab, _, _) -> lab = "loc"   ) args,
+            match
-          List.find (fun (lab, _, _) -> lab = "values") args
+              List.find (fun (lab, _, _) -> lab = "loc"   ) args,
-        with
+              List.find (fun (lab, _, _) -> lab = "values") args
-        | (_, Some l, Required), (_, Some v, Required) ->
+            with
-          let pos = l.exp_loc.loc_start in
+            | (_, Some l, Required), (_, Some v, Required) ->
-          Printf.eprintf "%s:%d:%d %s:%d:%d\n%!"
+              let pos = l.exp_loc.loc_start in
-            fname lnum cnum
+              if pos.pos_fname = fname &&
-             pos.pos_fname
+                 pos.pos_lnum = lnum   &&
-             pos.pos_lnum
+                 pos.pos_cnum - pos.pos_bol = cnum then
-             (pos.pos_cnum - pos.pos_bol);
+                raise (Found v.exp_env)
-          if pos.pos_fname = fname &&
+            | _ -> ()
-             pos.pos_lnum = lnum   &&
+          with Not_found -> ()
-             pos.pos_cnum - pos.pos_bol = cnum then
-            raise (Found v.exp_env)
-        | _ -> ()
-        | exception 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
+  try
-  | () -> failwith "Couldn't find location in cmt file"
+    search#lift_Cmt_format_cmt_infos cmt_infos;
-  | exception (Found env) ->
+    failwith "Couldn't find location in cmt file"
-    try
+  with Found env ->
-      List.iter Topdirs.dir_directory (search_path @ cmt_infos.cmt_loadpath);
+  try
-      let env = Envaux.env_of_only_summary env in
+    List.iter Topdirs.dir_directory (search_path @ cmt_infos.cmt_loadpath);
-      List.iter (fun (V (name, v)) -> Toploop.setvalue name (Obj.repr v)) values;
+    let env = Envaux.env_of_only_summary env in
-      main_internal ~initial_env:(Some env)
+    List.iter (fun (V (name, v)) -> Toploop.setvalue name (Obj.repr v)) values;
-    with exn ->
+    main_internal ~initial_env:(Some env)
-      Location.report_exception Format.err_formatter exn;
+  with exn ->
-      exit 2
+    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