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

Run ppx preprocessors before typing and report their errors gracefully.

This commit is contained in:
Peter Zotov 2014-05-06 21:37:32 +04:00
parent 5305027a36
commit 8c09e086f5
1 changed files with 15 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/lib/uTop_main.ml
View File

@ -87,10 +87,24 @@ let parse_input_multi input =
let parse_and_check input eos_is_error = let parse_and_check input eos_is_error =
let buf = Buffer.create 32 in let buf = Buffer.create 32 in
let preprocess input =
match input with
#if ocaml_version >= (4, 02, 0)
| UTop.Value (Parsetree.Ptop_def pstr) ->
begin try
let pstr = Pparse.apply_rewriters Config.ast_impl_magic_number pstr in
UTop.Value (Parsetree.Ptop_def pstr)
with Pparse.Error error ->
Pparse.report_error Format.str_formatter error;
UTop.Error ([], Format.flush_str_formatter ())
end
#endif
| _ -> input
in
let result = let result =
UTop.collect_formatters buf [Format.err_formatter] UTop.collect_formatters buf [Format.err_formatter]
(fun () -> (fun () ->
match !UTop.parse_toplevel_phrase input eos_is_error with match preprocess (!UTop.parse_toplevel_phrase input eos_is_error) with
| UTop.Error (locs, msg) -> | UTop.Error (locs, msg) ->
UTop.Error (convert_locs input locs, "Error: " ^ msg ^ "\n") UTop.Error (convert_locs input locs, "Error: " ^ msg ^ "\n")
| UTop.Value phrase -> | UTop.Value phrase ->
@ -520,9 +534,6 @@ let rewrite_str_item pstr_item tstr_item =
let rewrite phrase = let rewrite phrase =
match phrase with match phrase with
| Parsetree.Ptop_def pstr -> | Parsetree.Ptop_def pstr ->
#if ocaml_version >= (4, 02, 0)
let pstr = Pparse.apply_rewriters Config.ast_impl_magic_number pstr in
#endif
if (UTop.get_auto_run_lwt () || UTop.get_auto_run_async ()) && List.exists is_eval pstr then if (UTop.get_auto_run_lwt () || UTop.get_auto_run_async ()) && List.exists is_eval pstr then
let tstr, _, _ = Typemod.type_structure !Toploop.toplevel_env pstr Location.none in let tstr, _, _ = Typemod.type_structure !Toploop.toplevel_env pstr Location.none in
let tstr = str_items_of_typed_structure tstr in let tstr = str_items_of_typed_structure tstr in