balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

The preprocessor library depends now on the kinds of comments

Browse Source 
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 2020-04-24 20:54:13 +02:00
parent c302a1a9d5
commit ce5464f9af
9 changed files with 212 additions and 250 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
vendors/Preprocessor/E_LexerMain.ml vendored
View File

@ -5,7 +5,7 @@ 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%!" msg
let options = EvalOpt.(read ~lang:`PascaLIGO ~ext:".ligo") let options = EvalOpt.read ".ligo" (* No comments allowed *)
let lex in_chan = let lex in_chan =
let buffer = Lexing.from_channel in_chan in let buffer = Lexing.from_channel in_chan in

2
vendors/Preprocessor/E_ParserMain.ml vendored
View File

@ -5,7 +5,7 @@ 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%!" msg
let options = EvalOpt.(read ~lang:`PascaLIGO ~ext:".ligo") let options = EvalOpt.read ".ligo" (* No comments allowed *)
let parse in_chan = let parse in_chan =
let buffer = Lexing.from_channel in_chan in let buffer = Lexing.from_channel in_chan in

49
vendors/Preprocessor/EvalOpt.ml vendored
View File

@ -2,29 +2,33 @@
(* The type [options] gathers the command-line options. *) (* 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) 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 = < type options = <
input : string option; input : string option;
libs : string list; libs : string list;
verbose : SSet.t; verbose : SSet.t;
offsets : bool; offsets : bool;
lang : language; block : block_comment option;
ext : string (* ".ligo", ".mligo", ".religo" *) 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 object
method input = input method input = input
method libs = libs method libs = libs
method lang = lang method block = block
method line = line
method offsets = offsets method offsets = offsets
method verbose = verbose method verbose = verbose
method ext = ext method ext = ext
@ -47,10 +51,10 @@ let abort msg =
(* Help *) (* Help *)
let help lang ext () = let help ext () =
let file = Filename.basename Sys.argv.(0) in let file = Filename.basename Sys.argv.(0) in
printf "Usage: %s [<option> ...] [<input>%s | \"-\"]\n" file ext; 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 "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";
@ -74,11 +78,10 @@ let add_verbose d =
verbose := List.fold_left (fun x y -> SSet.add y x) verbose := List.fold_left (fun x y -> SSet.add y x)
!verbose !verbose
(split_at_colon d) (split_at_colon d)
let specs lang ext = let specs ext =
let lang_str = lang_to_string lang in let open! Getopt in [
let open!Getopt in [
'I', nolong, None, Some add_path; '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, "columns", set columns true, None;
noshort, "verbose", None, Some add_verbose noshort, "verbose", None, Some add_verbose
] ]
@ -92,7 +95,7 @@ let anonymous arg =
(* Checking options and exporting them as non-mutable values *) (* Checking options and exporting them as non-mutable values *)
let check lang ext = let check ?block ?line ~ext =
let libs = !libs let libs = !libs
and offsets = not !columns and offsets = not !columns
@ -109,16 +112,18 @@ let check lang ext =
else abort "Source file not found." else abort "Source file not found."
else abort ("Source file lacks the extension " ^ ext ^ ".") 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 *) (* Parsing the command-line options *)
let read ~lang:(lang : language) ~ext:(ext : string) = type extension = string
let read ?block ?line (ext: extension) =
try try
Getopt.parse_cmdline (specs lang ext) anonymous; Getopt.parse_cmdline (specs ext) anonymous;
(verb_str := (verb_str :=
let apply e a = let apply e a =
if a = "" then e else sprintf "%s, %s" e a if a = "" then e else sprintf "%s, %s" e a
in SSet.fold apply !verbose ""); in SSet.fold apply !verbose "");
check lang ext check ?block ?line ~ext
with Getopt.Error msg -> abort msg with Getopt.Error msg -> abort msg

22
vendors/Preprocessor/EvalOpt.mli vendored
View File

