I removed exceptions for error reporting through the

interfaces ([Stdlib.result] instead).

I added --verbose=preproc to print the preprocessed text until
the error.

Fixed a bug: some whitespace in skip mode was printed out.
This commit is contained in:
Christian Rinderknecht 2020-03-26 16:51:08 +01:00
parent b24f1f6b1d
commit ca48e152a0
7 changed files with 85 additions and 47 deletions

View File

@ -10,6 +10,8 @@ val string_of_token : E_Parser.token -> string
type error = Invalid_character of char
val error_to_string : error -> string
val format :
?offsets:bool -> error Region.reg -> file:bool -> string Region.reg

View File

@ -31,7 +31,7 @@ type error = Invalid_character of char
let error_to_string = function
Invalid_character c ->
sprintf "Invalid character '%c' (%d).\n" c (Char.code c)
sprintf "Invalid character '%c' (%d)." c (Char.code c)
let format ?(offsets=true) Region.{region; value} ~file =
let msg = error_to_string value

View File

@ -4,19 +4,23 @@
type language = PascaLIGO | CameLIGO | ReasonLIGO
module SSet = Set.Make (String)
type options = <
input : string;
libs : string list;
lang : language;
offsets : bool
offsets : bool;
verbose : SSet.t
>
let make ~input ~libs ~lang ~offsets =
let make ~input ~libs ~lang ~offsets ~verbose =
object
method input = input
method libs = libs
method lang = lang
method offsets = offsets
method verbose = verbose
end
(* Auxiliary functions and modules *)
@ -43,6 +47,7 @@ let help () =
print "and each <option> (if any) is one of the following:";
print " -I <paths> Inclusion paths (colon-separated)";
print " --columns Columns for source locations";
print " --verbose=<stages> preproc";
print " -h, --help This help";
exit 0
@ -52,16 +57,23 @@ let input = ref None
and libs = ref []
and lang = ref None
and columns = ref false
and verbose = ref SSet.empty
and verb_str = ref ""
let split_at_colon = Str.(split (regexp ":"))
let add_path p = libs := !libs @ split_at_colon p
let add_verbose d =
verbose := List.fold_left (fun x y -> SSet.add y x)
!verbose
(split_at_colon d)
let specs =
let open!Getopt in [
'I', nolong, None, Some add_path;
'h', "help", Some help, None;
noshort, "columns", set columns true, None
noshort, "columns", set columns true, None;
noshort, "verbose", None, Some add_verbose
]
(* Handler of anonymous arguments *)
@ -84,6 +96,8 @@ let check () =
and offsets = not !columns
and verbose = !verbose
and lang =
match !lang with
Some lang -> lang
@ -94,12 +108,16 @@ let check () =
Some file -> file
| None -> abort "Missing input file."
in make ~input ~libs ~lang ~offsets
in make ~input ~libs ~lang ~offsets ~verbose
(* Parsing the command-line options *)
let read () =
try
Getopt.parse_cmdline specs anonymous;
(verb_str :=
let apply e a =
if a = "" then e else sprintf "%s, %s" e a
in SSet.fold apply !verbose "");
check ()
with Getopt.Error msg -> abort msg

View File

