handle camlp4ast -> ocamlast conversion errors
Ignore-this: 80e1397388e84be3a301279b26da1b30 darcs-hash:20120223132338-c41ad-ef4dc650c12d214c9b898da6acd408fb327d2449
This commit is contained in:
parent
b6c3d44ac2
commit
a3367ec947
|
@ -15,13 +15,36 @@ module Ast2pt = Camlp4.Struct.Camlp4Ast2OCamlAst.Make(Ast)
|
|||
|
||||
external cast_toplevel_phrase : Camlp4_import.Parsetree.toplevel_phrase -> Parsetree.toplevel_phrase = "%identity"
|
||||
|
||||
let convert_camlp4_toplevel_phrase ast =
|
||||
cast_toplevel_phrase (Ast2pt.phrase ast)
|
||||
|
||||
let print_camlp4_error pp exn =
|
||||
Format.fprintf pp "@[<0>%a@]" Camlp4.ErrorHandler.print exn;
|
||||
Format.pp_print_flush pp ()
|
||||
|
||||
let get_camlp4_error_message exn =
|
||||
let loc, exn =
|
||||
match exn with
|
||||
| Loc.Exc_located (loc, exn) ->
|
||||
((Loc.start_off loc, Loc.stop_off loc), exn)
|
||||
| exn ->
|
||||
((0, 0), exn)
|
||||
in
|
||||
let msg = UTop.get_message print_camlp4_error exn in
|
||||
(* Camlp4 sometimes generate several empty lines at the end... *)
|
||||
let idx = ref (String.length msg - 1) in
|
||||
while !idx > 0 && msg.[!idx] = '\n' do
|
||||
decr idx
|
||||
done;
|
||||
if !idx + 1 < String.length msg then
|
||||
(loc, String.sub msg 0 (!idx + 1))
|
||||
else
|
||||
(loc, msg)
|
||||
|
||||
let convert_camlp4_toplevel_phrase ast =
|
||||
try
|
||||
UTop.Value (cast_toplevel_phrase (Ast2pt.phrase ast))
|
||||
with exn ->
|
||||
let loc, msg = get_camlp4_error_message exn in
|
||||
UTop.Error ([loc], msg)
|
||||
|
||||
let parse_toplevel_phrase_camlp4 str eos_is_error =
|
||||
(* Execute delayed actions now. *)
|
||||
Register.iter_and_take_callbacks (fun (_, f) -> f ());
|
||||
|
@ -48,28 +71,13 @@ let parse_toplevel_phrase_camlp4 str eos_is_error =
|
|||
if !eof && not eos_is_error then
|
||||
raise UTop.Need_more
|
||||
else
|
||||
let locs, exn =
|
||||
match exn with
|
||||
| Loc.Exc_located (loc, exn) ->
|
||||
([(Loc.start_off loc, Loc.stop_off loc)], exn)
|
||||
| exn ->
|
||||
([], exn)
|
||||
in
|
||||
let msg = UTop.get_message print_camlp4_error exn in
|
||||
(* Camlp4 sometimes generate several empty lines at the end... *)
|
||||
let idx = ref (String.length msg - 1) in
|
||||
while !idx > 0 && msg.[!idx] = '\n' do
|
||||
decr idx
|
||||
done;
|
||||
if !idx + 1 < String.length msg then
|
||||
UTop.Error (locs, String.sub msg 0 (!idx + 1))
|
||||
else
|
||||
UTop.Error (locs, msg)
|
||||
let loc, msg = get_camlp4_error_message exn in
|
||||
UTop.Error ([loc], msg)
|
||||
|
||||
let parse_toplevel_phrase str eos_is_error =
|
||||
match parse_toplevel_phrase_camlp4 str eos_is_error with
|
||||
| UTop.Value ast ->
|
||||
UTop.Value (convert_camlp4_toplevel_phrase ast)
|
||||
convert_camlp4_toplevel_phrase ast
|
||||
| UTop.Error (locs, msg) ->
|
||||
UTop.Error (locs, msg)
|
||||
|
||||
|
|
|
@ -14,6 +14,11 @@ val parse_toplevel_phrase_camlp4 : string -> bool -> Camlp4.PreCast.Ast.str_item
|
|||
(** Camlp4 toplevel phrase parser. Same as {!parse_toplevel_phrase}
|
||||
but the result is not converted to an OCaml ast. *)
|
||||
|
||||
val convert_camlp4_toplevel_phrase : Camlp4.PreCast.Ast.str_item -> Parsetree.toplevel_phrase
|
||||
val convert_camlp4_toplevel_phrase : Camlp4.PreCast.Ast.str_item -> Parsetree.toplevel_phrase UTop.result
|
||||
(** Converts a camlp4 toplevel phrase into a standard OCaml toplevel
|
||||
phrase. *)
|
||||
phrase. Note that a camlp4 ast may not be convertible to an
|
||||
OCaml one, in which case it returns {!UTop.Error}. *)
|
||||
|
||||
val get_camlp4_error_message : exn -> UTop.location * string
|
||||
(** [get_camlp4_error_message exn] returns the location and error
|
||||
message for the exception [exn] as printed by camlp4. *)
|
||||
|
|
Loading…
Reference in New Issue