@ -2,25 +2,28 @@
(* The type [options] gathers the command-line options. *) (* 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 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 = < type options = <
input : string option; input : string option;
libs : string list; libs : string list;
verbose : SSet.t; verbose : SSet.t;
offsets : bool; offsets : bool;
lang : language; block : block_comment option;
ext : string (* ".ligo", ".mligo", ".religo" *) line : line_comment option;
ext : string
> >
val make : val make :
input:string option -> input:string option ->
libs:string list -> libs:string list ->
lang:language -> ?block:block_comment ->
?line:line_comment ->
offsets:bool -> offsets:bool ->
verbose:SSet.t -> verbose:SSet.t ->
ext:string -> ext:string ->
@ -30,4 +33,7 @@ val make :
the name of the concrete syntax. This is needed to correctly handle the name of the concrete syntax. This is needed to correctly handle
comments. *) comments. *)
val read : lang:language -> ext:string -> options type extension = string
val read :
?block:block_comment -> ?line:line_comment -> extension -> options

6
vendors/Preprocessor/Preproc.mli vendored
View File

@ -14,8 +14,8 @@ type error =
| Invalid_line_indicator of string | Invalid_line_indicator of string
| No_line_indicator | No_line_indicator
| End_line_indicator | End_line_indicator
| Newline_in_string (* For #include argument only *) | Newline_in_string (* For #include argument only *)
| Open_string (* For #include argument only *) | Unterminated_string (* For #include argument only *)
| Dangling_endif | Dangling_endif
| Open_region_in_conditional | Open_region_in_conditional
| Dangling_endregion | Dangling_endregion
@ -29,10 +29,10 @@ type error =
| Multiply_defined_symbol of string | Multiply_defined_symbol of string
| Error_directive of string | Error_directive of string
| Parse_error | Parse_error
| No_line_comment_or_blank
| Invalid_symbol | Invalid_symbol
| File_not_found of string | File_not_found of string
| Invalid_character of char | Invalid_character of char
| Unterminated_comment 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

348
vendors/Preprocessor/Preproc.mll vendored
View File

@ -44,19 +44,6 @@ type mode = Copy | Skip
type cond = If of mode | Elif of mode | Else | Region type cond = If of mode | Elif of mode | Else | Region
type trace = cond list 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 *) (* Environments *)
module Env = Set.Make (String) module Env = Set.Make (String)
@ -78,8 +65,6 @@ in function
* the field [env] records the symbols defined; * the field [env] records the symbols defined;
* the field [mode] informs whether the preprocessor is in copying or * the field [mode] informs whether the preprocessor is in copying or
skipping mode; 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 * the field [trace] is a stack of previous, still active conditional
directives; directives;
* the field [out] keeps the output buffer; * the field [out] keeps the output buffer;
@ -92,7 +77,6 @@ in function
type state = { type state = {
env : Env.t; env : Env.t;
mode : mode; mode : mode;
offset : offset;
trace : trace; trace : trace;
out : Buffer.t; out : Buffer.t;
incl : in_channel list; incl : in_channel list;
@ -117,7 +101,7 @@ type error =
| No_line_indicator | No_line_indicator
| End_line_indicator | End_line_indicator
| Newline_in_string | Newline_in_string
| Open_string | Unterminated_string
| Dangling_endif | Dangling_endif
| Open_region_in_conditional | Open_region_in_conditional
| Dangling_endregion | Dangling_endregion
@ -131,10 +115,10 @@ type error =
| Multiply_defined_symbol of string | Multiply_defined_symbol of string
| Error_directive of string | Error_directive of string
| Parse_error | Parse_error
| No_line_comment_or_blank
| Invalid_symbol | Invalid_symbol
| File_not_found of string | File_not_found of string
| Invalid_character of char | Invalid_character of char
| Unterminated_comment of string
let error_to_string = function let error_to_string = function
Directive_inside_line -> Directive_inside_line ->
@ -151,7 +135,7 @@ let error_to_string = function
Hint: Try a string, end of line, or a line comment." Hint: Try a string, end of line, or a line comment."
| Newline_in_string -> | Newline_in_string ->
sprintf "Invalid newline character in string." sprintf "Invalid newline character in string."
| Open_string -> | Unterminated_string ->
sprintf "Unterminated string.\n\ sprintf "Unterminated string.\n\
Hint: Close with double quotes." Hint: Close with double quotes."
| Dangling_endif -> | Dangling_endif ->
@ -187,14 +171,15 @@ let error_to_string = function
msg msg
| Parse_error -> | Parse_error ->
"Parse error in expression." "Parse error in expression."
| No_line_comment_or_blank ->
"Line comment or whitespace expected."
| Invalid_symbol -> | Invalid_symbol ->
"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 -> | Invalid_character c ->
E_Lexer.error_to_string (E_Lexer.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 format ?(offsets=true) Region.{region; value} ~file =
let msg = error_to_string value 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 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 -> {state with mode; trace; offset = Prefix 0} | If mode::trace -> {state with mode; trace}
| 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
@ -235,7 +220,7 @@ let reduce_cond state region =
let reduce_region 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 -> {state with trace; offset = Prefix 0} | Region::trace -> {state with trace}
| _ -> 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
@ -286,7 +271,7 @@ let find dir file libs =
let copy state buffer = Buffer.add_string state.out (Lexing.lexeme buffer) 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 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 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 (* Evaluating a preprocessor expression
The evaluation of conditional directives may involve symbols whose The evaluation of conditional directives may involve symbols whose
@ -346,6 +324,35 @@ let letter = small | capital
let ident = letter (letter | '_' | digit)* let ident = letter (letter | '_' | digit)*
let directive = '#' (blank* as space) (small+ as id) 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 *) (* Rules *)
(* The rule [scan] scans the input buffer for directives, strings, (* 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 depending on the compilation directives. If not copied, new line
characters are output. characters are output.
Scanning is triggered by the function call [scan env mode offset Scanning is triggered by the function call [scan env mode trace
trace lexbuf], where [env] is the set of defined symbols lexbuf], where [env] is the set of defined symbols (introduced by
(introduced by `#define'), [mode] specifies whether we are copying `#define'), [mode] specifies whether we are copying or skipping the
or skipping the input, [offset] informs about the location in the input, and [trace] is the stack of conditional directives read so
line (either there is a prefix of blanks, or at least a non-blank far.
character has been read), and [trace] is the stack of conditional
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; trace=[];
0; trace=[]; incl=[]; opt}], meaning that we start with an empty incl=[]; opt}], meaning that we start with an empty environment,
environment, that copying the input is enabled by default, and that that copying the input is enabled by default, and that we are at
we are at the start of a line and no previous conditional the start of a line and no previous conditional directives have
directives have been read yet. The field [opt] is the CLI options. 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
@ -386,12 +391,11 @@ let directive = '#' (blank* as space) (small+ as id)
value of the conditional expression must be ignored (but not its value of the conditional expression must be ignored (but not its
syntax), and we continue skipping the input. syntax), and we continue skipping the input.
When an "#else" is matched, the trace is extended with [Else], When an "#else" is matched, the trace is extended with [Else], then
then, if the directive is not at a wrong offset, the rest of the the rest of the line is scanned with [skip_line]. If we were in
line is scanned with [skip_line]. If we were in copy mode, the new copy mode, the new mode toggles to skipping mode; otherwise, the
mode toggles to skipping mode; otherwise, the trace is searched for trace is searched for the last encountered "#if" of "#elif" and the
the last encountered "#if" of "#elif" and the associated mode is associated mode is restored.
restored.
The case "#elif" is the result of the fusion (in the technical The case "#elif" is the result of the fusion (in the technical
sense) of the code for dealing with an "#else" followed by an sense) of the code for dealing with an "#else" followed by an
@ -465,28 +469,23 @@ 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 { expand_offset state; proc_nl state lexbuf; nl { proc_nl state lexbuf; scan state lexbuf }
scan {state with offset = Prefix 0} lexbuf } | blank { if state.mode = Copy then copy state lexbuf;
| blank { match state.offset with 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 { | directive {
let region = mk_reg lexbuf in
if not (List.mem id directives) if not (List.mem id directives)
then begin then begin
if state.mode = Copy then copy state lexbuf; if state.mode = Copy then copy state lexbuf;
scan state lexbuf scan state lexbuf
end end
else else
if state.offset = Inline if region#start#offset `Byte > 0
then fail Directive_inside_line state lexbuf then fail Directive_inside_line state lexbuf
else else
let region = mk_reg lexbuf in
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)
@ -517,15 +516,15 @@ rule scan state = parse
let mode = expr state lexbuf in let mode = expr state lexbuf in
let mode = if state.mode = Copy then mode else Skip in let mode = if state.mode = Copy then mode else Skip in
let trace = extend (If state.mode) state region 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 in scan state lexbuf
| "else" -> | "else" ->
let () = skip_line state lexbuf in let () = skip_line state lexbuf in
let mode = match state.mode with let mode = match state.mode with
Copy -> Skip Copy -> Skip
| Skip -> last_mode state.trace in | Skip -> last_mode state.trace in
let trace = extend Else state region let trace = extend Else state region
in scan {state with mode; offset = Prefix 0; trace} lexbuf in scan {state with mode; trace} lexbuf
| "elif" -> | "elif" ->
let mode = expr state lexbuf in let mode = expr state lexbuf in
let trace, mode = let trace, mode =
@ -534,7 +533,7 @@ rule scan state = parse
| Skip -> let old_mode = last_mode state.trace | Skip -> let old_mode = last_mode state.trace
in extend (Elif old_mode) state region, in extend (Elif old_mode) state region,
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; trace} lexbuf
| "endif" -> | "endif" ->
skip_line state lexbuf; skip_line state lexbuf;
scan (reduce_cond state region) lexbuf scan (reduce_cond state region) lexbuf
@ -544,89 +543,81 @@ rule scan state = parse
then stop (Reserved_symbol id) state region; then stop (Reserved_symbol id) state region;
if Env.mem id state.env if Env.mem id state.env
then stop (Multiply_defined_symbol id) state region; then stop (Multiply_defined_symbol id) state region;
let state = {state with env = Env.add id state.env; let state = {state with env = Env.add id state.env}
offset = Prefix 0}
in scan state lexbuf in scan state lexbuf
| "undef" -> | "undef" ->
let id, _ = variable state lexbuf in let id, _ = variable state lexbuf in
let state = {state with env = Env.remove id state.env; let state = {state with env = Env.remove id state.env}
offset = Prefix 0}
in scan state lexbuf in scan state lexbuf
| "error" -> | "error" ->
stop (Error_directive (message [] lexbuf)) state region stop (Error_directive (message [] lexbuf)) state region
| "region" -> | "region" ->
let msg = message [] lexbuf let msg = message [] lexbuf
in expand_offset state; in print state ("#" ^ space ^ "region" ^ msg ^ "\n");
print state ("#" ^ space ^ "region" ^ msg ^ "\n"); let state = {state with trace=Region::state.trace}
let state =
{state with offset = Prefix 0; trace=Region::state.trace}
in scan state lexbuf in scan state lexbuf
| "endregion" -> | "endregion" ->
let msg = message [] lexbuf let msg = message [] lexbuf
in expand_offset state; in print state ("#" ^ space ^ "endregion" ^ msg ^ "\n");
print state ("#" ^ space ^ "endregion" ^ msg ^ "\n");
scan (reduce_region state region) lexbuf 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 | _ -> assert false
} }
| eof { match state.trace with
[] -> expand_offset state; state | eof { if state.trace = [] then state
| _ -> fail Missing_endif state lexbuf } else fail Missing_endif state lexbuf }
| '"' { if state.mode = Copy then | '"' { if state.mode = Copy then
begin begin
expand_offset state;
copy state lexbuf; copy state lexbuf;
in_string (mk_reg lexbuf) state lexbuf scan (in_string (mk_reg lexbuf) state lexbuf) lexbuf
end; end
scan {state with offset=Inline} lexbuf } else scan state lexbuf }
| "//" { if state.mode = Copy then
begin | block_comment_openings {
expand_offset state; let lexeme = Lexing.lexeme lexbuf in
copy state lexbuf; match state.opt#block with
in_line_com state lexbuf Some block when block#opening = lexeme ->
end; if state.mode = Copy then
scan {state with offset=Inline} lexbuf } begin
| "/*" { if state.mode = Copy then copy state lexbuf;
begin let state = in_block block (mk_reg lexbuf) state lexbuf
expand_offset state; in scan state lexbuf
copy state lexbuf; end
if state.opt#lang = `ReasonLIGO then else scan state lexbuf
reasonLIGO_com (mk_reg lexbuf) state lexbuf | Some _ | None ->
end; let n = String.length lexeme in
scan {state with offset=Inline} lexbuf } begin
| "(*" { if state.mode = Copy then rollback lexbuf;
begin assert (n > 0);
expand_offset state; scan (scan_n_char n state lexbuf) lexbuf
copy state lexbuf; end }
if state.opt#lang = `CameLIGO
|| state.opt#lang = `PascaLIGO then | line_comments {
cameLIGO_com (mk_reg lexbuf) state lexbuf let lexeme = Lexing.lexeme lexbuf in
end; match state.opt#line with
scan {state with offset=Inline} lexbuf } Some line when line = lexeme ->
| _ { if state.mode = Copy then if state.mode = Copy then
begin begin
expand_offset state; copy state lexbuf;
copy state lexbuf scan (in_line_com state lexbuf) lexbuf
end; end
scan {state with offset=Inline} lexbuf } 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 }
| _ { 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 *) (* Support for #define and #undef *)
@ -638,47 +629,12 @@ 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 }
(*
(* 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 *) (* 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 } | _ { () }
| _ { fail No_line_comment_or_blank state lexbuf }
| eof { () }
and message acc = parse and message acc = parse
nl { Lexing.new_line lexbuf; nl { Lexing.new_line lexbuf;
@ -689,22 +645,41 @@ and message acc = parse
(* Comments *) (* Comments *)
and in_line_com state = parse and in_line_com state = parse
nl { proc_nl state lexbuf } nl { proc_nl state lexbuf; state }
| eof { () } | eof { state }
| _ { 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 reasonLIGO_com opening state = parse and in_block block opening state = parse
nl { proc_nl state lexbuf; reasonLIGO_com opening state lexbuf } '"' | block_comment_openings {
| "*/" { copy state lexbuf } let lexeme = Lexing.lexeme lexbuf in
| eof { () } if block#opening = lexeme || lexeme = "\""
| _ { copy state lexbuf; reasonLIGO_com opening state lexbuf } 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 | block_comment_closings {
nl { proc_nl state lexbuf; cameLIGO_com opening state lexbuf } let lexeme = Lexing.lexeme lexbuf in
| "*)" { copy state lexbuf } if block#closing = lexeme
| eof { () } then (copy state lexbuf; state)
| _ { copy state lexbuf; cameLIGO_com 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 }
| 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 *) (* Included filename *)
@ -717,15 +692,15 @@ and in_inclusion opening acc len state = parse
in Region.cover opening closing, in Region.cover opening closing,
mk_str len acc } mk_str len acc }
| nl { fail Newline_in_string state lexbuf } | 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 } | _ 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; state }
| eof { () } | eof { state }
| _ { copy state lexbuf; in_string opening state lexbuf } | _ { copy state lexbuf; in_string opening state lexbuf }
and preproc state = parse and preproc state = parse
@ -750,7 +725,6 @@ let lex opt buffer =
let state = { let state = {
env = Env.empty; env = Env.empty;
mode = Copy; mode = Copy;
offset = Prefix 0;
trace = []; trace = [];
out = Buffer.create 80; out = Buffer.create 80;
incl = []; incl = [];

7
vendors/Preprocessor/PreprocMain.ml vendored
View File

@ -4,9 +4,12 @@ module Region = Simple_utils.Region
module Preproc = Preprocessor.Preproc module Preproc = Preprocessor.Preproc
module EvalOpt = Preprocessor.EvalOpt 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 preproc cin =
let buffer = Lexing.from_channel cin in let buffer = Lexing.from_channel cin in

22
vendors/Preprocessor/build.sh vendored
View File

@ -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
View File

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