From 13011b0d4545d6dca69a31d44246f2f1972c8e66 Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Thu, 5 Jan 2023 14:48:48 +0100 Subject: [PATCH] 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 +---- src/lib/uTop_compat.ml | 132 +++++++++++++++++++++++++++++++++++++++ src/lib/uTop_complete.ml | 66 +------------------- src/lib/uTop_main.ml | 105 +++---------------------------- 4 files changed, 143 insertions(+), 176 deletions(-) create mode 100644 src/lib/uTop_compat.ml diff --git a/src/lib/uTop.ml b/src/lib/uTop.ml index 1a22fca..63f4163 100644 --- a/src/lib/uTop.ml +++ b/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 path = - Load_path.init path ~auto_include:Load_path.no_auto_include -#else -let set_load_path path = Load_path.init path -#endif +let set_load_path = UTop_compat.set_load_path (* +-----------------------------------------------------------------+ | Deprecated | diff --git a/src/lib/uTop_compat.ml b/src/lib/uTop_compat.ml new file mode 100644 index 0000000..9ab3769 --- /dev/null +++ b/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 diff --git a/src/lib/uTop_complete.ml b/src/lib/uTop_complete.ml index 2a0b43b..bfb6759 100644 --- a/src/lib/uTop_complete.ml +++ b/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 (constructors, _) -> -#else - | Type_variant constructors -> -#endif + | Type_variant _ -> 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 diff --git a/src/lib/uTop_main.ml b/src/lib/uTop_main.ml index 4352d3e..f5d6287 100644 --- a/src/lib/uTop_main.ml +++ b/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) - 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) + lookup_module name env 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 = Env.find_constructor_by_name id env in - #else - let cstr_desc = Env.lookup_constructor id env in - #endif + let cstr_desc = lookup_constructor id env in 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 ~auto_include:Load_path.no_auto_include (); -#else - Toploop.set_paths (); -#endif + toploop_set_paths (); try let ok = List.for_all (function | `Packages l -> UTop.require l; true - | `Object fn -> -#if OCAML_VERSION >= (4, 13, 0) - Toploop.load_file Format.err_formatter fn) -#else - Topdirs.load_file Format.err_formatter fn) -#endif + | `Object fn -> toploop_load_file Format.err_formatter fn) (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 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 + let search = iter_structure expr in try begin match cmt_infos.cmt_annots with | Implementation st -> search st