haskal
/
utop
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge pull request #393 from emillon/408 

Bump the compat to 4.08+
This commit is contained in:
Etienne Millon 2022-07-21 10:15:10 +02:00 committed by GitHub
parent ebca87c7a3 7a1d87e2da
commit f9b5ec7266
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 16 additions and 208 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
CHANGES.md
View File

@ -1,3 +1,8 @@
Unreleased
----------
* Bump the compatibility to 4.08+ (#393 @emillon)
2.10.0 (2022-10-06)
------------------

34
src/lib/uTop.ml
View File

@ -204,10 +204,7 @@ let discard_formatters pps f =
(* Output functions. *)
let out_functions = {
Format.out_string = (fun _ _ _ -> ()); out_flush = ignore;
out_newline = ignore; out_spaces = ignore
#if OCAML_VERSION >= (4, 06, 0)
; out_indent = ignore
#endif
out_newline = ignore; out_spaces = ignore ; out_indent = ignore
} in
(* Replace formatter functions. *)
List.iter (fun pp -> Format.pp_set_formatter_out_functions pp out_functions) pps;
@ -270,14 +267,10 @@ let parse_default parse str eos_is_error =
(* If the string is empty, do not report an error. *)
raise Need_more
| Lexer.Error (error, loc) ->
#if OCAML_VERSION >= (4, 08, 0)
(match Location.error_of_exn (Lexer.Error (error, loc)) with
| Some (`Ok error)->
Error ([mkloc loc], get_message Location.print_report error)
| _-> raise Need_more)
#else
Error ([mkloc loc], get_message Lexer.report_error error)
#endif
| Syntaxerr.Error error -> begin
match error with
| Syntaxerr.Unclosed (opening_loc, opening, closing_loc, closing) ->
@ -301,11 +294,9 @@ let parse_default parse str eos_is_error =
| Syntaxerr.Ill_formed_ast (loc, s) ->
Error ([mkloc loc],
Printf.sprintf "Error: broken invariant in parsetree: %s" s)
#if OCAML_VERSION >= (4, 03, 0)
| Syntaxerr.Invalid_package_type (loc, s) ->
Error ([mkloc loc],
Printf.sprintf "Invalid package type: %s" s)
#endif
#if OCAML_VERSION >= (5, 0, 0)
| Syntaxerr.Removed_string_set loc ->
Error ([mkloc loc],
@ -345,12 +336,6 @@ let with_loc loc str = {
Location.loc = loc;
}
#if OCAML_VERSION >= (4, 03, 0)
let nolabel = Asttypes.Nolabel
#else
let nolabel = ""
#endif
(* Check that the given phrase can be evaluated without typing/compile
errors. *)
let check_phrase phrase =
@ -377,7 +362,7 @@ let check_phrase phrase =
with_default_loc loc
(fun () ->
Str.eval
(Exp.fun_ nolabel None (Pat.construct unit None)
(Exp.fun_ Nolabel None (Pat.construct unit None)
(Exp.letmodule (with_loc loc
#if OCAML_VERSION >= (4, 10, 0)
(Some "_")
@ -810,17 +795,9 @@ let () =
| Backports |
+-----------------------------------------------------------------+ *)
let try_finally ~always work=
#if OCAML_VERSION >= (4, 08, 0)
Misc.try_finally ~always work
#else
Misc.try_finally work always
#endif
let use_output command =
let fn = Filename.temp_file "ocaml" "_toploop.ml" in
try_finally ~always:(fun () ->
Misc.try_finally ~always:(fun () ->
try Sys.remove fn with Sys_error _ -> ())
(fun () ->
match
@ -860,7 +837,6 @@ let () =
| Compiler-libs re-exports |
+-----------------------------------------------------------------+ *)
#if OCAML_VERSION >= (4, 08, 0)
let get_load_path () = Load_path.get_paths ()
#if OCAML_VERSION >= (5, 0, 0)
let set_load_path path =
@ -868,10 +844,6 @@ let set_load_path path =
#else
let set_load_path path = Load_path.init path
#endif
#else
let get_load_path () = !Config.load_path
let set_load_path path = Config.load_path := path
#endif
(* +-----------------------------------------------------------------+
| Deprecated |

82
src/lib/uTop_complete.ml
View File

@ -414,11 +414,7 @@ let visible_modules () =
(Sys.readdir (if dir = "" then Filename.current_dir_name else dir))
with Sys_error _ ->
acc)
#if OCAML_VERSION >= (4, 08, 0)
String_set.empty @@ Load_path.get_paths ()
#else
String_set.empty !Config.load_path
#endif
)
let field_name { ld_id = id } = Ident.name id
@ -454,45 +450,22 @@ let add_names_of_type decl acc =
| Type_open ->
acc
#if OCAML_VERSION >= (4, 08, 0)
let path_of_mty_alias = function
| Mty_alias path -> path
| _ -> assert false
#elif OCAML_VERSION >= (4, 04, 0)
let path_of_mty_alias = function
| Mty_alias (_, path) -> path
| _ -> assert false
#else
let path_of_mty_alias = function
| Mty_alias path -> path
| _ -> assert false
#endif
let rec names_of_module_type = function
| Mty_signature decls ->
List.fold_left
(fun acc decl -> match decl with
#if OCAML_VERSION >= (4, 08, 0)
| Sig_value (id, _, _)
| Sig_typext (id, _, _, _)
| Sig_module (id, _, _, _, _)
| Sig_modtype (id, _, _)
| Sig_class (id, _, _, _)
| Sig_class_type (id, _, _, _) ->
#else
| Sig_value (id, _)
| Sig_typext (id, _, _)
| Sig_module (id, _, _)
| Sig_modtype (id, _)
| Sig_class (id, _, _)
| Sig_class_type (id, _, _) ->
#endif
add (Ident.name id) acc
#if OCAML_VERSION >= (4, 08, 0)
| Sig_type (id, decl, _, _) ->
#else
| Sig_type (id, decl, _) ->
#endif
add_names_of_type decl (add (Ident.name id) acc))
String_set.empty decls
| Mty_ident path -> begin
@ -521,11 +494,7 @@ let rec fields_of_module_type = function
| Sig_class _
| Sig_class_type _ ->
acc
#if OCAML_VERSION >= (4, 08, 0)
| Sig_type (_, decl, _, _) ->
#else
| Sig_type (_, decl, _) ->
#endif
add_fields_of_type decl acc)
String_set.empty decls
| Mty_ident path -> begin
@ -595,11 +564,7 @@ let list_global_names () =
loop (add_names_of_type decl (add (Ident.name id) acc)) summary
| Env.Env_extension(summary, id, _) ->
loop (add (Ident.name id) acc) summary
#if OCAML_VERSION >= (4, 08, 0)
| Env.Env_module(summary, id, _, _) ->
#else
| Env.Env_module(summary, id, _) ->
#endif
loop (add (Ident.name id) acc) summary
| Env.Env_modtype(summary, id, _) ->
loop (add (Ident.name id) acc) summary
@ -609,28 +574,18 @@ let list_global_names () =
loop (add (Ident.name id) acc) summary
| Env.Env_functor_arg(summary, id) ->
loop (add (Ident.name id) acc) summary
#if OCAML_VERSION >= (4, 08, 0)
| Env.Env_persistent (summary, id) ->
loop (add (Ident.name id) acc) summary
#endif
#if OCAML_VERSION >= (4, 04, 0)
| Env.Env_constraints (summary, _) ->
loop acc summary
#endif
#if OCAML_VERSION >= (4, 10, 0)
| Env.Env_copy_types summary ->
loop acc summary
#elif OCAML_VERSION >= (4, 06, 0)
#else
| Env.Env_copy_types (summary, _) ->
loop acc summary
#endif
#if OCAML_VERSION >= (4, 08, 0)
| Env.Env_open(summary, path) ->
#elif OCAML_VERSION >= (4, 07, 0)
| Env.Env_open(summary, _, path) ->
#else
| Env.Env_open(summary, path) ->
#endif
match try Some (Path_map.find path !local_names_by_path) with Not_found -> None with
| Some names ->
loop (String_set.union acc names) summary
@ -670,11 +625,7 @@ let list_global_fields () =
loop (add_fields_of_type decl (add (Ident.name id) acc)) summary
| Env.Env_extension(summary, id, _) ->
loop (add (Ident.name id) acc) summary
#if OCAML_VERSION >= (4, 08, 0)
| Env.Env_module(summary, id, _, _) ->
#else
| Env.Env_module(summary, id, _) ->
#endif
loop (add (Ident.name id) acc) summary
| Env.Env_functor_arg(summary, id) ->
loop (add (Ident.name id) acc) summary
@ -684,30 +635,18 @@ let list_global_fields () =
loop (add (Ident.name id) acc) summary
| Env.Env_cltype(summary, id, _) ->
loop (add (Ident.name id) acc) summary
#if OCAML_VERSION >= (4, 08, 0)
| Env.Env_persistent (summary, id) ->
loop (add (Ident.name id) acc) summary
#endif
#if OCAML_VERSION >= (4, 04, 0)
| Env.Env_constraints (summary, _) ->
loop acc summary
#endif
#if OCAML_VERSION >= (4, 10, 0)
| Env.Env_copy_types summary ->
loop acc summary
#elif OCAML_VERSION >= (4, 06, 0)
#else
| Env.Env_copy_types (summary, _) ->
loop acc summary
#endif
#if OCAML_VERSION >= (4, 07, 0)
#if OCAML_VERSION >= (4, 08, 0)
| Env.Env_open(summary, path) ->
#else
| Env.Env_open(summary, _, path) ->
#endif
#else
| Env.Env_open(summary, path) ->
#endif
match try Some (Path_map.find path !local_fields_by_path) with Not_found -> None with
| Some fields ->
loop (String_set.union acc fields) summary
@ -817,14 +756,6 @@ let rec labels_of_type acc type_expr =
| Tpoly (te, _) ->
labels_of_type acc te
| Tarrow(label, _, te, _) ->
#if OCAML_VERSION < (4, 03, 0)
if label = "" then
labels_of_type acc te
else if label.[0] = '?' then
labels_of_type (String_map.add (String.sub label 1 (String.length label - 1)) Optional acc) te
else
labels_of_type (String_map.add label Required acc) te
#else
(match label with
| Nolabel ->
labels_of_type acc te
@ -832,7 +763,6 @@ let rec labels_of_type acc type_expr =
labels_of_type (String_map.add label Optional acc) te
| Labelled label ->
labels_of_type (String_map.add label Required acc) te)
#endif
| Tconstr(path, _, _) -> begin
match lookup_env Env.find_type path !Toploop.toplevel_env with
| None
@ -985,11 +915,7 @@ let complete ~phrase_terminator ~input =
(fun acc d -> add_files filter acc (Filename.concat d dir))
String_map.empty
(Filename.current_dir_name ::
#if OCAML_VERSION >= (4, 08, 0)
(Load_path.get_paths ())
#else
!Config.load_path
#endif
)
else
@ -1049,11 +975,7 @@ let complete ~phrase_terminator ~input =
(fun acc d -> add_files filter acc (Filename.concat d dir))
String_map.empty
(Filename.current_dir_name ::
#if OCAML_VERSION >= (4, 08, 0)
(Load_path.get_paths ())
#else
!Config.load_path
#endif
)
else
add_files filter String_map.empty (Filename.dirname file)

101
src/lib/uTop_main.ml
View File

@ -130,17 +130,11 @@ let convert_loc_line input locs lines =
| The read-line class |
+-----------------------------------------------------------------+ *)
#if OCAML_VERSION >= (4, 04, 0)
let ast_impl_kind = Pparse.Structure
#else
let ast_impl_kind = Config.ast_impl_magic_number
#endif
let preprocess input =
match input with
| Parsetree.Ptop_def pstr ->
Parsetree.Ptop_def
(Pparse.apply_rewriters ~tool_name:"ocaml" ast_impl_kind pstr)
(Pparse.apply_rewriters ~tool_name:"ocaml" Pparse.Structure pstr)
| _ -> input
let parse_input_multi input =
@ -383,14 +377,9 @@ let map_items unwrap wrap items =
(name, rs)
| Outcometree.Osig_typext ({ Outcometree.oext_name = name}, _)
| Outcometree.Osig_modtype (name, _)
#if OCAML_VERSION < (4, 03, 0)
| Outcometree.Osig_value (name, _, _) ->
(name, Outcometree.Orec_not)
#else
| Outcometree.Osig_value { oval_name = name; _ } ->
(name, Outcometree.Orec_not)
| Outcometree.Osig_ellipsis -> ("", Outcometree.Orec_not)
#endif
in
let keep =
name = "" || name.[0] <> '_' ||
@ -428,9 +417,7 @@ let map_items unwrap wrap items =
else
items
| Outcometree.Osig_typext _
#if OCAML_VERSION >= (4, 03, 0)
| Outcometree.Osig_ellipsis
#endif
| Outcometree.Osig_modtype _
| Outcometree.Osig_value _ ->
items
@ -497,12 +484,6 @@ let longident_async_thread_safe_block_on_async_exn =
Longident.(Ldot (Ldot (Lident "Async", "Thread_safe"), "block_on_async_exn"))
let longident_unit = Longident.Lident "()"
#if OCAML_VERSION >= (4, 03, 0)
let nolabel = Asttypes.Nolabel
#else
let nolabel = ""
#endif
let rewrite_rules = [
(* Rewrite Lwt.t expressions to Lwt_main.run <expr> *)
{
@ -512,7 +493,7 @@ let rewrite_rules = [
rewrite = (fun loc e ->
let open Ast_helper in
with_default_loc loc (fun () ->
Exp.apply (Exp.ident (with_loc loc longident_lwt_main_run)) [(nolabel, e)]
Exp.apply (Exp.ident (with_loc loc longident_lwt_main_run)) [(Nolabel, e)]
)
);
enabled = UTop.auto_run_lwt;
@ -530,7 +511,7 @@ let rewrite_rules = [
with_default_loc loc (fun () ->
Exp.apply
(Exp.ident (with_loc loc longident_async_thread_safe_block_on_async_exn))
[(nolabel, Exp.fun_ nolabel None punit e)]
[(Nolabel, Exp.fun_ Nolabel None punit e)]
)
);
enabled = UTop.auto_run_async;
@ -540,12 +521,10 @@ let rewrite_rules = [
#if OCAML_VERSION >= (4, 10, 0)
let lookup_type longident env =
Env.find_type_by_name longident env
#elif OCAML_VERSION >= (4, 04, 0)
#else
let lookup_type longident env =
let path = Env.lookup_type longident env in
(path, Env.find_type path env)
#else
let lookup_type = Env.lookup_type
#endif
let rule_path rule =
@ -575,11 +554,7 @@ let rule_path rule =
(* Returns whether the given path is persistent. *)
let rec is_persistent_path = function
| Path.Pident id -> Ident.persistent id
#if OCAML_VERSION >= (4, 08, 0)
| Path.Pdot (p, _) -> is_persistent_path p
#else
| Path.Pdot (p, _, _) -> is_persistent_path p
#endif
| Path.Papply (_, p) -> is_persistent_path p
(* Check that the given long identifier is present in the environment
@ -641,10 +616,8 @@ let type_structure env pstr =
let tstr, _, _, _, _ = Typemod.type_structure env pstr in
#elif OCAML_VERSION >= (4, 12, 0)
let tstr, _, _, _ = Typemod.type_structure env pstr in
#elif OCAML_VERSION >= (4, 08, 0)
let tstr, _, _, _ = Typemod.type_structure env pstr Location.none in
#else
let tstr, _, _ = Typemod.type_structure env pstr Location.none in
let tstr, _, _, _ = Typemod.type_structure env pstr Location.none in
#endif
tstr
@ -669,9 +642,7 @@ let add_let binding_name def =
{
pvb_pat = {
ppat_desc = Ppat_var { txt = binding_name; loc = pstr_loc; };
#if OCAML_VERSION >= (4, 08, 0)
ppat_loc_stack= [];
#endif
ppat_loc = pstr_loc;
ppat_attributes = [];
};
@ -694,8 +665,6 @@ let bind_expressions name phrase =
| Handling of [@@toplevel_printer] attributes |
+-----------------------------------------------------------------+ *)
#if OCAML_VERSION >= (4, 04, 0)
#if OCAML_VERSION >= (4, 09, 0)
module Persistent_signature = Persistent_env.Persistent_signature
#else
@ -715,27 +684,13 @@ let execute_phrase =
let rec collect_printers path signature acc =
List.fold_left (fun acc item ->
match (item : Types.signature_item) with
#if OCAML_VERSION >= (4, 08, 0)
| Sig_module (id, _, {md_type = Mty_signature s; _}, _, _) ->
#else
| Sig_module (id, {md_type = Mty_signature s; _}, _) ->
#endif
collect_printers (Longident.Ldot (path, Ident.name id)) s acc
#if OCAML_VERSION >= (4, 08, 0)
| Sig_value (id, vd, _) ->
#else
| Sig_value (id, vd) ->
#endif
#if OCAML_VERSION >= (4, 08, 0)
if List.exists (fun attr->
let open Parsetree in
match attr.attr_name with
| {Asttypes.txt = "toplevel_printer" | "ocaml.toplevel_printer"; _} ->
#else
if List.exists (function
| {Asttypes.txt = "toplevel_printer" | "ocaml.toplevel_printer"; _},
_ ->
#endif
true
| _ -> false)
vd.val_attributes
@ -763,12 +718,6 @@ let execute_phrase =
acknowledge_new_cmis ();
res
#else
let execute_phrase = Toploop.execute_phrase
#endif
(* +-----------------------------------------------------------------+
| Main loop |
+-----------------------------------------------------------------+ *)
@ -1278,48 +1227,28 @@ let typeof sid =
let out_sig_item =
try
let (path, ty_decl) = lookup_type id env in
#if OCAML_VERSION >= (4, 08, 0)
let id = Ident.create_local (Path.name path) in
#else
let id = Ident.create (Path.name path) in
#endif
Some (Printtyp.tree_of_type_declaration id ty_decl Types.Trec_not)
with Not_found ->
try
let (path, val_descr) = lookup_value id env in
#if OCAML_VERSION >= (4, 08, 0)
let id = Ident.create_local (Path.name path) in
#else
let id = Ident.create (Path.name path) in
#endif
Some (Printtyp.tree_of_value_description id val_descr)
with Not_found ->
try
let lbl_desc = lookup_label id env in
let (path, ty_decl) = from_type_desc (get_desc lbl_desc.Types.lbl_res) in
#if OCAML_VERSION >= (4, 08, 0)
let id = Ident.create_local (Path.name path) in
#else
let id = Ident.create (Path.name path) in
#endif
Some (Printtyp.tree_of_type_declaration id ty_decl Types.Trec_not)
with Not_found ->
try
let path, mod_typ = lookup_module id env in
#if OCAML_VERSION >= (4, 08, 0)
let id = Ident.create_local (Path.name path) in
#else
let id = Ident.create (Path.name path) in
#endif
Some (Printtyp.tree_of_module id mod_typ Types.Trec_not)
with Not_found ->
try
let (path, mty_decl) = lookup_modtype id env in
#if OCAML_VERSION >= (4, 08, 0)
let id = Ident.create_local (Path.name path) in
#else
let id = Ident.create (Path.name path) in
#endif
Some (Printtyp.tree_of_modtype_declaration id mty_decl)
with Not_found ->
try
@ -1331,11 +1260,7 @@ let typeof sid =
match cstr_desc.Types.cstr_tag with
| _ ->
let (path, ty_decl) = from_type_desc (get_desc cstr_desc.Types.cstr_res) in
#if OCAML_VERSION >= (4, 08, 0)
let id = Ident.create_local (Path.name path) in
#else
let id = Ident.create (Path.name path) in
#endif
Some (Printtyp.tree_of_type_declaration id ty_decl Types.Trec_not)
with Not_found ->
None
@ -1445,11 +1370,7 @@ let print_version_num () =
let autoload = ref true
let args = Arg.align [
#if OCAML_VERSION >= (4, 08, 0)
"-absname", Arg.Set Clflags.absname, " Show absolute filenames in error message";
#else
"-absname", Arg.Set Location.absname, " Show absolute filenames in error message";
#endif
"-I", Arg.String (fun dir -> Clflags.include_dirs := dir :: !Clflags.include_dirs), "<dir> Add <dir> to the list of include directories";
"-init", Arg.String (fun s -> Clflags.init_file := Some s), "<file> Load <file> instead of default init file";
"-labels", Arg.Clear Clflags.classic, " Use commuting label mode";
@ -1467,11 +1388,7 @@ let args = Arg.align [
"-rectypes", Arg.Set Clflags.recursive_types, " Allow arbitrary recursive types";
"-stdin", Arg.Unit (fun () -> run_script ""), " Read script from standard input";
"-strict-sequence", Arg.Set Clflags.strict_sequence, " Left-hand part of a sequence must have type unit";
#if OCAML_VERSION >= (4, 08, 0)
"-unsafe", Arg.Set Clflags.unsafe, " Do not compile bounds checking on array and string access";
#else
"-unsafe", Arg.Set Clflags.fast, " Do not compile bounds checking on array and string access";
#endif
"-version", Arg.Unit print_version, " Print version and exit";
"-vnum", Arg.Unit print_version_num, " Print version number and exit";
"-w", Arg.String (fun opt -> ignore (Warnings.parse_options false opt)),
@ -1665,18 +1582,10 @@ type value = V : string * _ -> value
exception Found of Env.t
#if OCAML_VERSION >= (4, 03, 0)
let get_required_label name args =
match List.find (fun (lab, _) -> lab = Asttypes.Labelled name) args with
| _, x -> x
| exception Not_found -> None
#else
let get_required_label name args =
match List.find (fun (lab, _, k) -> lab = "loc" && k = Typedtree.Required) args with
| _, x, _ -> x
| _ -> None
| exception Not_found -> None
#endif
let walk dir ~init ~f =
let rec loop dir acc =

2
utop.opam
View File

@ -6,7 +6,7 @@ homepage: "https://github.com/ocaml-community/utop"
bug-reports: "https://github.com/ocaml-community/utop/issues"
doc: "https://ocaml-community.github.io/utop/"
depends: [
"ocaml" {>= "4.03.0"}
"ocaml" {>= "4.08.0"}
"base-unix"
"base-threads"
"ocamlfind" {>= "1.7.2"}