From 300dd7e56246b249b0821e7bd1ce43f4fe2167a6 Mon Sep 17 00:00:00 2001 From: Kate Date: Tue, 9 Mar 2021 10:52:53 +0000 Subject: [PATCH 1/2] Add support for OCaml 4.13 --- src/lib/uTop_main.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lib/uTop_main.ml b/src/lib/uTop_main.ml index 21dbd34..81c10c2 100644 --- a/src/lib/uTop_main.ml +++ b/src/lib/uTop_main.ml @@ -1442,7 +1442,7 @@ let args = Arg.align [ #endif "-version", Arg.Unit print_version, " Print version and exit"; "-vnum", Arg.Unit print_version_num, " Print version number and exit"; - "-w", Arg.String (Warnings.parse_options false), + "-w", Arg.String (fun opt -> ignore (Warnings.parse_options false opt)), Printf.sprintf " Enable or disable warnings according to :\n\ \ + enable warnings in \n\ @@ -1453,7 +1453,7 @@ let args = Arg.align [ \ .. a range of consecutive warning numbers\n\ \ a predefined set\n\ \ default setting is %S" Warnings.defaults_w; - "-warn-error", Arg.String (Warnings.parse_options true), + "-warn-error", Arg.String (fun opt -> ignore (Warnings.parse_options true opt)), Printf.sprintf " Enable or disable error status for warnings according to \n\ \ See option -w for the syntax of .\n\ From 9fe8b5d838f3594c76468599393c323d36d52d86 Mon Sep 17 00:00:00 2001 From: Kate Date: Tue, 25 May 2021 20:54:51 +0100 Subject: [PATCH 2/2] Get rid of deprecated functions in OCaml 4.13 --- src/lib/uTop.ml | 80 +++++++++++++++++++++++++--------------- src/lib/uTop_complete.ml | 35 +++++++++++++----- src/lib/uTop_main.ml | 15 +++++++- 3 files changed, 89 insertions(+), 41 deletions(-) diff --git a/src/lib/uTop.ml b/src/lib/uTop.ml index 604e964..c827d52 100644 --- a/src/lib/uTop.ml +++ b/src/lib/uTop.ml @@ -17,6 +17,13 @@ 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%%" @@ -491,38 +498,49 @@ let prompt = ref default_prompt let edit_mode= ref LTerm_editor.Default +let default_info = { + Toploop.section = "UTop"; + doc = ""; (* TODO: have some kind of documentation *) +} + let () = - Hashtbl.add Toploop.directive_table "utop_prompt_simple" + Toploop.add_directive "utop_prompt_simple" (Toploop.Directive_none (fun () -> - prompt := S.map (Printf.ksprintf LTerm_text.of_utf8 "utop [%d]: ") count)); + prompt := S.map (Printf.ksprintf LTerm_text.of_utf8 "utop [%d]: ") count)) + default_info; - Hashtbl.add Toploop.directive_table "utop_prompt_dummy" + Toploop.add_directive "utop_prompt_dummy" (Toploop.Directive_none (fun () -> - prompt := S.const (LTerm_text.of_utf8 "# "))); + prompt := S.const (LTerm_text.of_utf8 "# "))) + default_info; - Hashtbl.add Toploop.directive_table "utop_prompt_fancy_light" + Toploop.add_directive "utop_prompt_fancy_light" (Toploop.Directive_none (fun () -> set_profile Light; - prompt := default_prompt)); + prompt := default_prompt)) + default_info; - Hashtbl.add Toploop.directive_table "utop_prompt_fancy_dark" + Toploop.add_directive "utop_prompt_fancy_dark" (Toploop.Directive_none (fun () -> set_profile Dark; - prompt := default_prompt)); + prompt := default_prompt)) + default_info; - Hashtbl.add Toploop.directive_table "edit_mode_default" + Toploop.add_directive "edit_mode_default" (Toploop.Directive_none (fun () -> - edit_mode:= LTerm_editor.Default)); + edit_mode:= LTerm_editor.Default)) + default_info; - Hashtbl.add Toploop.directive_table "edit_mode_vi" + Toploop.add_directive "edit_mode_vi" (Toploop.Directive_none (fun () -> edit_mode:= LTerm_editor.Vi)) + default_info (* +-----------------------------------------------------------------+ | Help | @@ -544,7 +562,7 @@ let doc_of_action action = LTerm_read_line.doc_of_action action let () = - Hashtbl.add Toploop.directive_table "utop_help" + Toploop.add_directive "utop_help" (Toploop.Directive_none (fun () -> print_endline "If you can't see the prompt properly try: #utop_prompt_simple @@ -559,9 +577,10 @@ utop defines the following directives: #topfind_log : display messages recorded from findlib since the beginning of the session #topfind_verbose : enable/disable topfind verbosity -For a complete description of utop, look at the utop(1) manual page.")); +For a complete description of utop, look at the utop(1) manual page.")) + default_info; - Hashtbl.add Toploop.directive_table "utop_bindings" + Toploop.add_directive "utop_bindings" (Toploop.Directive_none (fun () -> let make_lines keys actions acc = @@ -630,9 +649,10 @@ For a complete description of utop, look at the utop(1) manual page.")); output_string stdout (Buffer.contents buf) in List.iter format_line table; - flush stdout)); + flush stdout)) + default_info; - Hashtbl.add Toploop.directive_table "utop_macro" + Toploop.add_directive "utop_macro" (Toploop.Directive_none (fun () -> let macro = Zed_macro.contents LTerm_read_line.macro in @@ -642,11 +662,13 @@ For a complete description of utop, look at the utop(1) manual page.")); output_char stdout '\n') macro; flush stdout)) + default_info let () = - Hashtbl.add Toploop.directive_table "pwd" + Toploop.add_directive "pwd" (Toploop.Directive_none (fun () -> print_endline (Sys.getcwd ()))) + default_info let make_stash_directive entry_formatter fname = if get_ui () = Emacs then @@ -682,7 +704,7 @@ let () = Printf.sprintf "(* %s *)" out end in - Hashtbl.add Toploop.directive_table "utop_stash" (Toploop.Directive_string fn) + Toploop.add_directive "utop_stash" (Toploop.Directive_string fn) default_info let () = let fn = make_stash_directive begin function @@ -692,7 +714,7 @@ let () = out end in - Hashtbl.add Toploop.directive_table "utop_save" (Toploop.Directive_string fn) + Toploop.add_directive "utop_save" (Toploop.Directive_string fn) default_info (* +-----------------------------------------------------------------+ | Findlib stuff | @@ -724,19 +746,19 @@ let () = if S.value topfind_verbose then real_log str let () = - Hashtbl.add - Toploop.directive_table + Toploop.add_directive "topfind_log" (Toploop.Directive_none (fun () -> List.iter (fun str -> print_string str; print_char '\n') (S.value topfind_log); - flush stdout)); + flush stdout)) + default_info; - Hashtbl.add - Toploop.directive_table + Toploop.add_directive "topfind_verbose" (Toploop.Directive_bool set_topfind_verbose) + default_info let split_words str = let len = String.length str in @@ -771,11 +793,11 @@ let require packages = handle_findlib_error exn let () = - Hashtbl.add - Toploop.directive_table + Toploop.add_directive "require" (Toploop.Directive_string (fun str -> require (split_words str))) + default_info (* +-----------------------------------------------------------------+ | Backports | @@ -806,11 +828,11 @@ let use_output command = let () = let name = "use_output" in - if not (Hashtbl.mem Toploop.directive_table name) then - Hashtbl.add - Toploop.directive_table + if toploop_get_directive name = None then + Toploop.add_directive name (Toploop.Directive_string use_output) + default_info (* +-----------------------------------------------------------------+ | Initialization | diff --git a/src/lib/uTop_complete.ml b/src/lib/uTop_complete.ml index 2224386..d8b2b32 100644 --- a/src/lib/uTop_complete.ml +++ b/src/lib/uTop_complete.ml @@ -22,6 +22,20 @@ let set_of_list = List.fold_left (fun set x -> String_set.add x set) String_set. | Utils | +-----------------------------------------------------------------+ *) +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 | [] -> @@ -254,17 +268,18 @@ let parse_label tokens = let list_directives phrase_terminator = String_map.bindings - (Hashtbl.fold - (fun dir kind map -> + (List.fold_left + (fun map dir -> let suffix = - match kind with - | Toploop.Directive_none _ -> phrase_terminator - | Toploop.Directive_string _ -> " \"" - | Toploop.Directive_bool _ | Toploop.Directive_int _ | Toploop.Directive_ident _ -> " " + match toploop_get_directive dir with + | Some (Toploop.Directive_none _) -> phrase_terminator + | Some (Toploop.Directive_string _) -> " \"" + | Some (Toploop.Directive_bool _ | Toploop.Directive_int _ | Toploop.Directive_ident _) -> " " + | None -> assert false in String_map.add dir suffix map) - Toploop.directive_table - String_map.empty) + String_map.empty + (toploop_all_directive_names ())) (* +-----------------------------------------------------------------+ | File listing | @@ -1045,7 +1060,7 @@ let complete ~phrase_terminator ~input = (* Generic completion on directives. *) | [(Symbol "#", _); ((Lident dir | Uident dir), _); (Blanks, { idx2 = stop })] -> (stop, - match try Some (Hashtbl.find Toploop.directive_table dir) with Not_found -> None with + match toploop_get_directive dir with | Some (Toploop.Directive_none _) -> [(phrase_terminator, "")] | Some (Toploop.Directive_string _) -> [(" \"", "")] | Some (Toploop.Directive_bool _) -> [(true_name, phrase_terminator); (false_name, phrase_terminator)] @@ -1053,7 +1068,7 @@ let complete ~phrase_terminator ~input = | Some (Toploop.Directive_ident _) -> List.map (fun w -> (w, "")) (String_set.elements (global_names ())) | None -> []) | (Symbol "#", _) :: ((Lident dir | Uident dir), _) :: tokens -> begin - match try Some (Hashtbl.find Toploop.directive_table dir) with Not_found -> None with + match toploop_get_directive dir with | Some (Toploop.Directive_none _) -> (0, []) | Some (Toploop.Directive_string _) -> diff --git a/src/lib/uTop_main.ml b/src/lib/uTop_main.ml index 81c10c2..d687e99 100644 --- a/src/lib/uTop_main.ml +++ b/src/lib/uTop_main.ml @@ -1337,9 +1337,15 @@ let typeof sid = let str = Buffer.contents buf in Lwt_main.run (Lazy.force LTerm.stdout >>= fun term -> render_out_phrase term str) +let default_info = { + Toploop.section = "UTop"; + doc = ""; (* TODO: have some kind of documentation *) +} + let () = - Hashtbl.add Toploop.directive_table "typeof" + Toploop.add_directive "typeof" (Toploop.Directive_string typeof) + default_info (* +-----------------------------------------------------------------+ | Entry point | @@ -1355,7 +1361,12 @@ let prepare () = List.for_all (function | `Packages l -> UTop.require l; true - | `Object fn -> Topdirs.load_file Format.err_formatter fn) + | `Object 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 ();