The preprocessor library depends now on the kinds of comments
instead of a closed set of languages. I also removed the offsets: I simply use the current region to determine whether the preprocessing directie starts at the beginning of a line. I also removed scanning line indicators, to make the lexer simpler.
This commit is contained in:
Christian Rinderknecht
parent
c302a1a9d5
commit
ce5464f9af
2
vendors/Preprocessor/E_LexerMain.ml
vendored
2
vendors/Preprocessor/E_LexerMain.ml
vendored
@ -5,7 +5,7 @@ module Region = Simple_utils.Region
|
||||
|
||||
let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg
|
||||
|
||||
let options = EvalOpt.(read ~lang:`PascaLIGO ~ext:".ligo")
|
||||
let options = EvalOpt.read ".ligo" (* No comments allowed *)
|
||||
|
||||
let lex in_chan =
|
||||
let buffer = Lexing.from_channel in_chan in
|
||||
|
||||
2
vendors/Preprocessor/E_ParserMain.ml
vendored
2
vendors/Preprocessor/E_ParserMain.ml
vendored
@ -5,7 +5,7 @@ module Region = Simple_utils.Region
|
||||
|
||||
let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg
|
||||
|
||||
let options = EvalOpt.(read ~lang:`PascaLIGO ~ext:".ligo")
|
||||
let options = EvalOpt.read ".ligo" (* No comments allowed *)
|
||||
|
||||
let parse in_chan =
|
||||
let buffer = Lexing.from_channel in_chan in
|
||||
|
||||
47
vendors/Preprocessor/EvalOpt.ml
vendored
47
vendors/Preprocessor/EvalOpt.ml
vendored
@ -2,29 +2,33 @@
|
||||
|
||||
(* The type [options] gathers the command-line options. *)
|
||||
|
||||
type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
|
||||
|
||||
let lang_to_string = function
|
||||
`PascaLIGO -> "PascaLIGO"
|
||||
| `CameLIGO -> "CameLIGO"
|
||||
| `ReasonLIGO -> "ReasonLIGO"
|
||||
|
||||
module SSet = Set.Make (String)
|
||||
|
||||
type line_comment = string (* Opening of a line comment *)
|
||||
type block_comment = <opening : string; closing : string>
|
||||
|
||||
let mk_block ~opening ~closing : block_comment =
|
||||
object
|
||||
method opening = opening
|
||||
method closing = closing
|
||||
end
|
||||
|
||||
type options = <
|
||||
input : string option;
|
||||
libs : string list;
|
||||
verbose : SSet.t;
|
||||
offsets : bool;
|
||||
lang : language;
|
||||
ext : string (* ".ligo", ".mligo", ".religo" *)
|
||||
block : block_comment option;
|
||||
line : line_comment option;
|
||||
ext : string
|
||||
>
|
||||
|
||||
let make ~input ~libs ~lang ~offsets ~verbose ~ext : options =
|
||||
let make ~input ~libs ?block ?line ~offsets ~verbose ~ext : options =
|
||||
object
|
||||
method input = input
|
||||
method libs = libs
|
||||
method lang = lang
|
||||
method block = block
|
||||
method line = line
|
||||
method offsets = offsets
|
||||
method verbose = verbose
|
||||
method ext = ext
|
||||
@ -47,10 +51,10 @@ let abort msg =
|
||||
|
||||
(* Help *)
|
||||
|
||||
let help lang ext () =
|
||||
let help ext () =
|
||||
let file = Filename.basename Sys.argv.(0) in
|
||||
printf "Usage: %s [<option> ...] [<input>%s | \"-\"]\n" file ext;
|
||||
printf "where <input>%s is the %s source file (default: stdin),\n" ext lang;
|
||||
printf "where <input>%s is the LIGO source file (default: stdin),\n" ext;
|
||||
print "and each <option> (if any) is one of the following:";
|
||||
print " -I <paths> Inclusion paths (colon-separated)";
|
||||
print " --columns Columns for source locations";
|
||||
@ -74,11 +78,10 @@ let add_verbose d =
|
||||
verbose := List.fold_left (fun x y -> SSet.add y x)
|
||||
!verbose
|
||||
(split_at_colon d)
|
||||
let specs lang ext =
|
||||
let lang_str = lang_to_string lang in
|
||||
let specs ext =
|
||||
let open! Getopt in [
|
||||
'I', nolong, None, Some add_path;
|
||||
'h', "help", Some (help lang_str ext), None;
|
||||
'h', "help", Some (help ext), None;
|
||||
noshort, "columns", set columns true, None;
|
||||
noshort, "verbose", None, Some add_verbose
|
||||
]
|
||||
@ -92,7 +95,7 @@ let anonymous arg =
|
||||
|
||||
(* Checking options and exporting them as non-mutable values *)
|
||||
|
||||
let check lang ext =
|
||||
let check ?block ?line ~ext =
|
||||
let libs = !libs
|
||||
|
||||
and offsets = not !columns
|
||||
@ -109,16 +112,18 @@ let check lang ext =
|
||||
else abort "Source file not found."
|
||||
else abort ("Source file lacks the extension " ^ ext ^ ".")
|
||||
|
||||
in make ~input ~libs ~lang ~offsets ~verbose ~ext
|
||||
in make ~input ~libs ?block ?line ~offsets ~verbose ~ext
|
||||
|
||||
(* Parsing the command-line options *)
|
||||
|
||||
let read ~lang:(lang : language) ~ext:(ext : string) =
|
||||
type extension = string
|
||||
|
||||
let read ?block ?line (ext: extension) =
|
||||
try
|
||||
Getopt.parse_cmdline (specs lang ext) anonymous;
|
||||
Getopt.parse_cmdline (specs ext) anonymous;
|
||||
(verb_str :=
|
||||
let apply e a =
|
||||
if a = "" then e else sprintf "%s, %s" e a
|
||||
in SSet.fold apply !verbose "");
|
||||
check lang ext
|
||||
check ?block ?line ~ext
|
||||
with Getopt.Error msg -> abort msg
|
||||
|
||||
22
vendors/Preprocessor/EvalOpt.mli
vendored
22
vendors/Preprocessor/EvalOpt.mli
vendored
@ -2,25 +2,28 @@
|
||||
|
||||
(* The type [options] gathers the command-line options. *)
|
||||
|
||||
type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
|
||||
|
||||
val lang_to_string : language -> string
|
||||
|
||||
module SSet : Set.S with type elt = string and type t = Set.Make(String).t
|
||||
|
||||
type line_comment = string (* Opening of a line comment *)
|
||||
type block_comment = <opening : string; closing : string>
|
||||
|
||||
val mk_block : opening:string -> closing:string -> block_comment
|
||||
|
||||
type options = <
|
||||
input : string option;
|
||||
libs : string list;
|
||||
verbose : SSet.t;
|
||||
offsets : bool;
|
||||
lang : language;
|
||||
ext : string (* ".ligo", ".mligo", ".religo" *)
|
||||
block : block_comment option;
|
||||
line : line_comment option;
|
||||
ext : string
|
||||
>
|
||||
|
||||
val make :
|
||||
input:string option ->
|
||||
libs:string list ->
|
||||
lang:language ->
|
||||
?block:block_comment ->
|
||||
?line:line_comment ->
|
||||
offsets:bool ->
|
||||
verbose:SSet.t ->
|
||||
ext:string ->
|
||||
@ -30,4 +33,7 @@ val make :
|
||||
the name of the concrete syntax. This is needed to correctly handle
|
||||
comments. *)
|
||||
|
||||
val read : lang:language -> ext:string -> options
|
||||
type extension = string
|
||||
|
||||
val read :
|
||||
?block:block_comment -> ?line:line_comment -> extension -> options
|
||||
|
||||
4
vendors/Preprocessor/Preproc.mli
vendored
4
vendors/Preprocessor/Preproc.mli
vendored
@ -15,7 +15,7 @@ type error =
|
||||
| No_line_indicator
|
||||
| End_line_indicator
|
||||
| Newline_in_string (* For #include argument only *)
|
||||
| Open_string (* For #include argument only *)
|
||||
| Unterminated_string (* For #include argument only *)
|
||||
| Dangling_endif
|
||||
| Open_region_in_conditional
|
||||
| Dangling_endregion
|
||||
@ -29,10 +29,10 @@ type error =
|
||||
| Multiply_defined_symbol of string
|
||||
| Error_directive of string
|
||||
| Parse_error
|
||||
| No_line_comment_or_blank
|
||||
| Invalid_symbol
|
||||
| File_not_found of string
|
||||
| Invalid_character of char
|
||||
| Unterminated_comment of string
|
||||
|
||||
val format :
|
||||
?offsets:bool -> error Region.reg -> file:bool -> string Region.reg
|
||||
|
||||
322
vendors/Preprocessor/Preproc.mll
vendored
322
vendors/Preprocessor/Preproc.mll
vendored
@ -44,19 +44,6 @@ type mode = Copy | Skip
|
||||
type cond = If of mode | Elif of mode | Else | Region
|
||||
type trace = cond list
|
||||
|
||||
(* Line offsets
|
||||
|
||||
The value [Inline] of type [offset] means that the current location
|
||||
cannot be reached from the start of the line with only white
|
||||
space. The same holds for the special value [Prefix 0]. Values of
|
||||
the form [Prefix n] mean that the current location can be reached
|
||||
from the start of the line with [n] white spaces (padding). These
|
||||
distinctions are needed because preprocessor directives cannot
|
||||
occur inside lines.
|
||||
*)
|
||||
|
||||
type offset = Prefix of int | Inline
|
||||
|
||||
(* Environments *)
|
||||
|
||||
module Env = Set.Make (String)
|
||||
@ -78,8 +65,6 @@ in function
|
||||
* 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;
|
||||
@ -92,7 +77,6 @@ in function
|
||||
type state = {
|
||||
env : Env.t;
|
||||
mode : mode;
|
||||
offset : offset;
|
||||
trace : trace;
|
||||
out : Buffer.t;
|
||||
incl : in_channel list;
|
||||
@ -117,7 +101,7 @@ type error =
|
||||
| No_line_indicator
|
||||
| End_line_indicator
|
||||
| Newline_in_string
|
||||
| Open_string
|
||||
| Unterminated_string
|
||||
| Dangling_endif
|
||||
| Open_region_in_conditional
|
||||
| Dangling_endregion
|
||||
@ -131,10 +115,10 @@ type error =
|
||||
| Multiply_defined_symbol of string
|
||||
| Error_directive of string
|
||||
| Parse_error
|
||||
| No_line_comment_or_blank
|
||||
| Invalid_symbol
|
||||
| File_not_found of string
|
||||
| Invalid_character of char
|
||||
| Unterminated_comment of string
|
||||
|
||||
let error_to_string = function
|
||||
Directive_inside_line ->
|
||||
@ -151,7 +135,7 @@ let error_to_string = function
|
||||
Hint: Try a string, end of line, or a line comment."
|
||||
| Newline_in_string ->
|
||||
sprintf "Invalid newline character in string."
|
||||
| Open_string ->
|
||||
| Unterminated_string ->
|
||||
sprintf "Unterminated string.\n\
|
||||
Hint: Close with double quotes."
|
||||
| Dangling_endif ->
|
||||
@ -187,14 +171,15 @@ let error_to_string = function
|
||||
msg
|
||||
| Parse_error ->
|
||||
"Parse error in expression."
|
||||
| No_line_comment_or_blank ->
|
||||
"Line comment or whitespace expected."
|
||||
| Invalid_symbol ->
|
||||
"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)
|
||||
| Unterminated_comment ending ->
|
||||
sprintf "Unterminated comment.\n\
|
||||
Hint: Close with \"%s\"." ending
|
||||
|
||||
let format ?(offsets=true) Region.{region; value} ~file =
|
||||
let msg = error_to_string value
|
||||
@ -224,7 +209,7 @@ let fail error state buffer = stop error state (mk_reg buffer)
|
||||
let reduce_cond state region =
|
||||
let rec reduce = function
|
||||
[] -> stop Dangling_endif state region
|
||||
| If mode::trace -> {state with mode; trace; offset = Prefix 0}
|
||||
| If mode::trace -> {state with mode; trace}
|
||||
| Region::_ -> stop Open_region_in_conditional state region
|
||||
| _::trace -> reduce trace
|
||||
in reduce state.trace
|
||||
@ -235,7 +220,7 @@ let reduce_cond state region =
|
||||
let reduce_region state region =
|
||||
match state.trace with
|
||||
[] -> stop Dangling_endregion state region
|
||||
| Region::trace -> {state with trace; offset = Prefix 0}
|
||||
| Region::trace -> {state with trace}
|
||||
| _ -> stop Conditional_in_region state region
|
||||
|
||||
(* The function [extend] is called when encountering conditional
|
||||
@ -286,7 +271,7 @@ let find dir file libs =
|
||||
|
||||
let copy state buffer = Buffer.add_string state.out (Lexing.lexeme buffer)
|
||||
|
||||
(* End of lines *)
|
||||
(* End of lines are always copied *)
|
||||
|
||||
let proc_nl state buffer = Lexing.new_line buffer; copy state buffer
|
||||
|
||||
@ -294,13 +279,6 @@ let proc_nl state buffer = Lexing.new_line buffer; copy state buffer
|
||||
|
||||
let print state string = Buffer.add_string state.out string
|
||||
|
||||
(* Expanding the offset into whitespace *)
|
||||
|
||||
let expand_offset state =
|
||||
match state.offset with
|
||||
Prefix 0 | Inline -> ()
|
||||
| Prefix n -> print state (String.make n ' ')
|
||||
|
||||
(* Evaluating a preprocessor expression
|
||||
|
||||
The evaluation of conditional directives may involve symbols whose
|
||||
@ -346,6 +324,35 @@ let letter = small | capital
|
||||
let ident = letter (letter | '_' | digit)*
|
||||
let directive = '#' (blank* as space) (small+ as id)
|
||||
|
||||
(* Comments *)
|
||||
|
||||
let pascaligo_block_comment_opening = "(*"
|
||||
let pascaligo_block_comment_closing = "*)"
|
||||
let pascaligo_line_comment = "//"
|
||||
|
||||
let cameligo_block_comment_opening = "(*"
|
||||
let cameligo_block_comment_closing = "*)"
|
||||
let cameligo_line_comment = "//"
|
||||
|
||||
let reasonligo_block_comment_opening = "/*"
|
||||
let reasonligo_block_comment_closing = "*/"
|
||||
let reasonligo_line_comment = "//"
|
||||
|
||||
let block_comment_openings =
|
||||
pascaligo_block_comment_opening
|
||||
| cameligo_block_comment_opening
|
||||
| reasonligo_block_comment_opening
|
||||
|
||||
let block_comment_closings =
|
||||
pascaligo_block_comment_closing
|
||||
| cameligo_block_comment_closing
|
||||
| reasonligo_block_comment_closing
|
||||
|
||||
let line_comments =
|
||||
pascaligo_line_comment
|
||||
| cameligo_line_comment
|
||||
| reasonligo_line_comment
|
||||
|
||||
(* Rules *)
|
||||
|
||||
(* The rule [scan] scans the input buffer for directives, strings,
|
||||
@ -354,19 +361,17 @@ let directive = '#' (blank* as space) (small+ as id)
|
||||
depending on the compilation directives. If not copied, new line
|
||||
characters are output.
|
||||
|
||||
Scanning is triggered by the function call [scan env mode offset
|
||||
trace lexbuf], where [env] is the set of defined symbols
|
||||
(introduced by `#define'), [mode] specifies whether we are copying
|
||||
or skipping the input, [offset] informs about the location in the
|
||||
line (either there is a prefix of blanks, or at least a non-blank
|
||||
character has been read), and [trace] is the stack of conditional
|
||||
directives read so far.
|
||||
Scanning is triggered by the function call [scan env mode trace
|
||||
lexbuf], where [env] is the set of defined symbols (introduced by
|
||||
`#define'), [mode] specifies whether we are copying or skipping the
|
||||
input, and [trace] is the stack of conditional directives read so
|
||||
far.
|
||||
|
||||
The first call is [scan {env=Env.empty; mode=Copy; offset = Prefix
|
||||
0; trace=[]; incl=[]; opt}], meaning that we start with an empty
|
||||
environment, that copying the input is enabled by default, and that
|
||||
we are at the start of a line and no previous conditional
|
||||
directives have been read yet. The field [opt] is the CLI options.
|
||||
The first call is [scan {env=Env.empty; mode=Copy; trace=[];
|
||||
incl=[]; opt}], meaning that we start with an empty environment,
|
||||
that copying the input is enabled by default, and that we are at
|
||||
the start of a line and no previous conditional 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
|
||||
lexbuf (If mode) trace], during the evaluation of which the
|
||||
@ -386,12 +391,11 @@ let directive = '#' (blank* as space) (small+ as id)
|
||||
value of the conditional expression must be ignored (but not its
|
||||
syntax), and we continue skipping the input.
|
||||
|
||||
When an "#else" is matched, the trace is extended with [Else],
|
||||
then, if the directive is not at a wrong offset, the rest of the
|
||||
line is scanned with [skip_line]. If we were in copy mode, the new
|
||||
mode toggles to skipping mode; otherwise, the trace is searched for
|
||||
the last encountered "#if" of "#elif" and the associated mode is
|
||||
restored.
|
||||
When an "#else" is matched, the trace is extended with [Else], then
|
||||
the rest of the line is scanned with [skip_line]. If we were in
|
||||
copy mode, the new mode toggles to skipping mode; otherwise, the
|
||||
trace is searched for the last encountered "#if" of "#elif" and the
|
||||
associated mode is restored.
|
||||
|
||||
The case "#elif" is the result of the fusion (in the technical
|
||||
sense) of the code for dealing with an "#else" followed by an
|
||||
@ -468,25 +472,20 @@ let directive = '#' (blank* as space) (small+ as id)
|
||||
*)
|
||||
|
||||
rule scan state = parse
|
||||
nl { expand_offset state; 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 ->
|
||||
if state.mode = Copy then copy state lexbuf;
|
||||
nl { proc_nl state lexbuf; scan state lexbuf }
|
||||
| blank { if state.mode = Copy then copy state lexbuf;
|
||||
scan state lexbuf }
|
||||
| directive {
|
||||
let region = mk_reg lexbuf in
|
||||
if not (List.mem id directives)
|
||||
then begin
|
||||
if state.mode = Copy then copy state lexbuf;
|
||||
scan state lexbuf
|
||||
end
|
||||
else
|
||||
if state.offset = Inline
|
||||
if region#start#offset `Byte > 0
|
||||
then fail Directive_inside_line state lexbuf
|
||||
else
|
||||
let region = mk_reg lexbuf in
|
||||
match id with
|
||||
"include" ->
|
||||
let line = Lexing.(lexbuf.lex_curr_p.pos_lnum)
|
||||
@ -517,7 +516,7 @@ rule scan state = parse
|
||||
let mode = expr state lexbuf in
|
||||
let mode = if state.mode = Copy then mode else Skip in
|
||||
let trace = extend (If state.mode) state region in
|
||||
let state = {state with mode; offset = Prefix 0; trace}
|
||||
let state = {state with mode; trace}
|
||||
in scan state lexbuf
|
||||
| "else" ->
|
||||
let () = skip_line state lexbuf in
|
||||
@ -525,7 +524,7 @@ rule scan state = parse
|
||||
Copy -> Skip
|
||||
| Skip -> last_mode state.trace in
|
||||
let trace = extend Else state region
|
||||
in scan {state with mode; offset = Prefix 0; trace} lexbuf
|
||||
in scan {state with mode; trace} lexbuf
|
||||
| "elif" ->
|
||||
let mode = expr state lexbuf in
|
||||
let trace, mode =
|
||||
@ -534,7 +533,7 @@ rule scan state = parse
|
||||
| Skip -> let old_mode = last_mode state.trace
|
||||
in extend (Elif old_mode) state region,
|
||||
if old_mode = Copy then mode else Skip
|
||||
in scan {state with mode; offset = Prefix 0; trace} lexbuf
|
||||
in scan {state with mode; trace} lexbuf
|
||||
| "endif" ->
|
||||
skip_line state lexbuf;
|
||||
scan (reduce_cond state region) lexbuf
|
||||
@ -544,89 +543,81 @@ rule scan state = parse
|
||||
then stop (Reserved_symbol id) state region;
|
||||
if Env.mem id state.env
|
||||
then stop (Multiply_defined_symbol id) state region;
|
||||
let state = {state with env = Env.add id state.env;
|
||||
offset = Prefix 0}
|
||||
let state = {state with env = Env.add id state.env}
|
||||
in scan state lexbuf
|
||||
| "undef" ->
|
||||
let id, _ = variable state lexbuf in
|
||||
let state = {state with env = Env.remove id state.env;
|
||||
offset = Prefix 0}
|
||||
let state = {state with env = Env.remove id state.env}
|
||||
in scan state lexbuf
|
||||
| "error" ->
|
||||
stop (Error_directive (message [] lexbuf)) state region
|
||||
| "region" ->
|
||||
let msg = message [] lexbuf
|
||||
in expand_offset state;
|
||||
print state ("#" ^ space ^ "region" ^ msg ^ "\n");
|
||||
let state =
|
||||
{state with offset = Prefix 0; trace=Region::state.trace}
|
||||
in print state ("#" ^ space ^ "region" ^ msg ^ "\n");
|
||||
let state = {state with trace=Region::state.trace}
|
||||
in scan state lexbuf
|
||||
| "endregion" ->
|
||||
let msg = message [] lexbuf
|
||||
in expand_offset state;
|
||||
print state ("#" ^ space ^ "endregion" ^ msg ^ "\n");
|
||||
in print state ("#" ^ space ^ "endregion" ^ msg ^ "\n");
|
||||
scan (reduce_region state region) lexbuf
|
||||
(*
|
||||
| "line" ->
|
||||
expand_offset state;
|
||||
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
|
||||
[] -> expand_offset state; state
|
||||
| _ -> fail Missing_endif state lexbuf }
|
||||
|
||||
| eof { if state.trace = [] then state
|
||||
else fail Missing_endif state lexbuf }
|
||||
|
||||
| '"' { if state.mode = Copy then
|
||||
begin
|
||||
expand_offset state;
|
||||
copy state lexbuf;
|
||||
in_string (mk_reg lexbuf) state lexbuf
|
||||
end;
|
||||
scan {state with offset=Inline} lexbuf }
|
||||
| "//" { if state.mode = Copy then
|
||||
scan (in_string (mk_reg lexbuf) state lexbuf) lexbuf
|
||||
end
|
||||
else scan state lexbuf }
|
||||
|
||||
| block_comment_openings {
|
||||
let lexeme = Lexing.lexeme lexbuf in
|
||||
match state.opt#block with
|
||||
Some block when block#opening = lexeme ->
|
||||
if state.mode = Copy then
|
||||
begin
|
||||
expand_offset state;
|
||||
copy state lexbuf;
|
||||
in_line_com state lexbuf
|
||||
end;
|
||||
scan {state with offset=Inline} lexbuf }
|
||||
| "/*" { if state.mode = Copy then
|
||||
let state = in_block block (mk_reg lexbuf) state lexbuf
|
||||
in scan state lexbuf
|
||||
end
|
||||
else scan state lexbuf
|
||||
| Some _ | None ->
|
||||
let n = String.length lexeme in
|
||||
begin
|
||||
rollback lexbuf;
|
||||
assert (n > 0);
|
||||
scan (scan_n_char n state lexbuf) lexbuf
|
||||
end }
|
||||
|
||||
| line_comments {
|
||||
let lexeme = Lexing.lexeme lexbuf in
|
||||
match state.opt#line with
|
||||
Some line when line = lexeme ->
|
||||
if state.mode = Copy then
|
||||
begin
|
||||
expand_offset state;
|
||||
copy state lexbuf;
|
||||
if state.opt#lang = `ReasonLIGO then
|
||||
reasonLIGO_com (mk_reg lexbuf) state lexbuf
|
||||
end;
|
||||
scan {state with offset=Inline} lexbuf }
|
||||
| "(*" { if state.mode = Copy then
|
||||
scan (in_line_com state lexbuf) lexbuf
|
||||
end
|
||||
else scan state lexbuf
|
||||
| Some _ | None ->
|
||||
let n = String.length lexeme in
|
||||
begin
|
||||
expand_offset state;
|
||||
copy state lexbuf;
|
||||
if state.opt#lang = `CameLIGO
|
||||
|| state.opt#lang = `PascaLIGO then
|
||||
cameLIGO_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
|
||||
end;
|
||||
scan {state with offset=Inline} lexbuf }
|
||||
rollback lexbuf;
|
||||
assert (n > 0);
|
||||
scan (scan_n_char n state lexbuf) lexbuf
|
||||
end }
|
||||
|
||||
| _ { if state.mode = Copy then copy state lexbuf;
|
||||
scan state lexbuf }
|
||||
|
||||
(* Scanning a series of characters *)
|
||||
|
||||
and scan_n_char n state = parse
|
||||
_ { if state.mode = Copy then copy state lexbuf;
|
||||
if n = 1 then state else scan_n_char (n-1) state lexbuf }
|
||||
|
||||
(* Support for #define and #undef *)
|
||||
|
||||
@ -638,47 +629,12 @@ and symbol state = parse
|
||||
ident as id { id, mk_reg lexbuf }
|
||||
| _ { fail Invalid_symbol state lexbuf }
|
||||
|
||||
(*
|
||||
(* Line indicator (#line) *)
|
||||
|
||||
and line_ind state = parse
|
||||
blank* { copy state lexbuf; line_indicator state lexbuf }
|
||||
|
||||
and line_indicator state = parse
|
||||
natural { copy state lexbuf; end_indicator state lexbuf }
|
||||
| ident as id {
|
||||
match id with
|
||||
"default" | "hidden" ->
|
||||
print state (id ^ message [] lexbuf)
|
||||
| _ -> fail (Invalid_line_indicator id) state lexbuf }
|
||||
| _ { fail No_line_indicator state lexbuf }
|
||||
|
||||
and end_indicator state = parse
|
||||
blank+ { copy state lexbuf; end_indicator state lexbuf }
|
||||
| nl { proc_nl state lexbuf }
|
||||
| eof { copy state lexbuf }
|
||||
| "//" { copy state lexbuf;
|
||||
print state (message [] lexbuf ^ "\n") }
|
||||
| '"' { copy state lexbuf;
|
||||
in_string (mk_reg lexbuf) state lexbuf;
|
||||
opt_line_com state lexbuf }
|
||||
| _ { fail End_line_indicator state lexbuf }
|
||||
|
||||
and opt_line_com state = parse
|
||||
nl { proc_nl state lexbuf }
|
||||
| eof { copy state lexbuf }
|
||||
| blank+ { copy state lexbuf; opt_line_com state lexbuf }
|
||||
| "//" { print state ("//" ^ message [] lexbuf) }
|
||||
*)
|
||||
|
||||
(* New lines and verbatim sequence of characters *)
|
||||
|
||||
and skip_line state = parse
|
||||
nl { proc_nl state lexbuf }
|
||||
| blank+ { skip_line state lexbuf }
|
||||
| "//" { in_line_com {state with mode=Skip} lexbuf }
|
||||
| _ { fail No_line_comment_or_blank state lexbuf }
|
||||
| eof { () }
|
||||
| _ { () }
|
||||
|
||||
and message acc = parse
|
||||
nl { Lexing.new_line lexbuf;
|
||||
@ -689,22 +645,41 @@ and message acc = parse
|
||||
(* Comments *)
|
||||
|
||||
and in_line_com state = parse
|
||||
nl { proc_nl state lexbuf }
|
||||
| eof { () }
|
||||
nl { proc_nl state lexbuf; state }
|
||||
| eof { state }
|
||||
| _ { if state.mode = Copy then copy state lexbuf;
|
||||
in_line_com state lexbuf }
|
||||
|
||||
and reasonLIGO_com opening state = parse
|
||||
nl { proc_nl state lexbuf; reasonLIGO_com opening state lexbuf }
|
||||
| "*/" { copy state lexbuf }
|
||||
| eof { () }
|
||||
| _ { copy state lexbuf; reasonLIGO_com opening state lexbuf }
|
||||
and in_block block opening state = parse
|
||||
'"' | block_comment_openings {
|
||||
let lexeme = Lexing.lexeme lexbuf in
|
||||
if block#opening = lexeme || lexeme = "\""
|
||||
then let () = copy state lexbuf in
|
||||
let opening' = mk_reg lexbuf in
|
||||
let next = if lexeme = "\"" then in_string
|
||||
else in_block block in
|
||||
let state = next opening' state lexbuf
|
||||
in in_block block opening state lexbuf
|
||||
else let () = rollback lexbuf in
|
||||
let n = String.length lexeme in
|
||||
let () = assert (n > 0) in
|
||||
let state = scan_n_char n state lexbuf
|
||||
in in_block block opening state lexbuf }
|
||||
|
||||
and cameLIGO_com opening state = parse
|
||||
nl { proc_nl state lexbuf; cameLIGO_com opening state lexbuf }
|
||||
| "*)" { copy state lexbuf }
|
||||
| eof { () }
|
||||
| _ { copy state lexbuf; cameLIGO_com opening state lexbuf }
|
||||
| block_comment_closings {
|
||||
let lexeme = Lexing.lexeme lexbuf in
|
||||
if block#closing = lexeme
|
||||
then (copy state lexbuf; state)
|
||||
else let () = rollback lexbuf in
|
||||
let n = String.length lexeme in
|
||||
let () = assert (n > 0) in
|
||||
let state = scan_n_char n state lexbuf
|
||||
in in_block block opening state lexbuf }
|
||||
|
||||
| nl { proc_nl state lexbuf; in_block block opening state lexbuf }
|
||||
| eof { let err = Unterminated_comment (block#closing)
|
||||
in stop err state opening }
|
||||
| _ { copy state lexbuf; in_block block opening state lexbuf }
|
||||
|
||||
(* Included filename *)
|
||||
|
||||
@ -717,15 +692,15 @@ and in_inclusion opening acc len state = parse
|
||||
in Region.cover opening closing,
|
||||
mk_str len acc }
|
||||
| nl { fail Newline_in_string state lexbuf }
|
||||
| eof { stop Open_string state opening }
|
||||
| eof { stop Unterminated_string state opening }
|
||||
| _ as c { in_inclusion opening (c::acc) (len+1) state lexbuf }
|
||||
|
||||
(* Strings *)
|
||||
|
||||
and in_string opening state = parse
|
||||
"\\\"" { copy state lexbuf; in_string opening state lexbuf }
|
||||
| '"' { copy state lexbuf }
|
||||
| eof { () }
|
||||
| '"' { copy state lexbuf; state }
|
||||
| eof { state }
|
||||
| _ { copy state lexbuf; in_string opening state lexbuf }
|
||||
|
||||
and preproc state = parse
|
||||
@ -750,7 +725,6 @@ let lex opt buffer =
|
||||
let state = {
|
||||
env = Env.empty;
|
||||
mode = Copy;
|
||||
offset = Prefix 0;
|
||||
trace = [];
|
||||
out = Buffer.create 80;
|
||||
incl = [];
|
||||
|
||||
7
vendors/Preprocessor/PreprocMain.ml
vendored
7
vendors/Preprocessor/PreprocMain.ml
vendored
@ -4,9 +4,12 @@ module Region = Simple_utils.Region
|
||||
module Preproc = Preprocessor.Preproc
|
||||
module EvalOpt = Preprocessor.EvalOpt
|
||||
|
||||
let highlight msg = Printf.eprintf "\027[31m%s\027[0m\n%!" msg
|
||||
let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg
|
||||
|
||||
let options = EvalOpt.(read ~lang:`PascaLIGO ~ext:".ligo")
|
||||
let options =
|
||||
let open EvalOpt in
|
||||
let block = mk_block ~opening:"(*" ~closing:"*)"
|
||||
in read ~block ~line:"//" ".ligo"
|
||||
|
||||
let preproc cin =
|
||||
let buffer = Lexing.from_channel cin in
|
||||
|
||||
22
vendors/Preprocessor/build.sh
vendored
22
vendors/Preprocessor/build.sh
vendored
@ -1,22 +0,0 @@
|
||||
#!/bin/sh
|
||||
set -x
|
||||
ocamllex.opt E_Lexer.mll
|
||||
ocamllex.opt Preproc.mll
|
||||
menhir -la 1 E_Parser.mly
|
||||
ocamlfind ocamlc -strict-sequence -w +A-48-4 -c EvalOpt.mli
|
||||
ocamlfind ocamlc -strict-sequence -w +A-48-4 -c E_AST.ml
|
||||
ocamlfind ocamlc -strict-sequence -w +A-48-4 -c E_Parser.mli
|
||||
ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c E_Lexer.mli
|
||||
ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c E_LexerMain.ml
|
||||
camlcmd="ocamlfind ocamlc -I _x86_64 -strict-sequence -w +A-48-4 "
|
||||
ocamlfind ocamlc -strict-sequence -w +A-48-4 -package getopt,str -c EvalOpt.ml
|
||||
ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c E_Lexer.ml
|
||||
menhir --infer --ocamlc="$camlcmd" E_Parser.mly
|
||||
ocamlfind ocamlc -strict-sequence -w +A-48-4 -c E_Parser.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 ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c Preproc.mli
|
||||
ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c PreprocMain.ml
|
||||
ocamlfind ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c Preproc.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 ocamlc -strict-sequence -w +A-48-4 -package simple-utils -c E_ParserMain.ml
|
||||
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
|
||||
4
vendors/Preprocessor/clean.sh
vendored
4
vendors/Preprocessor/clean.sh
vendored
@ -1,4 +0,0 @@
|
||||
#!/bin/sh
|
||||
|
||||
\rm -f *.cm* *.o *.byte *.opt
|
||||
\rm E_Lexer.ml E_Parser.ml E_Parser.mli Preproc.ml
|
||||
Loading…
Reference in New Issue
Block a user