fix 4.01 compatibility

This commit is contained in:
Jeremie Dimino 2016-04-08 09:31:37 +01:00
parent 7b966e17e3
commit 35c740c312
3 changed files with 54 additions and 40 deletions

View File

@ -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"
]))
| _ ->
())
())

View File

@ -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 =

View File

@ -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