The emitted line directives now have the exact same contents as with

cpp. A line made of blanks is now correctly copied out (instead of
single newline).
This commit is contained in:
Christian Rinderknecht 2020-03-27 19:30:39 +01:00
parent b5a3fb9367
commit ebff258882
3 changed files with 70 additions and 45 deletions

View File

@ -65,7 +65,20 @@ in function
| Ident id -> Env.mem id env | Ident id -> Env.mem id env
(* The type [state] groups the information that needs to be threaded (* The type [state] groups the information that needs to be threaded
along the scanning functions. *) along the scanning functions:
* the field [env] records the symbols defined;
* the field [mode] informs whether the preprocessor is in copying or
skipping mode;
* the field [offset] tells whether the current location can be
reached from the start of the line with only white space;
* the field [trace] is a stack of previous, still active conditional
directives;
* the field [out] keeps the output buffer;
* the field [incl] is a list of opened input channels (#include);
* the field [opt] holds the CLI options;
* the field [dir] is the file system's path to the the current input
file.
*)
type state = { type state = {
env : Env.t; env : Env.t;
@ -74,9 +87,18 @@ type state = {
trace : trace; trace : trace;
out : Buffer.t; out : Buffer.t;
incl : in_channel list; incl : in_channel list;
opt : EvalOpt.options opt : EvalOpt.options;
dir : string list
} }
(* Directories *)
let push_dir dir state =
if dir = "." then state else {state with dir = dir :: state.dir}
let mk_path state =
String.concat Filename.dir_sep (List.rev state.dir)
(* ERRORS *) (* ERRORS *)
type error = type error =
@ -240,13 +262,17 @@ let rec last_mode = function
let rec find base = function let rec find base = function
[] -> None [] -> None
| dir::dirs -> | dir::dirs ->
let path = dir ^ Filename.dir_sep ^ base in let path =
try Some (open_in path) with if dir = "." || dir = "" then base
else dir ^ Filename.dir_sep ^ base in
try Some (path, open_in path) with
Sys_error _ -> find base dirs Sys_error _ -> find base dirs
let find dir file libs : in_channel option = let find dir file libs =
let path = dir ^ Filename.dir_sep ^ file in let path =
try Some (open_in path) with if dir = "." || dir = "" then file
else dir ^ Filename.dir_sep ^ file in
try Some (path, open_in path) with
Sys_error _ -> Sys_error _ ->
let base = Filename.basename file in let base = Filename.basename file in
if base = file then find file libs else None if base = file then find file libs else None
@ -439,7 +465,7 @@ let directive = '#' (blank* as space) (small+ as id)
*) *)
rule scan state = parse rule scan state = parse
nl { proc_nl state lexbuf; nl { expand_offset state; 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 -> Prefix n ->
@ -458,24 +484,30 @@ rule scan state = parse
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) in and file = Lexing.(lexbuf.lex_curr_p.pos_fname) in
let base = Filename.basename file let base = Filename.basename file
and dir = Filename.dirname file (* and dir = Filename.dirname file*)
and reg, incl_file = scan_inclusion state lexbuf in and reg, incl_file = scan_inclusion state lexbuf in
print state (sprintf "# 1 \"%s\" 1\n" incl_file); let incl_dir = Filename.dirname incl_file in
let incl_chan = let path = mk_path state in
match find dir incl_file state.opt#libs with let incl_path, incl_chan =
Some channel -> channel match find path incl_file state.opt#libs with
Some p -> p
| None -> stop (File_not_found incl_file) state reg in | None -> stop (File_not_found incl_file) state reg in
let incl_buf = Lexing.from_channel incl_chan in let incl_buf = Lexing.from_channel incl_chan in
let () = let () =
let open Lexing in let open Lexing in
incl_buf.lex_curr_p <- incl_buf.lex_curr_p <-
{incl_buf.lex_curr_p with pos_fname = incl_file} in {incl_buf.lex_curr_p with pos_fname = incl_file} in
let state = {state with incl = incl_chan::state.incl} in let state = {state with incl = incl_chan::state.incl} in
let state' = let state' =
{state with env=Env.empty; mode=Copy; trace=[]} in {state with env=Env.empty; mode=Copy; trace=[]} in
let state' = push_dir incl_dir state' in
print state (sprintf "\n# 1 \"%s\" 1\n" incl_path);
let state' = scan state' incl_buf in let state' = scan state' incl_buf in
let state = {state with incl = state'.incl} in let state = {state with incl = state'.incl} in
print state (sprintf "# %i \"%s\" 2" (line+1) base); let path =
if path = "" then base
else path ^ Filename.dir_sep ^ base in
print state (sprintf "\n# %i \"%s\" 2" (line+1) path);
scan state lexbuf scan state lexbuf
| "if" -> | "if" ->
let mode = expr state lexbuf in let mode = expr state lexbuf in
@ -668,12 +700,6 @@ and cameLIGO_com opening state = parse
| eof { stop Open_comment state opening } | eof { stop Open_comment state opening }
| _ { copy state lexbuf; cameLIGO_com opening state lexbuf } | _ { copy state lexbuf; cameLIGO_com opening state lexbuf }
(* Include a file *)
and cat state = parse
eof { () }
| _ { copy state lexbuf; cat state lexbuf }
(* Included filename *) (* Included filename *)
and scan_inclusion state = parse and scan_inclusion state = parse
@ -713,7 +739,8 @@ let lex opt buffer =
trace = []; trace = [];
out = Buffer.create 80; out = Buffer.create 80;
incl = []; incl = [];
opt opt;
dir = []
} in } in
match scan state buffer with match scan state buffer with
state -> List.iter close_in state.incl; state -> List.iter close_in state.incl;

