Move compat functions to their module

The utop code base is full of #if OCAML_VERSION to adapt to the changes
in compiler-libs. This has some issues - for example the corresponding
logic is harder to recognize, and some logic is duplicated in several
places. Also, this prevents using a formatter.

One medium-term goal is to move most of the compat functions to a new
Utop_compat module which would be the only place we use cppo.

This contains the "easy" cases - moving existing functions, etc. It is a
bit more difficult (and controversial) to convert pattern matching to
this pattern so it'll be done separately.

src/lib/uTop.ml

@@ -16,13 +16,6 @@ open LTerm_style
 
 let (>>=) = Lwt.(>>=)
 
-let toploop_get_directive name =
-#if OCAML_VERSION >= (4, 13, 0)
-  Toploop.get_directive name
-#else
-  try Some (Hashtbl.find Toploop.directive_table name) with Not_found -> None
-#endif
-
 module String_set = Set.Make(String)
 
 let version = "%%VERSION%%"
@@ -812,7 +805,7 @@ let use_output command =
 
 let () =
   let name = "use_output" in
-  if toploop_get_directive name = None then
+  if UTop_compat.toploop_get_directive name = None then
     Toploop.add_directive
       name
       (Toploop.Directive_string use_output)
@@ -838,12 +831,7 @@ let () =
    +-----------------------------------------------------------------+ *)
 
 let get_load_path () = Load_path.get_paths ()
-#if OCAML_VERSION >= (5, 0, 0)
+let set_load_path = UTop_compat.set_load_path
-let set_load_path path =
-  Load_path.init path ~auto_include:Load_path.no_auto_include
-#else
-let set_load_path path = Load_path.init path
-#endif
 
 (* +-----------------------------------------------------------------+
    | Deprecated                                                      |

src/lib/uTop_compat.ml

@@ -0,0 +1,132 @@
+let lookup_value =
+#if OCAML_VERSION >= (4, 10, 0)
+  Env.find_value_by_name
+#else
+  Env.lookup_value
+#endif
+
+let get_desc x =
+#if OCAML_VERSION >= (4, 14, 0)
+  Types.get_desc x
+#else
+  x.Types.desc
+#endif
+
+let toploop_get_directive name =
+#if OCAML_VERSION >= (4, 13, 0)
+  Toploop.get_directive name
+#else
+  try Some (Hashtbl.find Toploop.directive_table name) with Not_found -> None
+#endif
+
+let lookup_module name env =
+#if OCAML_VERSION >= (4, 10, 0)
+  let path, md = Env.find_module_by_name name env in
+#else
+  let path = Env.lookup_module name env ~load:true in
+  let md = Env.find_module path env in
+#endif
+  (path, md.md_type)
+
+let lookup_label =
+#if OCAML_VERSION >= (4, 10, 0)
+  Env.find_label_by_name
+#else
+  Env.lookup_label
+#endif
+
+let lookup_modtype =
+#if OCAML_VERSION >= (4, 10, 0)
+  Env.find_modtype_by_name
+#else
+  Env.lookup_modtype
+#endif
+
+let lookup_constructor =
+#if OCAML_VERSION >= (4, 10, 0)
+  Env.find_constructor_by_name
+#else
+  Env.lookup_constructor
+#endif
+
+let lookup_class=
+#if OCAML_VERSION >= (4, 10, 0)
+  Env.find_class_by_name
+#else
+  Env.lookup_class
+#endif
+
+let longident_parse str =
+#if OCAML_VERSION >= (4, 11, 0)
+  let lexbuf = Lexing.from_string str in
+  Parse.longident lexbuf
+#else
+  Longident.parse str
+#endif
+
+let toploop_all_directive_names () =
+#if OCAML_VERSION >= (4, 13, 0)
+  Toploop.all_directive_names ()
+#else
+  Hashtbl.fold (fun dir _ acc -> dir::acc) Toploop.directive_table []
+#endif
+
+#if OCAML_VERSION >= (4, 10, 0)
+let lookup_type longident env =
+  Env.find_type_by_name longident env
+#else
+let lookup_type longident env =
+  let path = Env.lookup_type longident env in
+  (path, Env.find_type path env)
+#endif
+
+let set_load_path path =
+#if OCAML_VERSION >= (5, 0, 0)
+  Load_path.init path ~auto_include:Load_path.no_auto_include
+#else
+  Load_path.init path
+#endif
+
+let toploop_use_silently fmt name =
+#if OCAML_VERSION >= (4, 14, 0)
+  Toploop.use_silently fmt (File name)
+#else
+  Toploop.use_silently fmt name
+#endif
+
+module Persistent_signature =
+#if OCAML_VERSION >= (4, 09, 0)
+  Persistent_env.Persistent_signature
+#else
+  Env.Persistent_signature
+#endif
+
+let toploop_set_paths () =
+#if OCAML_VERSION >= (5, 0, 0)
+  Toploop.set_paths ~auto_include:Load_path.no_auto_include ()
+#else
+  Toploop.set_paths ()
+#endif
+
+let toploop_load_file ppf fn =
+#if OCAML_VERSION >= (4, 13, 0)
+  Toploop.load_file ppf fn
+#else
+  Topdirs.load_file ppf fn
+#endif
+
+let iter_structure expr =
+#if OCAML_VERSION >= (4,09,0)
+  let next iterator e = Tast_iterator.default_iterator.expr iterator e in
+  let expr iterator = expr (next iterator) in
+  let iter = { Tast_iterator.default_iterator with expr } in
+  iter.structure iter
+#else
+  let module Search =
+    TypedtreeIter.MakeIterator(struct
+      include TypedtreeIter.DefaultIteratorArgument
+
+      let enter_expression = expr ignore
+     end) in
+  Search.iter_structure
+#endif

src/lib/uTop_complete.ml

@@ -11,6 +11,7 @@
 
 open Types
 open LTerm_read_line
+open UTop_compat
 open UTop_token
 
 module String_set = Set.Make(String)
@@ -22,27 +23,6 @@ let set_of_list = List.fold_left (fun set x -> String_set.add x set) String_set.
    | Utils                                                           |
    +-----------------------------------------------------------------+ *)
 
