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:
parent
b24f1f6b1d
commit
ca48e152a0
2
vendors/Preproc/E_Lexer.mli
vendored
2
vendors/Preproc/E_Lexer.mli
vendored
@ -10,6 +10,8 @@ val string_of_token : E_Parser.token -> string
|
|||||||
|
|
||||||
type error = Invalid_character of char
|
type error = Invalid_character of char
|
||||||
|
|
||||||
|
val error_to_string : error -> string
|
||||||
|
|
||||||
val format :
|
val format :
|
||||||
?offsets:bool -> error Region.reg -> file:bool -> string Region.reg
|
?offsets:bool -> error Region.reg -> file:bool -> string Region.reg
|
||||||
|
|
||||||
|
2
vendors/Preproc/E_Lexer.mll
vendored
2
vendors/Preproc/E_Lexer.mll
vendored
@ -31,7 +31,7 @@ type error = Invalid_character of char
|
|||||||
|
|
||||||
let error_to_string = function
|
let error_to_string = function
|
||||||
Invalid_character c ->
|
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 format ?(offsets=true) Region.{region; value} ~file =
|
||||||
let msg = error_to_string value
|
let msg = error_to_string value
|
||||||
|
26
vendors/Preproc/EvalOpt.ml
vendored
26
vendors/Preproc/EvalOpt.ml
vendored
@ -4,19 +4,23 @@
|
|||||||
|
|
||||||
type language = PascaLIGO | CameLIGO | ReasonLIGO
|
type language = PascaLIGO | CameLIGO | ReasonLIGO
|
||||||
|
|
||||||
|
module SSet = Set.Make (String)
|
||||||
|
|
||||||
type options = <
|
type options = <
|
||||||
input : string;
|
input : string;
|
||||||
libs : string list;
|
libs : string list;
|
||||||
lang : language;
|
lang : language;
|
||||||
offsets : bool
|
offsets : bool;
|
||||||
|
verbose : SSet.t
|
||||||
>
|
>
|
||||||
|
|
||||||
let make ~input ~libs ~lang ~offsets =
|
let make ~input ~libs ~lang ~offsets ~verbose =
|
||||||
object
|
object
|
||||||
method input = input
|
method input = input
|
||||||
method libs = libs
|
method libs = libs
|
||||||
method lang = lang
|
method lang = lang
|
||||||
method offsets = offsets
|
method offsets = offsets
|
||||||
|
method verbose = verbose
|
||||||
end
|
end
|
||||||
|
|
||||||
(* Auxiliary functions and modules *)
|
(* Auxiliary functions and modules *)
|
||||||
@ -43,6 +47,7 @@ let help () =
|
|||||||
print "and each <option> (if any) is one of the following:";
|
print "and each <option> (if any) is one of the following:";
|
||||||
print " -I <paths> Inclusion paths (colon-separated)";
|
print " -I <paths> Inclusion paths (colon-separated)";
|
||||||
print " --columns Columns for source locations";
|
print " --columns Columns for source locations";
|
||||||
|
print " --verbose=<stages> preproc";
|
||||||
print " -h, --help This help";
|
print " -h, --help This help";
|
||||||
exit 0
|
exit 0
|
||||||
|
|
||||||
@ -52,16 +57,23 @@ let input = ref None
|
|||||||
and libs = ref []
|
and libs = ref []
|
||||||
and lang = ref None
|
and lang = ref None
|
||||||
and columns = ref false
|
and columns = ref false
|
||||||
|
and verbose = ref SSet.empty
|
||||||
|
and verb_str = ref ""
|
||||||
|
|
||||||
let split_at_colon = Str.(split (regexp ":"))
|
let split_at_colon = Str.(split (regexp ":"))
|
||||||
|
|
||||||
let add_path p = libs := !libs @ split_at_colon p
|
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 specs =
|
||||||
let open!Getopt in [
|
let open!Getopt in [
|
||||||
'I', nolong, None, Some add_path;
|
'I', nolong, None, Some add_path;
|
||||||
'h', "help", Some help, None;
|
'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 *)
|
(* Handler of anonymous arguments *)
|
||||||
@ -84,6 +96,8 @@ let check () =
|
|||||||
|
|
||||||
and offsets = not !columns
|
and offsets = not !columns
|
||||||
|
|
||||||
|
and verbose = !verbose
|
||||||
|
|
||||||
and lang =
|
and lang =
|
||||||
match !lang with
|
match !lang with
|
||||||
Some lang -> lang
|
Some lang -> lang
|
||||||
@ -94,12 +108,16 @@ let check () =
|
|||||||
Some file -> file
|
Some file -> file
|
||||||
| None -> abort "Missing input file."
|
| None -> abort "Missing input file."
|
||||||
|
|
||||||
in make ~input ~libs ~lang ~offsets
|
in make ~input ~libs ~lang ~offsets ~verbose
|
||||||
|
|
||||||
(* Parsing the command-line options *)
|
(* Parsing the command-line options *)
|
||||||
|
|
||||||
let read () =
|
let read () =
|
||||||
try
|
try
|
||||||
Getopt.parse_cmdline specs anonymous;
|
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 ()
|
check ()
|
||||||
with Getopt.Error msg -> abort msg
|
with Getopt.Error msg -> abort msg
|
||||||
|
6
vendors/Preproc/EvalOpt.mli
vendored
6
vendors/Preproc/EvalOpt.mli
vendored
@ -4,11 +4,14 @@
|
|||||||
|
|
||||||
type language = PascaLIGO | CameLIGO | ReasonLIGO
|
type language = PascaLIGO | CameLIGO | ReasonLIGO
|
||||||
|
|
||||||
|
module SSet : Set.S with type elt = string
|
||||||
|
|
||||||
type options = <
|
type options = <
|
||||||
input : string;
|
input : string;
|
||||||
libs : string list;
|
libs : string list;
|
||||||
lang : language;
|
lang : language;
|
||||||
offsets : bool
|
offsets : bool;
|
||||||
|
verbose : SSet.t
|
||||||
>
|
>
|
||||||
|
|
||||||
val make :
|
val make :
|
||||||
@ -16,6 +19,7 @@ val make :
|
|||||||
libs:string list ->
|
libs:string list ->
|
||||||
lang:language ->
|
lang:language ->
|
||||||
offsets:bool ->
|
offsets:bool ->
|
||||||
|
verbose:SSet.t ->
|
||||||
options
|
options
|
||||||
|
|
||||||
(* Parsing the command-line options on stdin. The first parameter is
|
(* Parsing the command-line options on stdin. The first parameter is
|
||||||
|
10
vendors/Preproc/Preproc.mli
vendored
10
vendors/Preproc/Preproc.mli
vendored
@ -34,15 +34,17 @@ type error =
|
|||||||
| No_line_comment_or_blank
|
| No_line_comment_or_blank
|
||||||
| Invalid_symbol
|
| Invalid_symbol
|
||||||
| File_not_found of string
|
| File_not_found of string
|
||||||
|
| Invalid_character of char
|
||||||
|
|
||||||
val format :
|
val format :
|
||||||
?offsets:bool -> error Region.reg -> file:bool -> string Region.reg
|
?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 ->
|
||||||
val lex : EvalOpt.options -> Lexing.lexbuf -> Buffer.t
|
Lexing.lexbuf ->
|
||||||
|
(Buffer.t, Buffer.t * error Region.reg) Stdlib.result
|
||||||
|
|
||||||
(* Evaluation of boolean expressions *)
|
(* Evaluation of boolean expressions *)
|
||||||
|
|
||||||
|
67
vendors/Preproc/Preproc.mll
vendored
67
vendors/Preproc/Preproc.mll
vendored
@ -105,6 +105,7 @@ type error =
|
|||||||
| No_line_comment_or_blank
|
| No_line_comment_or_blank
|
||||||
| Invalid_symbol
|
| Invalid_symbol
|
||||||
| File_not_found of string
|
| File_not_found of string
|
||||||
|
| Invalid_character of char
|
||||||
|
|
||||||
let error_to_string = function
|
let error_to_string = function
|
||||||
Invalid_directive name ->
|
Invalid_directive name ->
|
||||||
@ -167,6 +168,8 @@ let error_to_string = function
|
|||||||
"Expected a symbol (identifier)."
|
"Expected a symbol (identifier)."
|
||||||
| File_not_found name ->
|
| File_not_found name ->
|
||||||
sprintf "File \"%s\" to include 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 format ?(offsets=true) Region.{region; value} ~file =
|
||||||
let msg = error_to_string value
|
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
|
let value = sprintf "Preprocessing error %s:\n%s" reg msg
|
||||||
in Region.{value; region}
|
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 mk_reg buffer =
|
||||||
let start = Lexing.lexeme_start_p buffer |> Pos.from_byte
|
let start = Lexing.lexeme_start_p buffer |> Pos.from_byte
|
||||||
and stop = Lexing.lexeme_end_p buffer |> Pos.from_byte
|
and stop = Lexing.lexeme_end_p buffer |> Pos.from_byte
|
||||||
in Region.make ~start ~stop
|
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)
|
let fail error state buffer = stop error state (mk_reg buffer)
|
||||||
|
|
||||||
(* The function [reduce_cond] is called when a #endif directive is
|
(* 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 expr state buffer : mode =
|
||||||
let ast =
|
let ast =
|
||||||
try E_Parser.expr E_Lexer.scan buffer with
|
try E_Parser.expr E_Lexer.scan buffer with
|
||||||
E_Parser.Error ->
|
E_Lexer.Error Region.{value; region} ->
|
||||||
let region = mk_reg buffer in
|
(match value with
|
||||||
let value = Parse_error
|
E_Lexer.Invalid_character c ->
|
||||||
in raise (Error (state.out, Region.{value; region})) in
|
stop (Invalid_character c) state region)
|
||||||
|
| E_Parser.Error ->
|
||||||
|
fail Parse_error state buffer in
|
||||||
let () = print state "\n" in
|
let () = print state "\n" in
|
||||||
if eval state.env ast then Copy else Skip
|
if eval state.env ast then Copy else Skip
|
||||||
|
|
||||||
@ -431,8 +442,11 @@ rule scan state = parse
|
|||||||
nl { proc_nl state lexbuf;
|
nl { proc_nl state lexbuf;
|
||||||
scan {state with offset = Prefix 0} lexbuf }
|
scan {state with offset = Prefix 0} lexbuf }
|
||||||
| blank { match state.offset with
|
| blank { match state.offset with
|
||||||
Prefix n -> scan {state with offset = Prefix (n+1)} lexbuf
|
Prefix n ->
|
||||||
| Inline -> copy state lexbuf; scan state lexbuf }
|
scan {state with offset = Prefix (n+1)} lexbuf
|
||||||
|
| Inline ->
|
||||||
|
if state.mode = Copy then copy state lexbuf;
|
||||||
|
scan state lexbuf }
|
||||||
| directive {
|
| directive {
|
||||||
if not (List.mem id directives)
|
if not (List.mem id directives)
|
||||||
then fail (Invalid_directive id) state lexbuf;
|
then fail (Invalid_directive id) state lexbuf;
|
||||||
@ -452,7 +466,7 @@ rule scan state = parse
|
|||||||
Some channel -> channel
|
Some channel -> channel
|
||||||
| None -> stop (File_not_found incl_file) state reg in
|
| None -> stop (File_not_found incl_file) state reg in
|
||||||
let state = {state with incl = incl_chan::state.incl} 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);
|
print state (sprintf "# %i \"%s\" 2" (line+1) base);
|
||||||
scan state lexbuf
|
scan state lexbuf
|
||||||
| "if" ->
|
| "if" ->
|
||||||
@ -496,19 +510,6 @@ rule scan state = parse
|
|||||||
in scan state lexbuf
|
in scan state lexbuf
|
||||||
| "error" ->
|
| "error" ->
|
||||||
stop (Error_directive (message [] lexbuf)) state region
|
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" ->
|
| "region" ->
|
||||||
let msg = message [] lexbuf
|
let msg = message [] lexbuf
|
||||||
in expand_offset state;
|
in expand_offset state;
|
||||||
@ -526,6 +527,19 @@ rule scan state = parse
|
|||||||
print state ("#" ^ space ^ "line");
|
print state ("#" ^ space ^ "line");
|
||||||
line_ind state lexbuf;
|
line_ind state lexbuf;
|
||||||
scan {state with offset = Prefix 0} 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
|
| _ -> assert false
|
||||||
}
|
}
|
||||||
| eof { match state.trace with
|
| 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 trace is empty at the end. Note that we discard the state at
|
||||||
the end. *)
|
the end. *)
|
||||||
|
|
||||||
let lex opt buffer : Buffer.t =
|
let lex opt buffer =
|
||||||
let state = {
|
let state = {
|
||||||
env = Env.empty;
|
env = Env.empty;
|
||||||
mode = Copy;
|
mode = Copy;
|
||||||
@ -693,9 +707,10 @@ let lex opt buffer : Buffer.t =
|
|||||||
incl = [];
|
incl = [];
|
||||||
opt
|
opt
|
||||||
} in
|
} in
|
||||||
let state = scan state buffer in
|
match scan state buffer with
|
||||||
let () = List.iter close_in state.incl
|
state -> List.iter close_in state.incl;
|
||||||
in state.out
|
Stdlib.Ok state.out
|
||||||
|
| exception Error e -> Stdlib.Error e
|
||||||
|
|
||||||
(* END OF TRAILER *)
|
(* END OF TRAILER *)
|
||||||
}
|
}
|
||||||
|
11
vendors/Preproc/PreprocMain.ml
vendored
11
vendors/Preproc/PreprocMain.ml
vendored
@ -13,15 +13,12 @@ match open_in options#input with
|
|||||||
buffer.lex_curr_p <-
|
buffer.lex_curr_p <-
|
||||||
{buffer.lex_curr_p with pos_fname = options#input} in
|
{buffer.lex_curr_p with pos_fname = options#input} in
|
||||||
match Preproc.lex options buffer with
|
match Preproc.lex options buffer with
|
||||||
pp -> print_string (Buffer.contents pp)
|
Stdlib.Ok pp_buffer -> print_string (Buffer.contents pp_buffer)
|
||||||
| exception E_Lexer.Error err ->
|
| Stdlib.Error (pp_buffer, err) ->
|
||||||
let formatted =
|
|
||||||
E_Lexer.format ~offsets:options#offsets ~file:true err
|
|
||||||
in highlight formatted.Region.value
|
|
||||||
| exception Preproc.Error (_out, err) ->
|
|
||||||
let formatted =
|
let formatted =
|
||||||
Preproc.format ~offsets:options#offsets ~file:true err in
|
Preproc.format ~offsets:options#offsets ~file:true err in
|
||||||
begin
|
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
|
highlight formatted.Region.value
|
||||||
end
|
end
|
||||||
|
Loading…
Reference in New Issue
Block a user