Added support for -I CLI option (same behaviour as CPP).

Comments are now recognised in accordance with the file extension.
This commit is contained in:
Christian Rinderknecht 2020-03-25 18:52:23 +01:00
parent ab79fe4eda
commit b24f1f6b1d
4 changed files with 99 additions and 59 deletions

View File

@ -41,7 +41,7 @@ let help () =
printf "Usage: %s [<option> ...] <input>\n" file; printf "Usage: %s [<option> ...] <input>\n" file;
printf "where <input> is the source file,\n"; printf "where <input> is the source file,\n";
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> Library paths (colon-separated)"; print " -I <paths> Inclusion paths (colon-separated)";
print " --columns Columns for source locations"; print " --columns Columns for source locations";
print " -h, --help This help"; print " -h, --help This help";
exit 0 exit 0

View File

@ -33,6 +33,7 @@ type error =
| Parse_error | Parse_error
| No_line_comment_or_blank | No_line_comment_or_blank
| Invalid_symbol | Invalid_symbol
| File_not_found of 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
@ -41,7 +42,7 @@ val format :
exception Error of Buffer.t * error Region.reg exception Error of Buffer.t * error Region.reg
val lex : Lexing.lexbuf -> Buffer.t val lex : EvalOpt.options -> Lexing.lexbuf -> Buffer.t
(* Evaluation of boolean expressions *) (* Evaluation of boolean expressions *)

View File