-let get_desc x =
-#if OCAML_VERSION >= (4, 14, 0)
-  Types.get_desc x
-#else
-  x.Types.desc
-#endif
-
-let toploop_get_directive name =
-#if OCAML_VERSION >= (4, 13, 0)
-  Toploop.get_directive name
-#else
-  try Some (Hashtbl.find Toploop.directive_table name) with Not_found -> None
-#endif
-
-let toploop_all_directive_names () =
-#if OCAML_VERSION >= (4, 13, 0)
-  Toploop.all_directive_names ()
-#else
-  Hashtbl.fold (fun dir _ acc -> dir::acc) Toploop.directive_table []
-#endif
-
 (* Transform a non-empty list of strings into a long-identifier. *)
 let longident_of_list = function
   | [] ->
@@ -422,11 +402,7 @@ let constructor_name { cd_id = id } = Ident.name id
 
 let add_fields_of_type decl acc =
   match decl.type_kind with
-#if OCAML_VERSION >= (4, 13, 0)
+    | Type_variant _ ->
-    | Type_variant (constructors, _) ->
-#else
-    | Type_variant constructors ->
-#endif
         acc
     | Type_record (fields, _) ->
         List.fold_left (fun acc field -> add (field_name field) acc) acc fields
@@ -512,15 +488,6 @@ let rec fields_of_module_type = function
   | _ ->
       String_set.empty
 
-let lookup_module id env =
-#if OCAML_VERSION >= (4, 10, 0)
-  let path, decl = Env.find_module_by_name id env in
-  (path, decl.md_type)
-#else
-  let path = Env.lookup_module id env ~load:true in
-  (path, (Env.find_module path env).md_type)
-#endif
-
 let find_module path env = (Env.find_module path env).md_type
 
 let names_of_module longident =
@@ -728,13 +695,6 @@ let rec find_object meths type_expr =
               None
 
 let methods_of_object longident meths =
-  let lookup_value=
-#if OCAML_VERSION >= (4, 10, 0)
-    Env.find_value_by_name
-#else
-    Env.lookup_value
-#endif
-  in
   match lookup_env lookup_value longident !Toploop.toplevel_env with
     | None ->
         []
