fix 4.01 compatibility
This commit is contained in:
parent
7b966e17e3
commit
35c740c312
|
@ -92,13 +92,20 @@ let () =
|
|||
rule "format lifter"
|
||||
~prod:"src/lib/uTop_cmt_lifter.ml"
|
||||
(fun _ _ ->
|
||||
Cmd (S [ P "ocamlfind"
|
||||
; A "ppx_tools/genlifter"
|
||||
; A "-I"
|
||||
; A "+compiler-libs"
|
||||
; A "Cmt_format.cmt_infos"
|
||||
; Sh ">"
|
||||
; A "src/lib/uTop_cmt_lifter.ml"
|
||||
]))
|
||||
let ocaml_version =
|
||||
Scanf.sscanf (BaseEnvLight.var_get "ocaml_version" env)
|
||||
"%u.%u" (fun a b -> (a, b))
|
||||
in
|
||||
if ocaml_version < (4, 02) then
|
||||
Echo ([], "src/lib/uTop_cmt_lifter.ml")
|
||||
else
|
||||
Cmd (S [ P "ocamlfind"
|
||||
; A "ppx_tools/genlifter"
|
||||
; A "-I"
|
||||
; A "+compiler-libs"
|
||||
; A "Cmt_format.cmt_infos"
|
||||
; Sh ">"
|
||||
; A "src/lib/uTop_cmt_lifter.ml"
|
||||
]))
|
||||
| _ ->
|
||||
())
|
||||
())
|
||||
|
|
|
@ -77,9 +77,10 @@ let auto_run_async, get_auto_run_async, set_auto_run_async = make_variable true
|
|||
let topfind_verbose, get_topfind_verbose, set_topfind_verbose = make_variable false
|
||||
let external_editor, get_external_editor, set_external_editor =
|
||||
make_variable
|
||||
(match Sys.getenv "EDITOR" with
|
||||
| exception Not_found -> "vi"
|
||||
| s -> s)
|
||||
(try
|
||||
Sys.getenv "EDITOR"
|
||||
with Not_found ->
|
||||
"vi")
|
||||
|
||||
(* Ugly hack until the action system of lambda-term is improved *)
|
||||
let end_and_accept_current_phrase : LTerm_read_line.action =
|
||||
|
|
|
@ -1368,6 +1368,13 @@ 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"
|
||||
|
||||
#else
|
||||
|
||||
exception Found of Env.t
|
||||
|
||||
let interact ~search_path ~unit ~loc:(fname, lnum, cnum, _) ~values =
|
||||
|
@ -1385,23 +1392,19 @@ let interact ~search_path ~unit ~loc:(fname, lnum, cnum, _) ~values =
|
|||
super#lift_Typedtree_expression e;
|
||||
match e.exp_desc with
|
||||
| Texp_apply (_, args) -> begin
|
||||
match
|
||||
List.find (fun (lab, _, _) -> lab = "loc" ) args,
|
||||
List.find (fun (lab, _, _) -> lab = "values") args
|
||||
with
|
||||
| (_, Some l, Required), (_, Some v, Required) ->
|
||||
let pos = l.exp_loc.loc_start in
|
||||
Printf.eprintf "%s:%d:%d %s:%d:%d\n%!"
|
||||
fname lnum cnum
|
||||
pos.pos_fname
|
||||
pos.pos_lnum
|
||||
(pos.pos_cnum - pos.pos_bol);
|
||||
if pos.pos_fname = fname &&
|
||||
pos.pos_lnum = lnum &&
|
||||
pos.pos_cnum - pos.pos_bol = cnum then
|
||||
raise (Found v.exp_env)
|
||||
| _ -> ()
|
||||
| exception Not_found -> ()
|
||||
try
|
||||
match
|
||||
List.find (fun (lab, _, _) -> lab = "loc" ) args,
|
||||
List.find (fun (lab, _, _) -> lab = "values") args
|
||||
with
|
||||
| (_, Some l, Required), (_, Some v, Required) ->
|
||||
let pos = l.exp_loc.loc_start in
|
||||
if pos.pos_fname = fname &&
|
||||
pos.pos_lnum = lnum &&
|
||||
pos.pos_cnum - pos.pos_bol = cnum then
|
||||
raise (Found v.exp_env)
|
||||
| _ -> ()
|
||||
with Not_found -> ()
|
||||
end
|
||||
| _ -> ()
|
||||
|
||||
|
@ -1425,17 +1428,18 @@ let interact ~search_path ~unit ~loc:(fname, lnum, cnum, _) ~values =
|
|||
method char _ = ()
|
||||
method array _ = ()
|
||||
end in
|
||||
match search#lift_Cmt_format_cmt_infos cmt_infos with
|
||||
| () -> failwith "Couldn't find location in cmt file"
|
||||
| exception (Found env) ->
|
||||
try
|
||||
List.iter Topdirs.dir_directory (search_path @ cmt_infos.cmt_loadpath);
|
||||
let env = Envaux.env_of_only_summary env in
|
||||
List.iter (fun (V (name, v)) -> Toploop.setvalue name (Obj.repr v)) values;
|
||||
main_internal ~initial_env:(Some env)
|
||||
with exn ->
|
||||
Location.report_exception Format.err_formatter exn;
|
||||
exit 2
|
||||
try
|
||||
search#lift_Cmt_format_cmt_infos cmt_infos;
|
||||
failwith "Couldn't find location in cmt file"
|
||||
with Found env ->
|
||||
try
|
||||
List.iter Topdirs.dir_directory (search_path @ cmt_infos.cmt_loadpath);
|
||||
let env = Envaux.env_of_only_summary env in
|
||||
List.iter (fun (V (name, v)) -> Toploop.setvalue name (Obj.repr v)) values;
|
||||
main_internal ~initial_env:(Some env)
|
||||
with exn ->
|
||||
Location.report_exception Format.err_formatter exn;
|
||||
exit 2
|
||||
|
||||
let () =
|
||||
Location.register_error_of_exn
|
||||
|
@ -1444,3 +1448,5 @@ let () =
|
|||
Some (Location.error_of_printer_file Envaux.report_error err)
|
||||
| _ -> None
|
||||
)
|
||||
|
||||
#endif
|
||||
|
|
Loading…
Reference in New Issue