@ -73,7 +73,8 @@ type state = {
offset : offset; offset : offset;
trace : trace; trace : trace;
out : Buffer.t; out : Buffer.t;
incl : in_channel list incl : in_channel list;
opt : EvalOpt.options
} }
(* ERRORS *) (* ERRORS *)
@ -103,6 +104,7 @@ type error =
| Parse_error | Parse_error
| No_line_comment_or_blank | No_line_comment_or_blank
| Invalid_symbol | Invalid_symbol
| File_not_found of string
let error_to_string = function let error_to_string = function
Invalid_directive name -> Invalid_directive name ->
@ -163,6 +165,8 @@ let error_to_string = function
"Line comment or whitespace expected." "Line comment or whitespace expected."
| Invalid_symbol -> | Invalid_symbol ->
"Expected a symbol (identifier)." "Expected a symbol (identifier)."
| File_not_found name ->
sprintf "File \"%s\" to include not found." name
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
@ -186,18 +190,18 @@ let fail error state buffer = stop error state (mk_reg buffer)
let reduce_cond state region = let reduce_cond state region =
let rec reduce = function let rec reduce = function
[] -> stop Dangling_endif state region [] -> stop Dangling_endif state region
| If mode::trace -> trace, mode | If mode::trace -> {state with mode; trace; offset = Prefix 0}
| Region::_ -> stop Open_region_in_conditional state region | Region::_ -> stop Open_region_in_conditional state region
| _::trace -> reduce trace | _::trace -> reduce trace
in reduce state.trace in reduce state.trace
(* The function [reduce_reg] is called when a #endregion directive is (* The function [reduce_region] is called when a #endregion directive is
read, and the trace needs updating. *) read, and the trace needs updating. *)
let reduce_reg state region = let reduce_region state region =
match state.trace with match state.trace with
[] -> stop Dangling_endregion state region [] -> stop Dangling_endregion state region
| Region::trace -> trace | Region::trace -> {state with trace; offset = Prefix 0}
| _ -> stop Conditional_in_region state region | _ -> stop Conditional_in_region state region
(* The function [extend] is called when encountering conditional (* The function [extend] is called when encountering conditional
@ -222,6 +226,22 @@ let rec last_mode = function
| (If mode | Elif mode)::_ -> mode | (If mode | Elif mode)::_ -> mode
| _::trace -> last_mode trace | _::trace -> last_mode trace
(* Finding a file to #include *)
let rec find base = function
[] -> None
| dir::dirs ->
let path = dir ^ Filename.dir_sep ^ base in
try Some (open_in path) with
Sys_error _ -> find base dirs
let find dir file libs : in_channel option =
let path = dir ^ Filename.dir_sep ^ file in
try Some (open_in path) with
Sys_error _ ->
let base = Filename.basename file in
if base = file then find file libs else None
(* PRINTING *) (* PRINTING *)
(* Copying the current lexeme to [stdout] *) (* Copying the current lexeme to [stdout] *)
@ -267,9 +287,9 @@ let expr state buffer : mode =
(* DIRECTIVES *) (* DIRECTIVES *)
let directives = [ let directives = [
"if"; "else"; "elif"; "endif"; "define"; "undef"; "define"; "elif"; "else"; "endif"; "endregion"; "error";
"error"; (*"warning";*) "line"; "region"; "endregion"; "if"; "include"; "line"; "region"; "undef" (* "warning" *)
"include"] ]
(* END OF HEADER *) (* END OF HEADER *)
} }
@ -303,10 +323,10 @@ let directive = '#' (blank* as space) (small+ as id)
directives read so far. directives read so far.
The first call is [scan {env=Env.empty; mode=Copy; offset = Prefix The first call is [scan {env=Env.empty; mode=Copy; offset = Prefix
0; trace=[]}], meaning that we start with an empty environment, 0; trace=[]; incl=[]; opt}], meaning that we start with an empty
that copying the input is enabled by default, and that we are at environment, that copying the input is enabled by default, and that
the start of a line and no previous conditional directives have we are at the start of a line and no previous conditional
been read yet. directives have been read yet. The field [opt] is the CLI options.
When an "#if" is matched, the trace is extended by the call [extend When an "#if" is matched, the trace is extended by the call [extend
lexbuf (If mode) trace], during the evaluation of which the lexbuf (If mode) trace], during the evaluation of which the
@ -405,7 +425,7 @@ let directive = '#' (blank* as space) (small+ as id)
Important note: Comments and strings are recognised as such only in Important note: Comments and strings are recognised as such only in
copy mode, which is a different behaviour from the preprocessor of copy mode, which is a different behaviour from the preprocessor of
GNU GCC, which always does. GNU GCC, which always does.
*) *)
rule scan state = parse rule scan state = parse
nl { proc_nl state lexbuf; nl { proc_nl state lexbuf;
@ -422,14 +442,18 @@ rule scan state = parse
match id with match id with
"include" -> "include" ->
let line = Lexing.(lexbuf.lex_curr_p.pos_lnum) let line = Lexing.(lexbuf.lex_curr_p.pos_lnum)
and file = Lexing.(lexbuf.lex_curr_p.pos_fname) and file = Lexing.(lexbuf.lex_curr_p.pos_fname) in
|> Filename.basename let base = Filename.basename file
and incl_file = scan_inclusion state lexbuf in and dir = Filename.dirname file
and reg, incl_file = scan_inclusion state lexbuf in
print state (sprintf "# 1 \"%s\" 1\n" incl_file); print state (sprintf "# 1 \"%s\" 1\n" incl_file);
let incl_chan = open_in incl_file in let incl_chan =
match find dir incl_file state.opt#libs with
Some channel -> channel
| 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);
print state (sprintf "# %i \"%s\" 2\n" (line+1) file); print state (sprintf "# %i \"%s\" 2" (line+1) base);
scan state lexbuf scan state lexbuf
| "if" -> | "if" ->
let mode = expr state lexbuf in let mode = expr state lexbuf in
@ -454,9 +478,8 @@ rule scan state = parse
if old_mode = Copy then mode else Skip if old_mode = Copy then mode else Skip
in scan {state with mode; offset = Prefix 0; trace} lexbuf in scan {state with mode; offset = Prefix 0; trace} lexbuf
| "endif" -> | "endif" ->
let () = skip_line state lexbuf in skip_line state lexbuf;
let trace, mode = reduce_cond state region scan (reduce_cond state region) lexbuf
in scan {state with mode; offset = Prefix 0; trace} lexbuf
| "define" -> | "define" ->
let id, region = variable state lexbuf in let id, region = variable state lexbuf in
if id="true" || id="false" if id="true" || id="false"
@ -497,10 +520,7 @@ rule scan state = parse
let msg = message [] lexbuf let msg = message [] lexbuf
in expand_offset state; in expand_offset state;
print state ("#" ^ space ^ "endregion" ^ msg ^ "\n"); print state ("#" ^ space ^ "endregion" ^ msg ^ "\n");
let state = scan (reduce_region state region) lexbuf
{state with offset = Prefix 0;
trace = reduce_reg state region}
in scan state lexbuf
| "line" -> | "line" ->
expand_offset state; expand_offset state;
print state ("#" ^ space ^ "line"); print state ("#" ^ space ^ "line");
@ -529,7 +549,17 @@ rule scan state = parse
begin begin
expand_offset state; expand_offset state;
copy state lexbuf; copy state lexbuf;
in_block_com (mk_reg lexbuf) state lexbuf if state.opt#lang = EvalOpt.ReasonLIGO then
reasonLIGO_com (mk_reg lexbuf) state lexbuf
end;
scan {state with offset=Inline} lexbuf }
| "(*" { if state.mode = Copy then
begin
expand_offset state;
copy state lexbuf;
if state.opt#lang = EvalOpt.CameLIGO
|| state.opt#lang = EvalOpt.PascaLIGO then
cameLIGO_com (mk_reg lexbuf) state lexbuf
end; end;
scan {state with offset=Inline} lexbuf } scan {state with offset=Inline} lexbuf }
| _ { if state.mode = Copy then | _ { if state.mode = Copy then
@ -546,7 +576,7 @@ and variable state = parse
in skip_line state lexbuf; id } in skip_line state lexbuf; id }
and symbol state = parse and symbol state = parse
ident as id { id, mk_reg lexbuf } ident as id { id, mk_reg lexbuf }
| _ { fail Invalid_symbol state lexbuf } | _ { fail Invalid_symbol state lexbuf }
@ -561,19 +591,19 @@ and line_indicator state = parse
match id with match id with
"default" | "hidden" -> "default" | "hidden" ->
print state (id ^ message [] lexbuf) print state (id ^ message [] lexbuf)
| _ -> fail (Invalid_line_indicator id) state lexbuf } | _ -> fail (Invalid_line_indicator id) state lexbuf }
| _ { fail No_line_indicator state lexbuf } | _ { fail No_line_indicator state lexbuf }
and end_indicator state = parse and end_indicator state = parse
blank+ { copy state lexbuf; end_indicator state lexbuf } blank+ { copy state lexbuf; end_indicator state lexbuf }
| nl { proc_nl state lexbuf } | nl { proc_nl state lexbuf }
| eof { copy state lexbuf } | eof { copy state lexbuf }
| "//" { copy state lexbuf; | "//" { copy state lexbuf;
print state (message [] lexbuf ^ "\n") } print state (message [] lexbuf ^ "\n") }
| '"' { copy state lexbuf; | '"' { copy state lexbuf;
in_string (mk_reg lexbuf) state lexbuf; in_string (mk_reg lexbuf) state lexbuf;
opt_line_com state lexbuf } opt_line_com state lexbuf }
| _ { fail End_line_indicator state lexbuf } | _ { fail End_line_indicator state lexbuf }
and opt_line_com state = parse and opt_line_com state = parse
nl { proc_nl state lexbuf } nl { proc_nl state lexbuf }
@ -584,11 +614,11 @@ and opt_line_com state = parse
(* New lines and verbatim sequence of characters *) (* New lines and verbatim sequence of characters *)
and skip_line state = parse and skip_line state = parse
nl { proc_nl state lexbuf } nl { proc_nl state lexbuf }
| blank+ { skip_line state lexbuf } | blank+ { skip_line state lexbuf }
| "//" { in_line_com {state with mode=Skip} lexbuf } | "//" { in_line_com {state with mode=Skip} lexbuf }
| _ { fail No_line_comment_or_blank state lexbuf } | _ { fail No_line_comment_or_blank state lexbuf }
| eof { () } | eof { () }
and message acc = parse and message acc = parse
nl { Lexing.new_line lexbuf; nl { Lexing.new_line lexbuf;
@ -604,11 +634,17 @@ and in_line_com state = parse
| _ { if state.mode = Copy then copy state lexbuf; | _ { if state.mode = Copy then copy state lexbuf;
in_line_com state lexbuf } in_line_com state lexbuf }
and in_block_com opening state = parse and reasonLIGO_com opening state = parse
nl { proc_nl state lexbuf; in_block_com opening state lexbuf } nl { proc_nl state lexbuf; reasonLIGO_com opening state lexbuf }
| "*/" { copy state lexbuf } | "*/" { copy state lexbuf }
| eof { stop Open_comment state opening } | eof { stop Open_comment state opening }
| _ { copy state lexbuf; in_block_com opening state lexbuf } | _ { copy state lexbuf; reasonLIGO_com opening state lexbuf }
and cameLIGO_com opening state = parse
nl { proc_nl state lexbuf; cameLIGO_com opening state lexbuf }
| "*)" { copy state lexbuf }
| eof { stop Open_comment state opening }
| _ { copy state lexbuf; cameLIGO_com opening state lexbuf }
(* Include a file *) (* Include a file *)
@ -623,19 +659,21 @@ and scan_inclusion state = parse
| '"' { in_inclusion (mk_reg lexbuf) [] 0 state lexbuf } | '"' { in_inclusion (mk_reg lexbuf) [] 0 state lexbuf }
and in_inclusion opening acc len state = parse and in_inclusion opening acc len state = parse
'"' { mk_str len acc } '"' { let closing = mk_reg lexbuf
| nl { fail Newline_in_string state lexbuf } in Region.cover opening closing,
| eof { stop Open_string state opening } mk_str len acc }
| nl { fail Newline_in_string state lexbuf }
| eof { stop Open_string state opening }
| _ as c { in_inclusion opening (c::acc) (len+1) state lexbuf } | _ as c { in_inclusion opening (c::acc) (len+1) state lexbuf }
(* Strings *) (* Strings *)
and in_string opening state = parse and in_string opening state = parse
"\\\"" { copy state lexbuf; in_string opening state lexbuf } "\\\"" { copy state lexbuf; in_string opening state lexbuf }
| '"' { copy state lexbuf } | '"' { copy state lexbuf }
| nl { fail Newline_in_string state lexbuf } | nl { fail Newline_in_string state lexbuf }
| eof { stop Open_string state opening } | eof { stop Open_string state opening }
| _ { copy state lexbuf; in_string opening state lexbuf } | _ { copy state lexbuf; in_string opening state lexbuf }
{ {
@ -645,14 +683,15 @@ 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 buffer : Buffer.t = let lex opt buffer : Buffer.t =
let state = { let state = {
env = Env.empty; env = Env.empty;
mode = Copy; mode = Copy;
offset = Prefix 0; offset = Prefix 0;
trace = []; trace = [];
out = Buffer.create 80; out = Buffer.create 80;
incl = [] incl = [];
opt
} in } in
let state = scan state buffer in let state = scan state buffer in
let () = List.iter close_in state.incl let () = List.iter close_in state.incl

View File

@ -1,6 +1,6 @@
module Region = Simple_utils.Region module Region = Simple_utils.Region
let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg let highlight msg = Printf.eprintf "\027[31m%s\027[0m\n%!" msg
let options = EvalOpt.read ();; let options = EvalOpt.read ();;
@ -12,16 +12,16 @@ match open_in options#input with
let () = let () =
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 buffer with match Preproc.lex options buffer with
pp -> print_string (Buffer.contents pp) pp -> print_string (Buffer.contents pp)
| exception E_Lexer.Error err -> | exception E_Lexer.Error err ->
let formatted = let formatted =
E_Lexer.format ~offsets:options#offsets ~file:true err E_Lexer.format ~offsets:options#offsets ~file:true err
in highlight formatted.Region.value in highlight formatted.Region.value
| exception Preproc.Error (out, err) -> | 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); (* print_string (Buffer.contents out);*)
highlight formatted.Region.value highlight formatted.Region.value
end end