@@ -775,13 +735,6 @@ let rec labels_of_type acc type_expr =
         String_map.bindings acc
 
 let labels_of_function longident meths =
-  let lookup_value=
-#if OCAML_VERSION >= (4, 10, 0)
-    Env.find_value_by_name
-#else
-    Env.lookup_value
-#endif
-  in
   match lookup_env lookup_value longident !Toploop.toplevel_env with
     | None ->
         []
@@ -793,13 +746,6 @@ let labels_of_function longident meths =
               labels_of_type String_map.empty type_expr
 
 let labels_of_newclass longident =
-  let lookup_class=
-#if OCAML_VERSION >= (4, 10, 0)
-    Env.find_class_by_name
-#else
-    Env.lookup_class
-#endif
-  in
   match lookup_env lookup_class longident !Toploop.toplevel_env with
     | None ->
         []
@@ -852,14 +798,6 @@ and find_context_in_quotation = function
    | Completion                                                      |
    +-----------------------------------------------------------------+ *)
 
-#if OCAML_VERSION < (4, 11, 0)
-let longident_parse= Longident.parse
-#else
-let longident_parse str=
-  let lexbuf= Lexing.from_string str in
-  Parse.longident lexbuf
-#endif
-
 let complete ~phrase_terminator ~input =
   let true_name, false_name = ("true", "false") in
   let tokens = UTop_lexer.lex_string input in

src/lib/uTop_main.ml

@@ -14,24 +14,11 @@ open LTerm_dlist
 open LTerm_text
 open LTerm_geom
 open UTop
+open UTop_compat
 open UTop_token
 open UTop_styles
 open UTop_private
 
-let get_desc x =
-#if OCAML_VERSION >= (4, 14, 0)
-  Types.get_desc x
-#else
-  x.Types.desc
-#endif
-
-let toploop_use_silently fmt name =
-#if OCAML_VERSION >= (4, 14, 0)
-  Toploop.use_silently fmt (File name)
-#else
-  Toploop.use_silently fmt name
-#endif
-
 let return, (>>=) = Lwt.return, Lwt.(>>=)
 
 module String_set = Set.Make(String)
@@ -319,12 +306,6 @@ module Autoprinter : sig
 end = struct
   open Types
 
-#if OCAML_VERSION >= (4, 09, 0)
-  module Persistent_signature = Persistent_env.Persistent_signature
-#else
-  module Persistent_signature = Env.Persistent_signature
-#endif
-
   let cons_path path id =
     let comp = Ident.name id in
     match path with
@@ -354,13 +335,7 @@ end = struct
 
   let find_module id env =
     let name = Longident.Lident (Ident.name id) in
-#if OCAML_VERSION >= (4, 10, 0)
+    lookup_module name env
-    let path, md = Env.find_module_by_name name env in
-#else
-    let path = Env.lookup_module name env ~load:true in
-    let path, md = (path, Env.find_module path env) in
-#endif
-    (path, md)
 
   let scan_cmis =
     let new_cmis = ref [] in
@@ -386,7 +361,7 @@ end = struct
       let scan_module env id =
         let path, md = find_module id env in
         if path = Path.Pident id then
-          walk_mty pp (Longident.Lident (Ident.name id)) md.md_type
+          walk_mty pp (Longident.Lident (Ident.name id)) md
       in
       let rec scan_globals last = function
         | [] -> ()
@@ -596,14 +571,6 @@ type rewrite_rule = {
   (* Whether the rule is enabled or not. *)
 }
 
-#if OCAML_VERSION < (4, 11, 0)
-let longident_parse= Longident.parse
-#else
-let longident_parse str=
-  let lexbuf= Lexing.from_string str in
-  Parse.longident lexbuf
-#endif
-
 let longident_lwt_main_run = Longident.Ldot (Longident.Lident "Lwt_main", "run")
 let longident_async_thread_safe_block_on_async_exn =
   Longident.(Ldot (Ldot (Lident "Async", "Thread_safe"), "block_on_async_exn"))