@ -4,11 +4,14 @@
type language = PascaLIGO | CameLIGO | ReasonLIGO
module SSet : Set.S with type elt = string
type options = <
input : string;
libs : string list;
lang : language;
offsets : bool
offsets : bool;
verbose : SSet.t
>
val make :
@ -16,6 +19,7 @@ val make :
libs:string list ->
lang:language ->
offsets:bool ->
verbose:SSet.t ->
options
(* Parsing the command-line options on stdin. The first parameter is

View File

@ -34,15 +34,17 @@ type error =
| No_line_comment_or_blank
| Invalid_symbol
| File_not_found of string
| Invalid_character of char
val format :
?offsets:bool -> error Region.reg -> file:bool -> string Region.reg
(* Preprocessing a lexing buffer (might raise [Error]). *)
(* Preprocessing a lexing buffer *)
exception Error of Buffer.t * error Region.reg
val lex : EvalOpt.options -> Lexing.lexbuf -> Buffer.t
val lex :
EvalOpt.options ->
Lexing.lexbuf ->
(Buffer.t, Buffer.t * error Region.reg) Stdlib.result
(* Evaluation of boolean expressions *)

View File

@ -105,6 +105,7 @@ type error =
| No_line_comment_or_blank
| Invalid_symbol
| File_not_found of string
| Invalid_character of char
let error_to_string = function
Invalid_directive name ->
@ -167,6 +168,8 @@ let error_to_string = function
"Expected a symbol (identifier)."
| File_not_found name ->
sprintf "File \"%s\" to include not found." name
| Invalid_character c ->
E_Lexer.error_to_string (E_Lexer.Invalid_character c)
let format ?(offsets=true) Region.{region; value} ~file =
let msg = error_to_string value
@ -174,14 +177,20 @@ let format ?(offsets=true) Region.{region; value} ~file =
let value = sprintf "Preprocessing error %s:\n%s" reg msg
in Region.{value; region}
exception Error of Buffer.t * error Region.reg
exception Error of (Buffer.t * error Region.reg)
let mk_reg buffer =
let start = Lexing.lexeme_start_p buffer |> Pos.from_byte
and stop = Lexing.lexeme_end_p buffer |> Pos.from_byte
in Region.make ~start ~stop
let stop value state region = raise (Error (state.out, Region.{region; value}))
(* IMPORTANT : Make sure the function [stop] remains the only one
raising [Error]. *)
let stop value state region =
List.iter close_in state.incl;
raise (Error (state.out, Region.{region; value}))
let fail error state buffer = stop error state (mk_reg buffer)
(* The function [reduce_cond] is called when a #endif directive is
@ -277,10 +286,12 @@ let expand_offset state =
let expr state buffer : mode =
let ast =
try E_Parser.expr E_Lexer.scan buffer with
E_Parser.Error ->
let region = mk_reg buffer in
let value = Parse_error
in raise (Error (state.out, Region.{value; region})) in
E_Lexer.Error Region.{value; region} ->
(match value with
E_Lexer.Invalid_character c ->
stop (Invalid_character c) state region)
| E_Parser.Error ->
fail Parse_error state buffer in
let () = print state "\n" in
if eval state.env ast then Copy else Skip
@ -431,8 +442,11 @@ rule scan state = parse
nl { proc_nl state lexbuf;
scan {state with offset = Prefix 0} lexbuf }
| blank { match state.offset with
Prefix n -> scan {state with offset = Prefix (n+1)} lexbuf
| Inline -> copy state lexbuf; scan state lexbuf }
Prefix n ->
scan {state with offset = Prefix (n+1)} lexbuf
| Inline ->
if state.mode = Copy then copy state lexbuf;
scan state lexbuf }
| directive {
if not (List.mem id directives)
then fail (Invalid_directive id) state lexbuf;
@ -452,7 +466,7 @@ rule scan state = parse
Some channel -> channel
| None -> stop (File_not_found incl_file) state reg in
let state = {state with incl = incl_chan::state.incl} in
cat state (Lexing.from_channel incl_chan);
cat state (Lexing.from_channel incl_chan); (* TODO *)
print state (sprintf "# %i \"%s\" 2" (line+1) base);
scan state lexbuf
| "if" ->
@ -496,19 +510,6 @@ rule scan state = parse
in scan state lexbuf
| "error" ->
stop (Error_directive (message [] lexbuf)) state region
(*
| "warning" ->
let start_p, end_p = region in
let msg = message [] lexbuf in
let open Lexing
in prerr_endline
("Warning at line " ^ string_of_int start_p.pos_lnum
^ ", char "
^ string_of_int (start_p.pos_cnum - start_p.pos_bol)
^ "--" ^ string_of_int (end_p.pos_cnum - end_p.pos_bol)
^ ":\n" ^ msg);
scan env mode (Prefix 0) trace lexbuf
*)
| "region" ->
let msg = message [] lexbuf
in expand_offset state;
@ -526,6 +527,19 @@ rule scan state = parse
print state ("#" ^ space ^ "line");
line_ind state lexbuf;
scan {state with offset = Prefix 0} lexbuf
(*
| "warning" ->
let start_p, end_p = region in
let msg = message [] lexbuf in
let open Lexing
in prerr_endline
("Warning at line " ^ string_of_int start_p.pos_lnum
^ ", char "
^ string_of_int (start_p.pos_cnum - start_p.pos_bol)
^ "--" ^ string_of_int (end_p.pos_cnum - end_p.pos_bol)
^ ":\n" ^ msg);
scan env mode (Prefix 0) trace lexbuf
*)
| _ -> assert false
}
| eof { match state.trace with
@ -683,7 +697,7 @@ and in_string opening state = parse
the trace is empty at the end. Note that we discard the state at
the end. *)
let lex opt buffer : Buffer.t =
let lex opt buffer =
let state = {
env = Env.empty;
mode = Copy;
@ -693,9 +707,10 @@ let lex opt buffer : Buffer.t =
incl = [];
opt
} in
let state = scan state buffer in
let () = List.iter close_in state.incl
in state.out
match scan state buffer with
state -> List.iter close_in state.incl;
Stdlib.Ok state.out
| exception Error e -> Stdlib.Error e
(* END OF TRAILER *)
}

View File

@ -13,15 +13,12 @@ match open_in options#input with
buffer.lex_curr_p <-
{buffer.lex_curr_p with pos_fname = options#input} in
match Preproc.lex options buffer with
pp -> print_string (Buffer.contents pp)
| exception E_Lexer.Error err ->
let formatted =
E_Lexer.format ~offsets:options#offsets ~file:true err
in highlight formatted.Region.value
| exception Preproc.Error (_out, err) ->
Stdlib.Ok pp_buffer -> print_string (Buffer.contents pp_buffer)
| Stdlib.Error (pp_buffer, err) ->
let formatted =
Preproc.format ~offsets:options#offsets ~file:true err in
begin
(* print_string (Buffer.contents out);*)
if EvalOpt.SSet.mem "preproc" options#verbose then
Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
highlight formatted.Region.value
end