From 644278311d4994d2ad463daf2741fba60982761a Mon Sep 17 00:00:00 2001 From: Deokhwan Kim Date: Thu, 20 Apr 2017 08:34:48 -0400 Subject: [PATCH] Simplify #if directives UTop does not support OCaml < 4.02 anymore. --- src/lib/uTop.ml | 31 -------------- src/lib/uTop_complete.ml | 54 +---------------------- src/lib/uTop_main.ml | 93 +--------------------------------------- 3 files changed, 3 insertions(+), 175 deletions(-) diff --git a/src/lib/uTop.ml b/src/lib/uTop.ml index cbd1e1b..f8e23c2 100644 --- a/src/lib/uTop.ml +++ b/src/lib/uTop.ml @@ -260,14 +260,12 @@ let parse_default parse str eos_is_error = | Syntaxerr.Variable_in_scope (loc, var) -> Error ([mkloc loc], Printf.sprintf "In this scoped type, variable '%s is reserved for the local type %s." var var) -#if OCAML_VERSION >= (4, 02, 0) | Syntaxerr.Not_expecting (loc, nonterm) -> Error ([mkloc loc], Printf.sprintf "Syntax error: %s not expected" nonterm) | Syntaxerr.Ill_formed_ast (loc, s) -> Error ([mkloc loc], Printf.sprintf "Error: broken invariant in parsetree: %s" s) -#endif #if OCAML_VERSION >= (4, 03, 0) | Syntaxerr.Invalid_package_type (loc, s) -> Error ([mkloc loc], @@ -331,34 +329,6 @@ let check_phrase phrase = (* Construct "let _ () = let module _ = struct end in ()" in order to test the typing and compilation of [items] without evaluating them. *) let unit = with_loc loc (Longident.Lident "()") in -#if OCAML_VERSION < (4, 02, 0) - let structure = { - pmod_loc = loc; - pmod_desc = Pmod_structure (item :: items); - } in - let unit_expr = { - pexp_desc = Pexp_construct (unit, None, false); - pexp_loc = loc; - } in - let unit_patt = { - ppat_desc = Ppat_construct (unit, None, false); - ppat_loc = loc; - } in - let letmodule = { - pexp_desc = Pexp_letmodule (with_loc loc "_", structure, unit_expr); - pexp_loc = loc; - } in - let func = { - pexp_desc = Pexp_function ("", None, [(unit_patt, letmodule)]); - pexp_loc = loc; - } in - let top_def = { - pstr_desc = Pstr_value (Asttypes.Nonrecursive, - [({ ppat_desc = Ppat_var (with_loc loc "_"); - ppat_loc = loc }, func)]); - pstr_loc = loc; - } in -#else let top_def = let open Ast_helper in with_default_loc loc @@ -369,7 +339,6 @@ let check_phrase phrase = (Mod.structure (item :: items)) (Exp.construct unit None)))) in -#endif let check_phrase = Ptop_def [top_def] in try let _ = diff --git a/src/lib/uTop_complete.ml b/src/lib/uTop_complete.ml index e76d5c3..0f7b214 100644 --- a/src/lib/uTop_complete.ml +++ b/src/lib/uTop_complete.ml @@ -302,7 +302,6 @@ let list_directories dir = String_set.empty (try Sys.readdir (if dir = "" then Filename.current_dir_name else dir) with Sys_error _ -> [||])) -#if OCAML_VERSION >= (4, 02, 0) let path () = let path_separator = match Sys.os_type with @@ -325,7 +324,6 @@ let path () = try split (Sys.getenv "PATH") path_separator with Not_found -> [] -#endif (* +-----------------------------------------------------------------+ | Names listing | @@ -394,13 +392,8 @@ let visible_modules () = acc) String_set.empty !Config.load_path) -#if OCAML_VERSION >= (4, 02, 0) let field_name { ld_id = id } = Ident.name id let constructor_name { cd_id = id } = Ident.name id -#else -let field_name (id, _, _) = Ident.name id -let constructor_name (id, _, _) = Ident.name id -#endif let add_fields_of_type decl acc = match decl.type_kind with @@ -410,10 +403,8 @@ let add_fields_of_type decl acc = List.fold_left (fun acc field -> add (field_name field) acc) acc fields | Type_abstract -> acc -#if OCAML_VERSION >= (4, 02, 0) | Type_open -> acc -#endif let add_names_of_type decl acc = match decl.type_kind with @@ -423,16 +414,14 @@ let add_names_of_type decl acc = List.fold_left (fun acc field -> add (field_name field) acc) acc fields | Type_abstract -> acc -#if OCAML_VERSION >= (4, 02, 0) | Type_open -> acc -#endif #if OCAML_VERSION >= (4, 04, 0) let path_of_mty_alias = function | Mty_alias (_, path) -> path | _ -> assert false -#elif OCAML_VERSION >= (4, 02, 0) +#else let path_of_mty_alias = function | Mty_alias path -> path | _ -> assert false @@ -443,11 +432,7 @@ let rec names_of_module_type = function List.fold_left (fun acc decl -> match decl with | Sig_value (id, _) -#if OCAML_VERSION >= (4, 02, 0) | Sig_typext (id, _, _) -#else - | Sig_exception (id, _) -#endif | Sig_module (id, _, _) | Sig_modtype (id, _) | Sig_class (id, _, _) @@ -458,23 +443,16 @@ let rec names_of_module_type = function String_set.empty decls | Mty_ident path -> begin match lookup_env Env.find_modtype path !Toploop.toplevel_env with -#if OCAML_VERSION < (4, 02, 0) - | Some Modtype_abstract -> String_set.empty - | Some Modtype_manifest module_type -> names_of_module_type module_type -#else | Some { mtd_type = None } -> String_set.empty | Some { mtd_type = Some module_type } -> names_of_module_type module_type -#endif | None -> String_set.empty end -#if OCAML_VERSION >= (4, 02, 0) | Mty_alias _ as mty_alias -> begin let path = path_of_mty_alias mty_alias in match lookup_env Env.find_module path !Toploop.toplevel_env with | None -> String_set.empty | Some { md_type = module_type } -> names_of_module_type module_type end -#endif | _ -> String_set.empty @@ -483,11 +461,7 @@ let rec fields_of_module_type = function List.fold_left (fun acc decl -> match decl with | Sig_value (id, _) -#if OCAML_VERSION >= (4, 02, 0) | Sig_typext (id, _, _) -#else - | Sig_exception (id, _) -#endif | Sig_module (id, _, _) | Sig_modtype (id, _) | Sig_class (id, _, _) @@ -498,35 +472,23 @@ let rec fields_of_module_type = function String_set.empty decls | Mty_ident path -> begin match lookup_env Env.find_modtype path !Toploop.toplevel_env with -#if OCAML_VERSION < (4, 02, 0) - | Some Modtype_abstract -> String_set.empty - | Some Modtype_manifest module_type -> fields_of_module_type module_type -#else | Some { mtd_type = None } -> String_set.empty | Some { mtd_type = Some module_type } -> fields_of_module_type module_type -#endif | None -> String_set.empty end -#if OCAML_VERSION >= (4, 02, 0) | Mty_alias _ as mty_alias -> begin let path = path_of_mty_alias mty_alias in match lookup_env Env.find_module path !Toploop.toplevel_env with | None -> String_set.empty | Some { md_type = module_type } -> fields_of_module_type module_type end -#endif | _ -> String_set.empty -#if OCAML_VERSION < (4, 02, 0) -let lookup_module = Env.lookup_module -let find_module = Env.find_module -#else let lookup_module id env = let path = Env.lookup_module id env ~load:true in (path, (Env.find_module path env).md_type) let find_module path env = (Env.find_module path env).md_type -#endif let names_of_module longident = try @@ -563,11 +525,7 @@ let list_global_names () = loop (add (Ident.name id) acc) summary | Env.Env_type(summary, id, decl) -> loop (add_names_of_type decl (add (Ident.name id) acc)) summary -#if OCAML_VERSION >= (4, 02, 0) | Env.Env_extension(summary, id, _) -> -#else - | Env.Env_exception(summary, id, _) -> -#endif loop (add (Ident.name id) acc) summary | Env.Env_module(summary, id, _) -> loop (add (Ident.name id) acc) summary @@ -577,10 +535,8 @@ let list_global_names () = loop (add (Ident.name id) acc) summary | Env.Env_cltype(summary, id, _) -> loop (add (Ident.name id) acc) summary -#if OCAML_VERSION >= (4, 02, 0) | Env.Env_functor_arg(summary, id) -> loop (add (Ident.name id) acc) summary -#endif #if OCAML_VERSION >= (4, 04, 0) | Env.Env_constraints (summary, _) -> loop acc summary @@ -632,18 +588,12 @@ let list_global_fields () = loop (add (Ident.name id) acc) summary | Env.Env_type(summary, id, decl) -> loop (add_fields_of_type decl (add (Ident.name id) acc)) summary -#if OCAML_VERSION >= (4, 02, 0) | Env.Env_extension(summary, id, _) -> -#else - | Env.Env_exception(summary, id, _) -> -#endif loop (add (Ident.name id) acc) summary | Env.Env_module(summary, id, _) -> loop (add (Ident.name id) acc) summary -#if OCAML_VERSION >= (4, 02, 0) | Env.Env_functor_arg(summary, id) -> loop (add (Ident.name id) acc) summary -#endif | Env.Env_modtype(summary, id, _) -> loop (add (Ident.name id) acc) summary | Env.Env_class(summary, id, _) -> @@ -916,7 +866,6 @@ let complete ~syntax ~phrase_terminator ~input = (loc.idx2 - Zed_utf8.length name, List.map (function (w, Directory) -> (w, "") | (w, File) -> (w, "\"" ^ phrase_terminator)) result) -#if OCAML_VERSION >= (4, 02, 0) (* Completion on #ppx. *) | [(Symbol "#", _); (Lident ("ppx"), _); (String (tlen, false), loc)] -> let file = String.sub input (loc.ofs1 + tlen) (String.length input - loc.ofs1 - tlen) in @@ -945,7 +894,6 @@ let complete ~syntax ~phrase_terminator ~input = let result = lookup_assoc name list in (loc.idx2 - Zed_utf8.length name, List.map (function (w, Directory) -> (w, "") | (w, File) -> (w, "\"" ^ phrase_terminator)) result) -#endif (* Completion on #use and #mod_use *) | [(Symbol "#", _); (Lident "use", _); (String (tlen, false), loc)] diff --git a/src/lib/uTop_main.ml b/src/lib/uTop_main.ml index 4273845..64bbcac 100644 --- a/src/lib/uTop_main.ml +++ b/src/lib/uTop_main.ml @@ -82,17 +82,15 @@ let convert_locs str locs = List.map (fun (a, b) -> (index_of_offset str a, inde #if OCAML_VERSION >= (4, 04, 0) let ast_impl_kind = Pparse.Structure -#elif OCAML_VERSION >= (4, 02, 0) +#else let ast_impl_kind = Config.ast_impl_magic_number #endif let preprocess input = match input with -#if OCAML_VERSION >= (4, 02, 0) | Parsetree.Ptop_def pstr -> Parsetree.Ptop_def (Pparse.apply_rewriters ~tool_name:"ocaml" ast_impl_kind pstr) -#endif | _ -> input let parse_input_multi input = @@ -320,17 +318,9 @@ let rec map_items unwrap wrap items = | Outcometree.Osig_class (_, name, _, _, rs) | Outcometree.Osig_class_type (_, name, _, _, rs) | Outcometree.Osig_module (name, _, rs) -#if OCAML_VERSION >= (4, 02, 0) | Outcometree.Osig_type ({ Outcometree.otype_name = name }, rs) -> -#else - | Outcometree.Osig_type ((name, _, _, _, _), rs) -> -#endif (name, rs) -#if OCAML_VERSION >= (4, 02, 0) | Outcometree.Osig_typext ({ Outcometree.oext_name = name}, _) -#else - | Outcometree.Osig_exception (name, _) -#endif | Outcometree.Osig_modtype (name, _) #if OCAML_VERSION < (4, 03, 0) | Outcometree.Osig_value (name, _, _) -> @@ -373,11 +363,7 @@ let rec map_items unwrap wrap items = wrap (Outcometree.Osig_type (oty, Outcometree.Orec_first)) extra :: items' else items -#if OCAML_VERSION >= (4, 02, 0) | Outcometree.Osig_typext _ -#else - | Outcometree.Osig_exception _ -#endif #if OCAML_VERSION >= (4, 03, 0) | Outcometree.Osig_ellipsis #endif @@ -437,20 +423,6 @@ let longident_async_thread_safe_block_on_async_exn = Longident.parse "Async.Std.Thread_safe.block_on_async_exn" let longident_unit = Longident.Lident "()" -#if OCAML_VERSION < (4, 02, 0) -(* Wrap into: fun () -> *) -let wrap_unit loc e = - let i = with_loc loc longident_unit in - let p = { - Parsetree.ppat_desc = Parsetree.Ppat_construct (i, None, false); - Parsetree.ppat_loc = loc; - } in - { - Parsetree.pexp_desc = Parsetree.Pexp_function ("", None, [(p, e)]); - Parsetree.pexp_loc = loc; - } -#endif - #if OCAML_VERSION >= (4, 03, 0) let nolabel = Asttypes.Nolabel #else @@ -464,19 +436,10 @@ let rewrite_rules = [ path_to_rewrite = None; required_values = [longident_lwt_main_run]; rewrite = (fun loc e -> -#if OCAML_VERSION < (4, 02, 0) - { Parsetree.pexp_desc = - Parsetree.Pexp_apply - ({ Parsetree.pexp_desc = Parsetree.Pexp_ident (with_loc loc longident_lwt_main_run); - Parsetree.pexp_loc = loc }, - [("", e)]) - ; Parsetree.pexp_loc = loc } -#else let open Ast_helper in with_default_loc loc (fun () -> Exp.apply (Exp.ident (with_loc loc longident_lwt_main_run)) [(nolabel, e)] ) -#endif ); enabled = UTop.auto_run_lwt; }; @@ -488,15 +451,6 @@ let rewrite_rules = [ path_to_rewrite = None; required_values = [longident_async_thread_safe_block_on_async_exn]; rewrite = (fun loc e -> -#if OCAML_VERSION < (4, 02, 0) - { Parsetree.pexp_desc = - Parsetree.Pexp_apply - ({ Parsetree.pexp_desc = Parsetree.Pexp_ident - (with_loc loc longident_async_thread_safe_block_on_async_exn); - Parsetree.pexp_loc = loc }, - [("", wrap_unit loc e)]) - ; Parsetree.pexp_loc = loc } -#else let open Ast_helper in let punit = Pat.construct (with_loc loc (Longident.Lident "()")) None in with_default_loc loc (fun () -> @@ -504,7 +458,6 @@ let rewrite_rules = [ (Exp.ident (with_loc loc longident_async_thread_safe_block_on_async_exn)) [(nolabel, Exp.fun_ nolabel None punit e)] ) -#endif ); enabled = UTop.auto_run_async; } @@ -580,22 +533,6 @@ let rec rule_of_type typ = | _ -> None -#if OCAML_VERSION < (4, 02, 0) -let rewrite_str_item pstr_item tstr_item = - match pstr_item, tstr_item.Typedtree.str_desc with - | ({ Parsetree.pstr_desc = Parsetree.Pstr_eval e; - Parsetree.pstr_loc = loc }, - Typedtree.Tstr_eval { Typedtree.exp_type = typ }) -> begin - match rule_of_type typ with - | Some rule -> - { Parsetree.pstr_desc = Parsetree.Pstr_eval (rule.rewrite loc e); - Parsetree.pstr_loc = loc } - | None -> - pstr_item - end - | _ -> - pstr_item -#else let rewrite_str_item pstr_item tstr_item = match pstr_item, tstr_item.Typedtree.str_desc with | ({ Parsetree.pstr_desc = Parsetree.Pstr_eval (e, _); @@ -610,7 +547,6 @@ let rewrite_str_item pstr_item tstr_item = end | _ -> pstr_item -#endif let rewrite phrase = match phrase with @@ -763,11 +699,7 @@ let read_input_classic prompt buffer len = else Lwt_io.read_char_opt Lwt_io.stdin >>= function | Some c -> -#if OCAML_VERSION >= (4, 02, 0) Bytes.set buffer i c; -#else - buffer.[i] <- c; -#endif if c = '\n' then return (i + 1, false) else @@ -893,9 +825,7 @@ module Emacs(M : sig end) = struct (* Rewrite toplevel expressions. *) let phrase = rewrite phrase in try -#if OCAML_VERSION > (4, 00, 1) Env.reset_cache_toplevel (); -#endif ignore (Toploop.execute_phrase true Format.std_formatter phrase); true with exn -> @@ -1107,12 +1037,8 @@ let typeof sid = Some (Printtyp.tree_of_type_declaration id ty_decl Types.Trec_not) with Not_found -> try -#if OCAML_VERSION < (4, 02, 0) - let (path, mod_typ) = Env.lookup_module id env in -#else let path = Env.lookup_module id env ~load:true in let mod_typ = (Env.find_module path env).Types.md_type in -#endif let id = Ident.create (Path.name path) in Some (Printtyp.tree_of_module id mod_typ Types.Trec_not) with Not_found -> @@ -1124,12 +1050,6 @@ let typeof sid = try let cstr_desc = Env.lookup_constructor id env in match cstr_desc.Types.cstr_tag with -#if OCAML_VERSION < (4, 02, 0) - | Types.Cstr_exception (_path, loc) -> - let path, exn_decl = Typedecl.transl_exn_rebind env loc id in - let id = Ident.create (Path.name path) in - Some (Printtyp.tree_of_exception_declaration id exn_decl) -#endif | _ -> let (path, ty_decl) = from_type_desc cstr_desc.Types.cstr_res.Types.desc in let id = Ident.create (Path.name path) in @@ -1220,13 +1140,9 @@ let args = Arg.align [ "-noassert", Arg.Set Clflags.noassert, " Do not compile assertion checks"; "-nolabels", Arg.Set Clflags.classic, " Ignore non-optional labels in types"; "-nostdlib", Arg.Set Clflags.no_std_include, " Do not add default directory to the list of include directories"; -#if OCAML_VERSION >= (4, 02, 0) "-ppx", Arg.String (fun ppx -> Clflags.all_ppx := ppx :: !Clflags.all_ppx), " Pipe abstract syntax trees through preprocessor "; -#endif "-principal", Arg.Set Clflags.principal, " Check principality of type inference"; -#if OCAML_VERSION >= (4, 02, 0) "-safe-string", Arg.Clear Clflags.unsafe_string, " Make strings immutable"; -#endif "-short-paths", Arg.Clear Clflags.real_paths, " Shorten paths in types (the default)"; "-no-short-paths", Arg.Set Clflags.real_paths, " Do not shorten paths in types"; "-rectypes", Arg.Set Clflags.recursive_types, " Allow arbitrary recursive types"; @@ -1396,12 +1312,7 @@ 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" - -#elif not defined ENABLE_INTERACT +#if not defined ENABLE_INTERACT let interact ~search_path ~unit ~loc:(fname, lnum, cnum, _) ~values = failwith "\