@@ -643,15 +610,6 @@ let rewrite_rules = [
   }
 ]
 
-#if OCAML_VERSION >= (4, 10, 0)
-let lookup_type longident env =
-  Env.find_type_by_name longident env
-#else
-let lookup_type longident env =
-  let path = Env.lookup_type longident env in
-  (path, Env.find_type path env)
-#endif
-
 let rule_path rule =
   match rule.path_to_rewrite with
   | Some _ as x -> x
@@ -685,13 +643,6 @@ let rec is_persistent_path = function
 (* Check that the given long identifier is present in the environment
    and is persistent. *)
 let is_persistent_in_env longident =
-  let lookup_value=
-#if OCAML_VERSION >= (4, 10, 0)
-    Env.find_value_by_name
-#else
-    Env.lookup_value
-#endif
-  in
   try
     is_persistent_path (fst (lookup_value longident !Toploop.toplevel_env))
   with Not_found ->
@@ -1276,22 +1227,6 @@ end
 let typeof sid =
   let id  = longident_parse sid in
   let env = !Toploop.toplevel_env in
-#if OCAML_VERSION >= (4, 10, 0)
-  let lookup_value= Env.find_value_by_name
-  and lookup_label= Env.find_label_by_name
-  and lookup_modtype= Env.find_modtype_by_name
-  and lookup_module id env =
-    let path, decl = Env.find_module_by_name id env in
-    (path, decl.md_type)
-#else
-  let lookup_value= Env.lookup_value
-  and lookup_label= Env.lookup_label
-  and lookup_modtype= Env.lookup_modtype
-  and lookup_module id env =
-    let path = Env.lookup_module id env ~load:true in
-    (path, (Env.find_module path env).md_type)
-#endif
-  in
   let from_type_desc = function
     | Types.Tconstr (path, _, _) ->
       let typ_decl = Env.find_type path env in
@@ -1326,11 +1261,7 @@ let typeof sid =
       Some (Printtyp.tree_of_modtype_declaration id mty_decl)
     with Not_found ->
     try
-      #if OCAML_VERSION >= (4, 10, 0)
+      let cstr_desc = lookup_constructor id env in
-      let cstr_desc = Env.find_constructor_by_name id env in
-      #else
-      let cstr_desc = Env.lookup_constructor id env in
-      #endif
       match cstr_desc.Types.cstr_tag with
       | _ ->
         let (path, ty_decl) = from_type_desc (get_desc cstr_desc.Types.cstr_res) in
@@ -1369,22 +1300,13 @@ let emacs_mode = ref false
 let preload = ref []
 
 let prepare () =
-#if OCAML_VERSION >= (5, 0, 0)
+  toploop_set_paths ();
-  Toploop.set_paths ~auto_include:Load_path.no_auto_include ();
-#else
-  Toploop.set_paths ();
-#endif
   try
     let ok =
       List.for_all
         (function
           | `Packages l -> UTop.require l; true
-          | `Object fn ->
+          | `Object fn -> toploop_load_file Format.err_formatter fn)
-#if OCAML_VERSION >= (4, 13, 0)
-            Toploop.load_file Format.err_formatter fn)
-#else
-            Topdirs.load_file Format.err_formatter fn)
-#endif
         (List.rev !preload)
     in
     if ok then !Toploop.toplevel_startup_hook ();
@@ -1701,20 +1623,7 @@ let interact ?(search_path=[]) ?(build_dir="_build") ~unit ~loc:(fname, lnum, cn
           end
         | _ -> next e
   in
-#if OCAML_VERSION >= (4,09,0)
+  let search = iter_structure expr in
-  let next iterator e = Tast_iterator.default_iterator.expr iterator e in
-  let expr iterator = expr (next iterator) in
-  let iter = { Tast_iterator.default_iterator with expr } in
-  let search = iter.structure iter in
-#else
-  let module Search =
-    TypedtreeIter.MakeIterator(struct
-      include TypedtreeIter.DefaultIteratorArgument
-
-      let enter_expression = expr ignore
-     end) in
-    let search = Search.iter_structure in
-#endif
   try
     begin match cmt_infos.cmt_annots with
     | Implementation st -> search st