View File

@ -1,25 +1,22 @@
#!/bin/sh #!/bin/sh
set -x set -x
ocamllex.opt Escan.mll ocamllex.opt E_Lexer.mll
ocamllex.opt Preproc.mll ocamllex.opt Preproc.mll
menhir -la 1 Eparser.mly menhir -la 1 E_Parser.mly
ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c EvalOpt.mli ocamlfind ocamlc -strict-sequence -w +A-48-4 -c EvalOpt.mli
ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c EvalOpt.ml ocamlfind ocamlc -strict-sequence -w +A-48-4 -c E_AST.ml
ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c Etree.ml ocamlfind ocamlc -strict-sequence -w +A-48-4 -c E_Parser.mli
ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c Error.ml ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c E_Lexer.mli
ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c Etree.ml ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c E_LexerMain.ml
ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c Error.ml camlcmd="ocamlfind ocamlc -I _x86_64 -strict-sequence -w +A-48-4 "
ocamlfind ocamlc -strict-sequence -w +A-48-4 -c Eparser.mli ocamlfind ocamlc -strict-sequence -w +A-48-4 -package getopt,str -c EvalOpt.ml
camlcmd="ocamlfind ocamlc -I _i686 -strict-sequence -w +A-48-4 " ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c E_Lexer.ml
menhir --infer --ocamlc="$camlcmd" Eparser.mly menhir --infer --ocamlc="$camlcmd" E_Parser.mly
ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c Escan.ml ocamlfind ocamlc -strict-sequence -w +A-48-4 -c E_Parser.ml
ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c Eparser.ml ocamlfind ocamlc -package getopt,simple-utils,str -linkpkg -o E_LexerMain.byte E_AST.cmo E_Parser.cmo E_Lexer.cmo EvalOpt.cmo E_LexerMain.cmo
ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c Preproc.ml ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c Preproc.mli
ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c Escan.ml ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c PreprocMain.ml
ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c Preproc.ml ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c Preproc.ml
ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c EMain.ml ocamlfind ocamlc -package getopt,simple-utils,str -linkpkg -o PreprocMain.byte EvalOpt.cmo E_AST.cmo E_Parser.cmo E_Lexer.cmo Preproc.cmo PreprocMain.cmo
ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c EMain.ml ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c E_ParserMain.ml
ocamlfind ocamlopt -o EMain.opt EvalOpt.cmx Etree.cmx Eparser.cmx Error.cmx Escan.cmx Preproc.cmx EMain.cmx ocamlfind ocamlc -package getopt,simple-utils,str -linkpkg -o E_ParserMain.byte E_AST.cmo E_Parser.cmo E_Lexer.cmo EvalOpt.cmo Preproc.cmo E_ParserMain.cmo
ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c ProcMain.ml
ocamlfind ocamlopt -strict-sequence -w +A-48-4 -c ProcMain.ml
ocamlfind ocamlopt -o ProcMain.opt EvalOpt.cmx Etree.cmx Eparser.cmx Error.cmx Escan.cmx Preproc.cmx ProcMain.cmx

View File

@ -1,3 +1,4 @@
#!/bin/sh #!/bin/sh
\rm -f *.cm* *.o *.byte *.opt \rm -f *.cm* *.o *.byte *.opt
\rm E_Lexer.ml E_Parser.ml E_Parser.mli Preproc.ml