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

Bump compatibility to 4.11+ (#444)

This commit is contained in:
Etienne Millon 2023-07-03 11:29:30 +02:00 committed by GitHub
parent 40c1b32a7c
commit 21439f537e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
7 changed files with 36 additions and 150 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CHANGES.md
View File

@ -4,6 +4,8 @@
* Remove deprecated values `prompt_continue`, `prompt_comment`, `smart_accept`, * Remove deprecated values `prompt_continue`, `prompt_comment`, `smart_accept`,
`new_prompt_hooks`, `at_new_prompt` (#..., @emillon) `new_prompt_hooks`, `at_new_prompt` (#..., @emillon)
* Require OCaml 4.11.0 or newer. (#444, @emillon)
2.12.1 (2023-04-21) 2.12.1 (2023-04-21)
------------------- -------------------

2
dune-project
View File

@ -15,7 +15,7 @@
(description (description
"utop is an improved toplevel (i.e., Read-Eval-Print Loop or REPL) for OCaml. It can run in a terminal or in Emacs. It supports line edition, history, real-time and context sensitive completion, colors, and more. It integrates with the Tuareg mode in Emacs.") "utop is an improved toplevel (i.e., Read-Eval-Print Loop or REPL) for OCaml. It can run in a terminal or in Emacs. It supports line edition, history, real-time and context sensitive completion, colors, and more. It integrates with the Tuareg mode in Emacs.")
(depends (depends
(ocaml (>= 4.08.0)) (ocaml (>= 4.11.0))
base-unix base-unix
base-threads base-threads
(ocamlfind (>= 1.7.2)) (ocamlfind (>= 1.7.2))

8
src/lib/uTop.ml
View File

@ -359,13 +359,7 @@ let check_phrase phrase =
(fun () -> (fun () ->
Str.eval Str.eval
(Exp.fun_ Nolabel None (Pat.construct unit None) (Exp.fun_ Nolabel None (Pat.construct unit None)
(Exp.letmodule (with_loc loc (Exp.letmodule (with_loc loc (Some "_"))
#if OCAML_VERSION >= (4, 10, 0)
(Some "_")
#else
"_"
#endif
)
(Mod.structure (item :: items)) (Mod.structure (item :: items))
(Exp.construct unit None)))) (Exp.construct unit None))))
in in

84
src/lib/uTop_compat.ml
View File

@ -1,10 +1,3 @@
let lookup_value =
#if OCAML_VERSION >= (4, 10, 0)
Env.find_value_by_name
#else
Env.lookup_value
#endif
let get_desc x = let get_desc x =
#if OCAML_VERSION >= (4, 14, 0) #if OCAML_VERSION >= (4, 14, 0)
Types.get_desc x Types.get_desc x
@ -19,51 +12,6 @@ let toploop_get_directive name =
try Some (Hashtbl.find Toploop.directive_table name) with Not_found -> None try Some (Hashtbl.find Toploop.directive_table name) with Not_found -> None
#endif #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 () = let toploop_all_directive_names () =
#if OCAML_VERSION >= (4, 13, 0) #if OCAML_VERSION >= (4, 13, 0)
Toploop.all_directive_names () Toploop.all_directive_names ()
@ -71,15 +19,6 @@ let toploop_all_directive_names () =
Hashtbl.fold (fun dir _ acc -> dir::acc) Toploop.directive_table [] Hashtbl.fold (fun dir _ acc -> dir::acc) Toploop.directive_table []
#endif #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 = let set_load_path path =
#if OCAML_VERSION >= (5, 0, 0) #if OCAML_VERSION >= (5, 0, 0)
Load_path.init path ~auto_include:Load_path.no_auto_include Load_path.init path ~auto_include:Load_path.no_auto_include
@ -94,13 +33,6 @@ let toploop_use_silently fmt name =
Toploop.use_silently fmt name Toploop.use_silently fmt name
#endif #endif
module Persistent_signature =
#if OCAML_VERSION >= (4, 09, 0)
Persistent_env.Persistent_signature
#else
Env.Persistent_signature
#endif
let toploop_set_paths () = let toploop_set_paths () =
#if OCAML_VERSION >= (5, 0, 0) #if OCAML_VERSION >= (5, 0, 0)
Toploop.set_paths ~auto_include:Load_path.no_auto_include () Toploop.set_paths ~auto_include:Load_path.no_auto_include ()
@ -115,22 +47,6 @@ let toploop_load_file ppf fn =
Topdirs.load_file ppf fn Topdirs.load_file ppf fn
#endif #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
(** Returns whether the given path is persistent. *) (** Returns whether the given path is persistent. *)
let rec is_persistent_path = function let rec is_persistent_path = function
| Path.Pident id -> Ident.persistent id | Path.Pident id -> Ident.persistent id

34
src/lib/uTop_complete.ml
View File

@ -494,9 +494,9 @@ let names_of_module longident =
try try
Longident_map.find longident !local_names_by_longident Longident_map.find longident !local_names_by_longident
with Not_found -> with Not_found ->
match lookup_env lookup_module longident !Toploop.toplevel_env with match lookup_env Env.find_module_by_name longident !Toploop.toplevel_env with
| Some(path, module_type) -> | Some(path, {md_type; _}) ->
let names = names_of_module_type module_type in let names = names_of_module_type md_type in
local_names_by_path := Path_map.add path names !local_names_by_path; local_names_by_path := Path_map.add path names !local_names_by_path;
local_names_by_longident := Longident_map.add longident names !local_names_by_longident; local_names_by_longident := Longident_map.add longident names !local_names_by_longident;
names names
@ -508,9 +508,9 @@ let fields_of_module longident =
try try
Longident_map.find longident !local_fields_by_longident Longident_map.find longident !local_fields_by_longident
with Not_found -> with Not_found ->
match lookup_env lookup_module longident !Toploop.toplevel_env with match lookup_env Env.find_module_by_name longident !Toploop.toplevel_env with
| Some(path, module_type) -> | Some(path, {md_type; _}) ->
let fields = fields_of_module_type module_type in let fields = fields_of_module_type md_type in
local_fields_by_path := Path_map.add path fields !local_fields_by_path; local_fields_by_path := Path_map.add path fields !local_fields_by_path;
local_fields_by_longident := Longident_map.add longident fields !local_fields_by_longident; local_fields_by_longident := Longident_map.add longident fields !local_fields_by_longident;
fields fields
@ -521,10 +521,8 @@ let fields_of_module longident =
let list_global_names () = let list_global_names () =
let rec loop acc = function let rec loop acc = function
| Env.Env_empty -> acc | Env.Env_empty -> acc
#if OCAML_VERSION >= (4, 10, 0)
| Env.Env_value_unbound _-> acc | Env.Env_value_unbound _-> acc
| Env.Env_module_unbound _-> acc | Env.Env_module_unbound _-> acc
#endif
| Env.Env_value(summary, id, _) -> | Env.Env_value(summary, id, _) ->
loop (add (Ident.name id) acc) summary loop (add (Ident.name id) acc) summary
| Env.Env_type(summary, id, decl) -> | Env.Env_type(summary, id, decl) ->
@ -545,13 +543,8 @@ let list_global_names () =
loop (add (Ident.name id) acc) summary loop (add (Ident.name id) acc) summary
| Env.Env_constraints (summary, _) -> | Env.Env_constraints (summary, _) ->
loop acc summary loop acc summary
#if OCAML_VERSION >= (4, 10, 0)
| Env.Env_copy_types summary -> | Env.Env_copy_types summary ->
loop acc summary loop acc summary
#else
| Env.Env_copy_types (summary, _) ->
loop acc summary
#endif
| Env.Env_open(summary, path) -> | Env.Env_open(summary, path) ->
match try Some (Path_map.find path !local_names_by_path) with Not_found -> None with match try Some (Path_map.find path !local_names_by_path) with Not_found -> None with
| Some names -> | Some names ->
@ -582,10 +575,8 @@ let replace x y set =
let list_global_fields () = let list_global_fields () =
let rec loop acc = function let rec loop acc = function
| Env.Env_empty -> acc | Env.Env_empty -> acc
#if OCAML_VERSION >= (4, 10, 0)
| Env.Env_value_unbound _-> acc | Env.Env_value_unbound _-> acc
| Env.Env_module_unbound _-> acc | Env.Env_module_unbound _-> acc
#endif
| Env.Env_value(summary, id, _) -> | Env.Env_value(summary, id, _) ->
loop (add (Ident.name id) acc) summary loop (add (Ident.name id) acc) summary
| Env.Env_type(summary, id, decl) -> | Env.Env_type(summary, id, decl) ->
@ -606,13 +597,8 @@ let list_global_fields () =
loop (add (Ident.name id) acc) summary loop (add (Ident.name id) acc) summary
| Env.Env_constraints (summary, _) -> | Env.Env_constraints (summary, _) ->
loop acc summary loop acc summary
#if OCAML_VERSION >= (4, 10, 0)
| Env.Env_copy_types summary -> | Env.Env_copy_types summary ->
loop acc summary loop acc summary
#else
| Env.Env_copy_types (summary, _) ->
loop acc summary
#endif
| Env.Env_open(summary, path) -> | Env.Env_open(summary, path) ->
match try Some (Path_map.find path !local_fields_by_path) with Not_found -> None with match try Some (Path_map.find path !local_fields_by_path) with Not_found -> None with
| Some fields -> | Some fields ->
@ -695,7 +681,7 @@ let rec find_object meths type_expr =
None None
let methods_of_object longident meths = let methods_of_object longident meths =
match lookup_env lookup_value longident !Toploop.toplevel_env with match lookup_env Env.find_value_by_name longident !Toploop.toplevel_env with
| None -> | None ->
[] []
| Some (path, { val_type = type_expr }) -> | Some (path, { val_type = type_expr }) ->
@ -735,7 +721,7 @@ let rec labels_of_type acc type_expr =
String_map.bindings acc String_map.bindings acc
let labels_of_function longident meths = let labels_of_function longident meths =
match lookup_env lookup_value longident !Toploop.toplevel_env with match lookup_env Env.find_value_by_name longident !Toploop.toplevel_env with
| None -> | None ->
[] []
| Some (path, { val_type = type_expr }) -> | Some (path, { val_type = type_expr }) ->
@ -746,7 +732,7 @@ let labels_of_function longident meths =
labels_of_type String_map.empty type_expr labels_of_type String_map.empty type_expr
let labels_of_newclass longident = let labels_of_newclass longident =
match lookup_env lookup_class longident !Toploop.toplevel_env with match lookup_env Env.find_class_by_name longident !Toploop.toplevel_env with
| None -> | None ->
[] []
| Some (path, { cty_new = None }) -> | Some (path, { cty_new = None }) ->
@ -830,7 +816,7 @@ let complete ~phrase_terminator ~input =
| [(Symbol "#", _); (Lident "typeof", _); (String (tlen, false), loc)] -> | [(Symbol "#", _); (Lident "typeof", _); (String (tlen, false), loc)] ->
let prefix = String.sub input (loc.ofs1 + tlen) (String.length input - loc.ofs1 - tlen) in let prefix = String.sub input (loc.ofs1 + tlen) (String.length input - loc.ofs1 - tlen) in
begin match longident_parse prefix with begin match Parse.longident (Lexing.from_string prefix) with
| Longident.Ldot (lident, last_prefix) -> | Longident.Ldot (lident, last_prefix) ->
let set = names_of_module lident in let set = names_of_module lident in
let compls = lookup last_prefix (String_set.elements set) in let compls = lookup last_prefix (String_set.elements set) in

54
src/lib/uTop_main.ml
View File

@ -333,19 +333,15 @@ end = struct
| Mty_signature s -> walk_sig pp ~path s | Mty_signature s -> walk_sig pp ~path s
| _ -> () | _ -> ()
let find_module id env =
let name = Longident.Lident (Ident.name id) in
lookup_module name env
let scan_cmis = let scan_cmis =
let new_cmis = ref [] in let new_cmis = ref [] in
let default_load = !Persistent_signature.load in let default_load = !Persistent_env.Persistent_signature.load in
let load ~unit_name = let load ~unit_name =
let res = default_load ~unit_name in let res = default_load ~unit_name in
(match res with None -> () | Some x -> new_cmis := x.cmi :: !new_cmis); (match res with None -> () | Some x -> new_cmis := x.cmi :: !new_cmis);
res res
in in
Persistent_signature.load := load; Persistent_env.Persistent_signature.load := load;
fun pp -> fun pp ->
List.iter (fun (cmi : Cmi_format.cmi_infos) -> List.iter (fun (cmi : Cmi_format.cmi_infos) ->
@ -359,9 +355,10 @@ end = struct
fun pp -> fun pp ->
let env = !Toploop.toplevel_env in let env = !Toploop.toplevel_env in
let scan_module env id = let scan_module env id =
let path, md = find_module id env in let name = Longident.Lident (Ident.name id) in
let path, {md_type; _} = Env.find_module_by_name name env in
if path = Path.Pident id then if path = Path.Pident id then
walk_mty pp (Longident.Lident (Ident.name id)) md walk_mty pp name md_type
in in
let rec scan_globals last = function let rec scan_globals last = function
| [] -> () | [] -> ()
@ -376,15 +373,9 @@ end = struct
| Env.Env_module (s, id, _, _) -> | Env.Env_module (s, id, _, _) ->
scan_summary last s; scan_summary last s;
scan_module env id scan_module env id
#if OCAML_VERSION >= (4, 10, 0)
| Env.Env_copy_types s | Env.Env_copy_types s
#else
| Env.Env_copy_types (s, _)
#endif
#if OCAML_VERSION >= (4, 10, 0)
| Env.Env_value_unbound (s, _, _) | Env.Env_value_unbound (s, _, _)
| Env.Env_module_unbound (s, _, _) | Env.Env_module_unbound (s, _, _)
#endif
| Env.Env_persistent (s, _) | Env.Env_persistent (s, _)
| Env.Env_value (s, _, _) | Env.Env_value (s, _, _)
| Env.Env_type (s, _, _) | Env.Env_type (s, _, _)
@ -590,7 +581,7 @@ let rule_path rule =
try try
let env = !Toploop.toplevel_env in let env = !Toploop.toplevel_env in
let path = let path =
match lookup_type rule.type_to_rewrite env with match Env.find_type_by_name rule.type_to_rewrite env with
| path, { Types.type_kind = Types.Type_abstract | path, { Types.type_kind = Types.Type_abstract
; Types.type_private = Asttypes.Public ; Types.type_private = Asttypes.Public
; Types.type_manifest = Some ty ; Types.type_manifest = Some ty
@ -611,7 +602,7 @@ let rule_path rule =
and is persistent. *) and is persistent. *)
let is_persistent_in_env longident = let is_persistent_in_env longident =
try try
is_persistent_path (fst (lookup_value longident !Toploop.toplevel_env)) is_persistent_path (fst (Env.find_value_by_name longident !Toploop.toplevel_env))
with Not_found -> with Not_found ->
false false
@ -1182,7 +1173,7 @@ end
+-----------------------------------------------------------------+ *) +-----------------------------------------------------------------+ *)
let typeof sid = let typeof sid =
let id = longident_parse sid in let id = Parse.longident (Lexing.from_string sid) in
let env = !Toploop.toplevel_env in let env = !Toploop.toplevel_env in
let from_type_desc = function let from_type_desc = function
| Types.Tconstr (path, _, _) -> | Types.Tconstr (path, _, _) ->
@ -1192,33 +1183,33 @@ let typeof sid =
in in
let out_sig_item = let out_sig_item =
try try
let (path, ty_decl) = lookup_type id env in let (path, ty_decl) = Env.find_type_by_name id env in
let id = Ident.create_local (Path.name path) in let id = Ident.create_local (Path.name path) in
Some (Printtyp.tree_of_type_declaration id ty_decl Types.Trec_not) Some (Printtyp.tree_of_type_declaration id ty_decl Types.Trec_not)
with Not_found -> with Not_found ->
try try
let (path, val_descr) = lookup_value id env in let (path, val_descr) = Env.find_value_by_name id env in
let id = Ident.create_local (Path.name path) in let id = Ident.create_local (Path.name path) in
Some (Printtyp.tree_of_value_description id val_descr) Some (Printtyp.tree_of_value_description id val_descr)
with Not_found -> with Not_found ->
try try
let lbl_desc = lookup_label id env in let lbl_desc = Env.find_label_by_name id env in
let (path, ty_decl) = from_type_desc (get_desc lbl_desc.Types.lbl_res) in let (path, ty_decl) = from_type_desc (get_desc lbl_desc.Types.lbl_res) in
let id = Ident.create_local (Path.name path) in let id = Ident.create_local (Path.name path) in
Some (Printtyp.tree_of_type_declaration id ty_decl Types.Trec_not) Some (Printtyp.tree_of_type_declaration id ty_decl Types.Trec_not)
with Not_found -> with Not_found ->
try try
let path, mod_typ = lookup_module id env in let path, {Types.md_type; _} = Env.find_module_by_name id env in
let id = Ident.create_local (Path.name path) in let id = Ident.create_local (Path.name path) in
Some (Printtyp.tree_of_module id mod_typ Types.Trec_not) Some (Printtyp.tree_of_module id md_type Types.Trec_not)
with Not_found -> with Not_found ->
try try
let (path, mty_decl) = lookup_modtype id env in let (path, mty_decl) = Env.find_modtype_by_name id env in
let id = Ident.create_local (Path.name path) in let id = Ident.create_local (Path.name path) in
Some (Printtyp.tree_of_modtype_declaration id mty_decl) Some (Printtyp.tree_of_modtype_declaration id mty_decl)
with Not_found -> with Not_found ->
try try
let cstr_desc = lookup_constructor id env in let cstr_desc = Env.find_constructor_by_name id env in
match cstr_desc.Types.cstr_tag with match cstr_desc.Types.cstr_tag with
| _ -> | _ ->
let (path, ty_decl) = from_type_desc (get_desc cstr_desc.Types.cstr_res) in let (path, ty_decl) = from_type_desc (get_desc cstr_desc.Types.cstr_res) in
@ -1276,7 +1267,6 @@ let prepare () =
Format.eprintf "Uncaught exception: %s\n" (Printexc.to_string exn); Format.eprintf "Uncaught exception: %s\n" (Printexc.to_string exn);
false false
#if OCAML_VERSION >= (4, 09, 0)
external caml_sys_modify_argv : string array -> unit = external caml_sys_modify_argv : string array -> unit =
"caml_sys_modify_argv" "caml_sys_modify_argv"
let override_argv () = let override_argv () =
@ -1284,14 +1274,6 @@ let override_argv () =
let copy = Array.init len (fun i -> Sys.argv.(i+ !Arg.current)) in let copy = Array.init len (fun i -> Sys.argv.(i+ !Arg.current)) in
caml_sys_modify_argv copy; caml_sys_modify_argv copy;
Arg.current := 0 Arg.current := 0
#else
let override_argv () =
let len = Array.length Sys.argv - !Arg.current in
Array.blit Sys.argv !Arg.current Sys.argv 0 len;
Obj.truncate (Obj.repr Sys.argv) len;
Arg.current := 0
#endif
let run_script name = let run_script name =
(* To prevent message from camlp4 *) (* To prevent message from camlp4 *)
@ -1552,6 +1534,12 @@ let walk dir ~init ~f =
| exception Unix.Unix_error(ENOENT, _, _) -> init | exception Unix.Unix_error(ENOENT, _, _) -> init
| _ -> loop dir init | _ -> loop dir init
let iter_structure expr =
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
let interact ?(search_path=[]) ?(build_dir="_build") ~unit ~loc:(fname, lnum, cnum, _) let interact ?(search_path=[]) ?(build_dir="_build") ~unit ~loc:(fname, lnum, cnum, _)
~values = ~values =
let search_path = walk build_dir ~init:search_path ~f:(fun dir acc -> dir :: acc) in let search_path = walk build_dir ~init:search_path ~f:(fun dir acc -> dir :: acc) in

2
utop.opam
View File

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