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

Integrated the library for preprocessing.

Browse Source 
The build with Makefile works. Dune build to be tested.
This commit is contained in:
Christian Rinderknecht 2020-03-31 19:44:10 +02:00
parent ebff258882
commit 968e73b342
50 changed files with 366 additions and 282 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/passes/1-parser/cameligo/.links
View File

@ -1,8 +1,20 @@
$HOME/git/OCaml-build/Makefile
$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli
$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
$HOME/git/ligo/vendors/Preprocessor/E_AST.ml
$HOME/git/ligo/vendors/Preprocessor/E_Lexer.mll
$HOME/git/ligo/vendors/Preprocessor/EvalOpt.ml
$HOME/git/ligo/vendors/Preprocessor/Preproc.mli
$HOME/git/ligo/vendors/Preprocessor/EvalOpt.mli
$HOME/git/ligo/vendors/Preprocessor/Preproc.mll
$HOME/git/ligo/vendors/Preprocessor/E_Lexer.mli
$HOME/git/ligo/vendors/Preprocessor/E_Parser.mly
$HOME/git/ligo/vendors/Preprocessor/.E_Parser.mly.tag
../shared/Lexer.mli
../shared/Lexer.mll
../shared/EvalOpt.ml
@ -17,7 +29,12 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
../shared/Utils.ml
../shared/ParserAPI.mli
../shared/ParserAPI.ml
../shared/LexerUnit.mli
../shared/LexerUnit.ml
../shared/ParserUnit.mli
../shared/ParserUnit.ml
Stubs/Simple_utils.ml
Stubs/Preprocessor.ml
$HOME/git/ligo/_build/default/src/passes/1-parser/cameligo/ParErr.ml

3
src/passes/1-parser/cameligo/LexerMain.ml
View File

@ -4,8 +4,7 @@ module Region = Simple_utils.Region
module IO =
struct
let ext = ".mligo"
let options = EvalOpt.read "CameLIGO" ext
let options = EvalOpt.(read ~lang:CameLIGO ~ext:".mligo")
end
module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))

5
src/passes/1-parser/cameligo/ParserMain.ml
View File

@ -2,8 +2,7 @@
module IO =
struct
let ext = ".mligo"
let options = EvalOpt.read "CameLIGO" ext
let options = EvalOpt.(read ~lang:CameLIGO ~ext:".mligo")
end
module Parser =
@ -98,7 +97,7 @@ let prefix =
None | Some "-" -> "temp"
| Some file -> Filename.(file |> basename |> remove_extension)
let suffix = ".pp" ^ IO.ext
let suffix = ".pp" ^ IO.options#ext
let pp_input =
if SSet.mem "cpp" IO.options#verbose

1
src/passes/1-parser/cameligo/Stubs/Preprocessor.ml Normal file
View File

@ -0,0 +1 @@
module Preproc = Preproc

17
src/passes/1-parser/pascaligo/.links
View File

@ -1,8 +1,20 @@
$HOME/git/OCaml-build/Makefile
$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli
$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
$HOME/git/ligo/vendors/Preprocessor/E_AST.ml
$HOME/git/ligo/vendors/Preprocessor/E_Lexer.mll
$HOME/git/ligo/vendors/Preprocessor/EvalOpt.ml
$HOME/git/ligo/vendors/Preprocessor/Preproc.mli
$HOME/git/ligo/vendors/Preprocessor/EvalOpt.mli
$HOME/git/ligo/vendors/Preprocessor/Preproc.mll
$HOME/git/ligo/vendors/Preprocessor/E_Lexer.mli
$HOME/git/ligo/vendors/Preprocessor/E_Parser.mly
$HOME/git/ligo/vendors/Preprocessor/.E_Parser.mly.tag
../shared/Lexer.mli
../shared/Lexer.mll
../shared/EvalOpt.ml
@ -21,7 +33,8 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
../shared/LexerUnit.ml
../shared/ParserUnit.mli
../shared/ParserUnit.ml
../shared/Memo.mli
../shared/Memo.ml
Stubs/Simple_utils.ml
Stubs/Preprocessor.ml
$HOME/git/ligo/_build/default/src/passes/1-parser/pascaligo/ParErr.ml

3
src/passes/1-parser/pascaligo/LexerMain.ml
View File

@ -4,8 +4,7 @@ module Region = Simple_utils.Region
module IO =
struct
let ext = ".ligo"
let options = EvalOpt.read "PascaLIGO" ext
let options = EvalOpt.(read ~lang:PascaLIGO ~ext:".ligo")
end
module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))

5
src/passes/1-parser/pascaligo/ParserMain.ml
View File

@ -2,8 +2,7 @@
module IO =
struct
let ext = ".ligo"
let options = EvalOpt.read "PascaLIGO" ext
let options = EvalOpt.(read ~lang:PascaLIGO ~ext:".ligo")
end
module Parser =
@ -110,7 +109,7 @@ let prefix =
None | Some "-" -> "temp"
| Some file -> Filename.(file |> basename |> remove_extension)
let suffix = ".pp" ^ IO.ext
let suffix = ".pp" ^ IO.options#ext
let pp_input =
if SSet.mem "cpp" IO.options#verbose

1
src/passes/1-parser/pascaligo/Stubs/Preprocessor.ml Normal file
View File

@ -0,0 +1 @@
module Preproc = Preproc

2
src/passes/1-parser/pascaligo/dune
View File

@ -20,6 +20,7 @@
menhirLib
parser_shared
hex
Preprocessor
simple-utils)
(preprocess
(pps bisect_ppx --conditional))
@ -170,4 +171,3 @@
)
))
)

18
src/passes/1-parser/reasonligo/.links
View File

@ -1,8 +1,20 @@
$HOME/git/OCaml-build/Makefile
$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli
$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
$HOME/git/ligo/vendors/Preprocessor/E_AST.ml
$HOME/git/ligo/vendors/Preprocessor/E_Lexer.mll
$HOME/git/ligo/vendors/Preprocessor/EvalOpt.ml
$HOME/git/ligo/vendors/Preprocessor/Preproc.mli
$HOME/git/ligo/vendors/Preprocessor/EvalOpt.mli
$HOME/git/ligo/vendors/Preprocessor/Preproc.mll
$HOME/git/ligo/vendors/Preprocessor/E_Lexer.mli
$HOME/git/ligo/vendors/Preprocessor/E_Parser.mly
$HOME/git/ligo/vendors/Preprocessor/.E_Parser.mly.tag
../shared/Lexer.mli
../shared/Lexer.mll
../shared/EvalOpt.ml
@ -17,13 +29,19 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
../shared/Utils.ml
../shared/ParserAPI.mli
../shared/ParserAPI.ml
../shared/LexerUnit.mli
../shared/LexerUnit.ml
../shared/ParserUnit.mli
../shared/ParserUnit.ml
Stubs/Simple_utils.ml
Stubs/Parser_cameligo.ml
Stubs/Preprocessor.ml
../cameligo/AST.ml
../cameligo/ParserLog.mli
../cameligo/ParserLog.ml
../cameligo/Scoping.mli
../cameligo/Scoping.ml
$HOME/git/ligo/_build/default/src/passes/1-parser/reasonligo/ParErr.ml

3
src/passes/1-parser/reasonligo/LexerMain.ml
View File

@ -4,8 +4,7 @@ module Region = Simple_utils.Region
module IO =
struct
let ext = ".religo"
let options = EvalOpt.read "ReasonLIGO" ext
let options = EvalOpt.(read ~lang:ReasonLIGO ~ext:".religo")
end
module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))

5
src/passes/1-parser/reasonligo/ParserMain.ml
View File

@ -2,8 +2,7 @@
module IO =
struct
let ext = ".religo"
let options = EvalOpt.read "ReasonLIGO" ext
let options = EvalOpt.(read ~lang:ReasonLIGO ~ext:".religo")
end
module Parser =
@ -113,7 +112,7 @@ let prefix =
None | Some "-" -> "temp"
| Some file -> Filename.(file |> basename |> remove_extension)
let suffix = ".pp" ^ IO.ext
let suffix = ".pp" ^ IO.options#ext
let pp_input =
if SSet.mem "cpp" IO.options#verbose

1
src/passes/1-parser/reasonligo/Stubs/Preprocessor.ml Normal file
View File

@ -0,0 +1 @@
module Preproc = Preproc

2
src/passes/1-parser/shared/.links
View File

@ -1,7 +1,7 @@
$HOME/git/OCaml-build/Makefile
$HOME/git/OCaml-build/Makefile.cfg
$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli
$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml

65
src/passes/1-parser/shared/EvalOpt.ml
View File

@ -1,36 +1,47 @@
(** Parsing command-line options *)
(* Parsing command-line options *)
(* The type [command] denotes some possible behaviours of the
compiler. *)
(** The type [command] denotes some possible behaviours of the
compiler.
*)
type command = Quiet | Copy | Units | Tokens
(** The type [options] gathers the command-line options.
*)
type language = PascaLIGO | CameLIGO | ReasonLIGO
let lang_to_string = function
PascaLIGO -> "PascaLIGO"
| CameLIGO -> "CameLIGO"
| ReasonLIGO -> "ReasonLIGO"
(* The type [options] gathers the command-line options. *)
type options = <
input : string option;
libs : string list;
verbose : Utils.String.Set.t;
offsets : bool;
lang : language;
ext : string; (* ".ligo", ".mligo", ".religo" *)
mode : [`Byte | `Point];
cmd : command;
mono : bool;
expr : bool
>
let make ~input ~libs ~verbose ~offsets ~mode ~cmd ~mono ~expr =
let make ~input ~libs ~verbose ~offsets ~lang ~ext ~mode ~cmd ~mono ~expr : options =
object
method input = input
method libs = libs
method verbose = verbose
method offsets = offsets
method lang = lang
method ext = ext
method mode = mode
method cmd = cmd
method mono = mono
method expr = expr
end
(** {1 Auxiliary functions} *)
(* Auxiliary functions *)
let printf = Printf.printf
let sprintf = Printf.sprintf
@ -39,7 +50,7 @@ let print = print_endline
let abort msg =
Utils.highlight (sprintf "Command-line error: %s\n" msg); exit 1
(** {1 Help} *)
(* Help *)
let help language extension () =
let file = Filename.basename Sys.argv.(0) in
@ -55,16 +66,16 @@ let help language extension () =
print " --bytes Bytes for source locations";
print " --mono Use Menhir monolithic API";
print " --expr Parse an expression";
print " --verbose=<stages> cli, cpp, ast-tokens, ast (colon-separated)";
print " --verbose=<stages> cli, preproc, ast-tokens, ast (colon-separated)";
print " --version Commit hash on stdout";
print " -h, --help This help";
exit 0
(** {1 Version} *)
(* Version *)
let version () = printf "%s\n" Version.version; exit 0
(** {1 Specifying the command-line options a la GNU} *)
(* Specifying the command-line options a la GNU *)
let copy = ref false
and tokens = ref false
@ -89,6 +100,7 @@ let add_verbose d =
(split_at_colon d)
let specs language extension =
let language = lang_to_string language in
let open! Getopt in [
'I', nolong, None, Some add_path;
'c', "copy", set copy true, None;
@ -105,17 +117,15 @@ let specs language extension =
]
;;
(** Handler of anonymous arguments
*)
(* Handler of anonymous arguments *)
let anonymous arg =
match !input with
None -> input := Some arg
| Some s -> Printf.printf "s=%s\n" s;
abort (sprintf "Multiple inputs")
;;
| Some _ -> abort (sprintf "Multiple inputs")
(* Checking options and exporting them as non-mutable values *)
(** Checking options and exporting them as non-mutable values
*)
let string_of convert = function
None -> "None"
| Some s -> sprintf "Some %s" (convert s)
@ -139,9 +149,8 @@ let print_opt () =
printf "verbose = %s\n" !verb_str;
printf "input = %s\n" (string_of quote !input);
printf "libs = %s\n" (string_of_path !libs)
;;
let check extension =
let check lang ext =
let () =
if Utils.String.Set.mem "cli" !verbose then print_opt () in
@ -149,11 +158,11 @@ let check extension =
match !input with
None | Some "-" -> !input
| Some file_path ->
if Filename.check_suffix file_path extension
if Filename.check_suffix file_path ext
then if Sys.file_exists file_path
then Some file_path
else abort "Source file not found."
else abort ("Source file lacks the extension " ^ extension ^ ".") in
else abort ("Source file lacks the extension " ^ ext ^ ".") in
(* Exporting remaining options as non-mutable values *)
@ -194,16 +203,16 @@ let check extension =
| false, false, false, true -> Tokens
| _ -> abort "Choose one of -q, -c, -u, -t."
in make ~input ~libs ~verbose ~offsets ~mode ~cmd ~mono ~expr
in make ~input ~libs ~verbose ~offsets ~mode ~cmd ~mono ~expr ~lang ~ext
(** {1 Parsing the command-line options} *)
(* Parsing the command-line options *)
let read language extension =
let read ~lang ~ext =
try
Getopt.parse_cmdline (specs language extension) anonymous;
Getopt.parse_cmdline (specs lang ext) anonymous;
(verb_str :=
let apply e a =
if a = "" then e else Printf.sprintf "%s, %s" e a
in Utils.String.Set.fold apply !verbose "");
check extension
check lang ext
with Getopt.Error msg -> abort msg

17
src/passes/1-parser/shared/EvalOpt.mli
View File

@ -48,11 +48,18 @@ type command = Quiet | Copy | Units | Tokens
expressions is used, otherwise a full-fledged contract is
expected.}
} *)
type language = PascaLIGO | CameLIGO | ReasonLIGO
val lang_to_string : language -> string
type options = <
input : string option;
libs : string list;
verbose : Utils.String.Set.t;
offsets : bool;
lang : language;
ext : string; (* ".ligo", ".mligo", ".religo" *)
mode : [`Byte | `Point];
cmd : command;
mono : bool;
@ -64,6 +71,8 @@ val make :
libs:string list ->
verbose:Utils.String.Set.t ->
offsets:bool ->
lang:language ->
ext:string ->
mode:[`Byte | `Point] ->
cmd:command ->
mono:bool ->
@ -71,7 +80,7 @@ val make :
options
(** Parsing the command-line options on stdin. The first parameter is
the name of the concrete syntax, e.g., "pascaligo", and the second
is the file extension, e.g., ".ligo".
*)
val read : string -> string -> options
the name of the concrete syntax, e.g., [PascaLIGO], and the second
is the expected file extension, e.g., ".ligo". *)
val read : lang:language -> ext:string -> options

26
src/passes/1-parser/shared/Lexer.mll
View File

@ -254,7 +254,7 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
Nil -> One token
| One t | Two (t,_) -> Two (token,t)
(** Beyond tokens, the result of lexing is a state. The type
(* Beyond tokens, the result of lexing is a state. The type
[state] represents the logical state of the lexing engine, that
is, a value which is threaded during scanning and which denotes
useful, high-level information beyond what the type
@ -292,6 +292,7 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
it to [decoder]. See the documentation of the third-party
library Uutf.
*)
type state = {
units : (Markup.t list * token) FQueue.t;
markup : Markup.t list;
@ -648,21 +649,22 @@ and scan state = parse
let state = scan_line thread state lexbuf |> push_line
in scan state lexbuf }
(* Management of #include CPP directives
(* Management of #include preprocessing directives
An input LIGO program may contain GNU CPP (C preprocessor)
directives, and the entry modules (named *Main.ml) run CPP on them
in traditional mode:
An input LIGO program may contain preprocessing directives, and
the entry modules (named *Main.ml) run the preprocessor on them,
as if using the GNU C preprocessor in traditional mode:
https://gcc.gnu.org/onlinedocs/cpp/Traditional-Mode.html
The main interest in using CPP is that it can stand for a poor
man's (flat) module system for LIGO thanks to #include
directives, and the traditional mode leaves the markup mostly
undisturbed.
The main interest in using a preprocessor is that it can stand
for a poor man's (flat) module system for LIGO thanks to #include
directives, and the equivalent of the traditional mode leaves the
markup undisturbed.
Some of the #line resulting from processing #include directives
deal with system file headers and thus have to be ignored for our
Contrary to the C preprocessor, our preprocessor does not
generate #line resulting from processing #include directives deal
with system file headers and thus have to be ignored for our
purpose. Moreover, these #line directives may also carry some
additional flags:
@ -671,7 +673,7 @@ and scan state = parse
of which 1 and 2 indicate, respectively, the start of a new file
and the return from a file (after its inclusion has been
processed).
*)
*)
| '#' blank* ("line" blank+)? (natural as line) blank+
'"' (string as file) '"' {

18
src/passes/1-parser/shared/LexerLog.ml
View File

@ -15,7 +15,7 @@ module type S =
val trace :
?offsets:bool -> [`Byte | `Point] ->
file_path option -> EvalOpt.command ->
Lexer.input -> EvalOpt.command ->
(unit, string Region.reg) Stdlib.result
end
@ -49,16 +49,12 @@ module Make (Lexer: Lexer.S) : (S with module Lexer = Lexer) =
type file_path = string
let trace ?(offsets=true) mode file_path_opt command :
let trace ?(offsets=true) mode input command :
(unit, string Region.reg) Stdlib.result =
let input =
match file_path_opt with
Some file_path -> Lexer.File file_path
| None -> Lexer.Stdin in
match Lexer.open_token_stream input with
Ok Lexer.{read; buffer; close; _} ->
let log = output_token ~offsets mode command stdout
and close_all () = close (); close_out stdout in
and close_all () = flush_all (); close () in
let rec iter () =
match read ~log buffer with
token ->
@ -67,14 +63,14 @@ module Make (Lexer: Lexer.S) : (S with module Lexer = Lexer) =
else iter ()
| exception Lexer.Error error ->
let file =
match file_path_opt with
None | Some "-" -> false
| Some _ -> true in
match input with
Lexer.File name -> name <> "-"
| _ -> false in
let msg =
Lexer.format_error ~offsets mode ~file error
in Stdlib.Error msg in
let result = iter ()
in close_all (); result
| Stdlib.Error (Lexer.File_opening msg) ->
close_out stdout; Stdlib.Error (Region.wrap_ghost msg)
flush_all (); Stdlib.Error (Region.wrap_ghost msg)
end

2
src/passes/1-parser/shared/LexerLog.mli
View File

@ -13,7 +13,7 @@ module type S =
val trace :
?offsets:bool -> [`Byte | `Point] ->
file_path option -> EvalOpt.command ->
Lexer.input -> EvalOpt.command ->
(unit, string Region.reg) Stdlib.result
end

164
src/passes/1-parser/shared/LexerUnit.ml
View File

@ -1,110 +1,106 @@
(* Functor to build a standalone LIGO lexer *)
module Region = Simple_utils.Region
module Preproc = Preprocessor.Preproc
module type IO =
sig
val ext : string (* LIGO file extension *)
val options : EvalOpt.options (* CLI options *)
end
module Make (IO: IO) (Lexer: Lexer.S) =
struct
open Printf
module SSet = Utils.String.Set
(* Error printing and exception tracing *)
let () = Printexc.record_backtrace true
(* Preprocessing the input source and opening the input channels *)
(* Path for CPP inclusions (#include) *)
let lib_path =
match IO.options#libs with
[] -> ""
| libs -> let mk_I dir path = sprintf " -I %s%s" dir path
in List.fold_right mk_I libs ""
let prefix =
match IO.options#input with
None | Some "-" -> "temp"
| Some file -> Filename.(file |> basename |> remove_extension)
let suffix = ".pp" ^ IO.ext
let pp_input =
if Utils.String.Set.mem "cpp" IO.options#verbose
then prefix ^ suffix
else let pp_input, pp_out = Filename.open_temp_file prefix suffix
in close_out pp_out; pp_input
let cpp_cmd =
match IO.options#input with
None | Some "-" ->
sprintf "cpp -traditional-cpp%s - > %s"
lib_path pp_input
| Some file ->
sprintf "cpp -traditional-cpp%s %s > %s"
lib_path file pp_input
(* Running the lexer on the input file *)
(* Preprocessing and lexing the input source *)
let scan () : (Lexer.token list, string Region.reg) Stdlib.result =
(* Preprocessing the input *)
(* Preprocessing the input source *)
if SSet.mem "cpp" IO.options#verbose
then eprintf "%s\n%!" cpp_cmd
else ();
let preproc cin =
let buffer = Lexing.from_channel cin in
let open Lexing in
let () =
match IO.options#input with
None | Some "-" -> ()
| Some pos_fname ->
buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in
match Preproc.lex IO.options buffer with
Stdlib.Error (pp_buffer, err) ->
if Utils.String.Set.mem "preproc" IO.options#verbose then
Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
let formatted =
Preproc.format ~offsets:IO.options#offsets ~file:true err
in Stdlib.Error formatted
| Stdlib.Ok pp_buffer ->
(* Running the lexer on the preprocessed input *)
if Sys.command cpp_cmd <> 0 then
let msg =
sprintf "External error: the command \"%s\" failed." cpp_cmd
in Stdlib.Error (Region.wrap_ghost msg)
else
match Lexer.open_token_stream (Lexer.File pp_input) with
Ok Lexer.{read; buffer; close; _} ->
let close_all () = close (); close_out stdout in
let rec read_tokens tokens =
match read ~log:(fun _ _ -> ()) buffer with
token ->
if Lexer.Token.is_eof token
then Stdlib.Ok (List.rev tokens)
else read_tokens (token::tokens)
| exception Lexer.Error error ->
let file =
match IO.options#input with
None | Some "-" -> false
| Some _ -> true in
let msg =
Lexer.format_error ~offsets:IO.options#offsets
IO.options#mode ~file error
in Stdlib.Error msg in
let result = read_tokens []
in close_all (); result
| Stdlib.Error (Lexer.File_opening msg) ->
close_out stdout; Stdlib.Error (Region.wrap_ghost msg)
let preproc_str = Buffer.contents pp_buffer in
match Lexer.open_token_stream (Lexer.String preproc_str) with
Ok Lexer.{read; buffer; close; _} ->
let close_all () = flush_all (); close () in
let rec read_tokens tokens =
match read ~log:(fun _ _ -> ()) buffer with
token ->
if Lexer.Token.is_eof token
then Stdlib.Ok (List.rev tokens)
else read_tokens (token::tokens)
| exception Lexer.Error error ->
let file =
match IO.options#input with
None | Some "-" -> false
| Some _ -> true in
let msg =
Lexer.format_error ~offsets:IO.options#offsets
IO.options#mode ~file error
in Stdlib.Error msg in
let result = read_tokens []
in close_all (); result
| Stdlib.Error (Lexer.File_opening msg) ->
flush_all (); Stdlib.Error (Region.wrap_ghost msg) in
match IO.options#input with
Some "-" | None -> preproc stdin
| Some file_path ->
try open_in file_path |> preproc with
Sys_error msg -> Stdlib.Error (Region.wrap_ghost msg)
(* Tracing the lexing (effectful) *)
(* Tracing the lexing *)
module Log = LexerLog.Make (Lexer)
let trace () : (unit, string Region.reg) Stdlib.result =
(* Preprocessing the input *)
if SSet.mem "cpp" IO.options#verbose
then eprintf "%s\n%!" cpp_cmd
else ();
if Sys.command cpp_cmd <> 0 then
let msg =
sprintf "External error: the command \"%s\" failed." cpp_cmd
in Stdlib.Error (Region.wrap_ghost msg)
else
Log.trace ~offsets:IO.options#offsets
IO.options#mode
(Some pp_input)
IO.options#cmd
let preproc cin =
let buffer = Lexing.from_channel cin in
let open Lexing in
let () =
match IO.options#input with
None | Some "-" -> ()
| Some pos_fname ->
buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in
match Preproc.lex IO.options buffer with
Stdlib.Error (pp_buffer, err) ->
if Utils.String.Set.mem "preproc" IO.options#verbose then
Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
let formatted =
Preproc.format ~offsets:IO.options#offsets ~file:true err
in Stdlib.Error formatted
| Stdlib.Ok pp_buffer ->
let preproc_str = Buffer.contents pp_buffer in
if Utils.String.Set.mem "preproc" IO.options#verbose then
begin
Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
Stdlib.Ok ()
end
else Log.trace ~offsets:IO.options#offsets
IO.options#mode
(Lexer.String preproc_str)
IO.options#cmd
in match IO.options#input with
Some "-" | None -> preproc stdin
| Some file_path ->
try open_in file_path |> preproc with
Sys_error msg -> Stdlib.Error (Region.wrap_ghost msg)
end

1
src/passes/1-parser/shared/LexerUnit.mli
View File

@ -4,7 +4,6 @@ module Region = Simple_utils.Region
module type IO =
sig
val ext : string (* LIGO file extension *)
val options : EvalOpt.options (* CLI options *)
end

5
src/passes/1-parser/shared/ParserAPI.ml
View File

@ -4,7 +4,6 @@ module Region = Simple_utils.Region
module type IO =
sig
val ext : string (* LIGO file extension *)
val options : EvalOpt.options (* CLI options *)
end
@ -141,12 +140,12 @@ module Make (IO : IO)
and failure = failure get_win in
let parser = Incr.contract buffer.Lexing.lex_curr_p in
let ast = I.loop_handle success failure supplier parser
in close (); ast
in flush_all (); close (); ast
let incr_expr Lexer.{read; buffer; get_win; close; _} =
let supplier = I.lexer_lexbuf_to_supplier (read ~log) buffer
and failure = failure get_win in
let parser = Incr.interactive_expr buffer.Lexing.lex_curr_p in
let expr = I.loop_handle success failure supplier parser
in close (); expr
in flush_all (); close (); expr
end

1
src/passes/1-parser/shared/ParserAPI.mli
View File

@ -4,7 +4,6 @@ module Region = Simple_utils.Region
module type IO =
sig
val ext : string (* LIGO file extension *)
val options : EvalOpt.options (* CLI options *)
end

7
src/passes/1-parser/shared/ParserUnit.ml
View File

@ -4,7 +4,6 @@ module Region = Simple_utils.Region
module type IO =
sig
val ext : string (* LIGO file extension *)
val options : EvalOpt.options (* CLI options *)
end
@ -94,7 +93,7 @@ module Make (Lexer: Lexer.S)
ParserLog.pp_expr state expr;
Buffer.output_buffer stdout output
end
in close (); Ok expr
in flush_all (); close (); Ok expr
(* Parsing a contract *)
@ -129,7 +128,7 @@ module Make (Lexer: Lexer.S)
ParserLog.pp_ast state ast;
Buffer.output_buffer stdout output
end
in close (); Ok ast
in flush_all (); close (); Ok ast
(* Wrapper for the parsers above *)
@ -180,5 +179,5 @@ module Make (Lexer: Lexer.S)
(* I/O errors *)
| exception Sys_error error ->
Stdlib.Error (Region.wrap_ghost error)
flush_all (); Stdlib.Error (Region.wrap_ghost error)
end

1
src/passes/1-parser/shared/ParserUnit.mli
View File

@ -4,7 +4,6 @@ module Region = Simple_utils.Region
module type IO =
sig
val ext : string (* LIGO file extension *)
val options : EvalOpt.options (* CLI options *)
end

3
src/passes/1-parser/shared/dune
View File

@ -8,7 +8,8 @@
simple-utils
uutf
getopt
zarith)
zarith
Preproc)
(preprocess
(pps bisect_ppx --conditional))
(modules

23
vendors/Preproc/E_LexerMain.ml vendored
View File

@ -1,23 +0,0 @@
module Region = Simple_utils.Region
let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg
let options = EvalOpt.read ();;
match open_in options#input with
exception Sys_error msg -> highlight msg
| cin ->
let buffer = Lexing.from_channel cin in
let open Lexing in
let () =
buffer.lex_curr_p <-
{buffer.lex_curr_p with pos_fname = options#input} in
let rec iter () =
match E_Lexer.scan buffer with
token -> Printf.printf "%s\n" (E_Lexer.string_of_token token);
if token <> E_Parser.EOL then iter ()
| exception E_Lexer.Error err ->
let formatted =
E_Lexer.format ~offsets:options#offsets ~file:true err
in highlight formatted.Region.value
in iter (); close_in cin

24
vendors/Preproc/PreprocMain.ml vendored
View File

@ -1,24 +0,0 @@
module Region = Simple_utils.Region
let highlight msg = Printf.eprintf "\027[31m%s\027[0m\n%!" msg
let options = EvalOpt.read ();;
match open_in options#input with
exception Sys_error msg -> highlight msg
| cin ->
let buffer = Lexing.from_channel cin in
let open Lexing in
let () =
buffer.lex_curr_p <-
{buffer.lex_curr_p with pos_fname = options#input} in
match Preproc.lex options buffer with
Stdlib.Ok pp_buffer -> print_string (Buffer.contents pp_buffer)
| Stdlib.Error (pp_buffer, err) ->
let formatted =
Preproc.format ~offsets:options#offsets ~file:true err in
begin
if EvalOpt.SSet.mem "preproc" options#verbose then
Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
highlight formatted.Region.value
end

0
vendors/Preproc/.E_LexerMain.tag → vendors/Preprocessor/.E_LexerMain.tag vendored
View File

0
vendors/Preproc/.E_Parser.mly.tag → vendors/Preprocessor/.E_Parser.mly.tag vendored
View File

0
vendors/Preproc/.E_ParserMain.tag → vendors/Preprocessor/.E_ParserMain.tag vendored
View File

0
vendors/Preproc/.PreprocMain.ml → vendors/Preprocessor/.PreprocMain.ml vendored
View File

0
vendors/Preproc/.PreprocMain.tag → vendors/Preprocessor/.PreprocMain.tag vendored
View File

0
vendors/Preproc/.links → vendors/Preprocessor/.links vendored
View File

0
vendors/Preproc/E_AST.ml → vendors/Preprocessor/E_AST.ml vendored
View File

0
vendors/Preproc/E_Lexer.mli → vendors/Preprocessor/E_Lexer.mli vendored
View File

0
vendors/Preproc/E_Lexer.mll → vendors/Preprocessor/E_Lexer.mll vendored
View File

33
vendors/Preprocessor/E_LexerMain.ml vendored Normal file
View File

@ -0,0 +1,33 @@
(* Standalone lexer for booleans expression of preprocessing
directives for PascaLIGO *)
module Region = Simple_utils.Region
let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg
let options = EvalOpt.read ~lang:EvalOpt.PascaLIGO ~ext:".ligo"
let lex in_chan =
let buffer = Lexing.from_channel in_chan in
let open Lexing in
let () =
match options#input with
Some "-" | None -> ()
| Some pos_fname ->
buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in
let rec iter () =
match E_Lexer.scan buffer with
token -> Printf.printf "%s\n" (E_Lexer.string_of_token token);
if token <> E_Parser.EOL then iter ()
| exception E_Lexer.Error err ->
let formatted =
E_Lexer.format ~offsets:options#offsets ~file:true err
in highlight formatted.Region.value
in iter (); close_in in_chan
let () =
match options#input with
Some "-" | None -> lex stdin
| Some file_path ->
try open_in file_path |> lex with
Sys_error msg -> highlight msg

0
vendors/Preproc/E_Parser.mly → vendors/Preprocessor/E_Parser.mly vendored
View File

33
vendors/Preproc/E_ParserMain.ml → vendors/Preprocessor/E_ParserMain.ml vendored
View File

@ -1,17 +1,20 @@
(* Standalone parser for booleans expression of preprocessing
directives for PascaLIGO *)
module Region = Simple_utils.Region
let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg
let options = EvalOpt.read ();;
let options = EvalOpt.read ~lang:EvalOpt.PascaLIGO ~ext:".ligo"
match open_in options#input with
exception Sys_error msg -> highlight msg
| cin ->
let buffer = Lexing.from_channel cin in
let open Lexing in
let () =
buffer.lex_curr_p <-
{buffer.lex_curr_p with pos_fname = options#input} in
let parse in_chan =
let buffer = Lexing.from_channel in_chan in
let open Lexing in
let () =
match options#input with
Some "-" | None -> ()
| Some pos_fname ->
buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in
let () =
try
let tree = E_Parser.expr E_Lexer.scan buffer in
@ -20,8 +23,7 @@ match open_in options#input with
with
E_Lexer.Error error ->
let formatted =
E_Lexer.format
~offsets:options#offsets ~file:true error
E_Lexer.format ~offsets:options#offsets ~file:true error
in highlight formatted.Region.value
| E_Parser.Error ->
let region = Preproc.mk_reg buffer
@ -31,4 +33,11 @@ match open_in options#input with
Preproc.format ~offsets:options#offsets
~file:true error
in highlight formatted.Region.value
in close_in cin
in close_in in_chan
let () =
match options#input with
Some "-" | None -> parse stdin
| Some file_path ->
try open_in file_path |> parse with
Sys_error msg -> highlight msg

65
vendors/Preproc/EvalOpt.ml → vendors/Preprocessor/EvalOpt.ml vendored
View File

@ -2,25 +2,32 @@
(* The type [options] gathers the command-line options. *)
type language = PascaLIGO | CameLIGO | ReasonLIGO
module SSet = Set.Make (String)
type language = PascaLIGO | CameLIGO | ReasonLIGO
let lang_to_string = function
PascaLIGO -> "PascaLIGO"
| CameLIGO -> "CameLIGO"
| ReasonLIGO -> "ReasonLIGO"
type options = <
input : string;
input : string option;
libs : string list;
lang : language;
verbose : SSet.t;
offsets : bool;
verbose : SSet.t
lang : language;
ext : string (* ".ligo", ".mligo", ".religo" *)
>
let make ~input ~libs ~lang ~offsets ~verbose =
let make ~input ~libs ~lang ~offsets ~verbose ~ext : options =
object
method input = input
method libs = libs
method lang = lang
method offsets = offsets
method verbose = verbose
method ext = ext
end
(* Auxiliary functions and modules *)
@ -40,10 +47,10 @@ let abort msg =
(* Help *)
let help () =
let help lang ext () =
let file = Filename.basename Sys.argv.(0) in
printf "Usage: %s [<option> ...] <input>\n" file;
printf "where <input> is the source file,\n";
printf "Usage: %s [<option> ...] [<input>%s | \"-\"]\n" file ext;
printf "where <input>%s is the %s source file (default: stdin),\n" ext lang;
print "and each <option> (if any) is one of the following:";
print " -I <paths> Inclusion paths (colon-separated)";
print " --columns Columns for source locations";
@ -55,7 +62,6 @@ let help () =
let input = ref None
and libs = ref []
and lang = ref None
and columns = ref false
and verbose = ref SSet.empty
and verb_str = ref ""
@ -68,10 +74,11 @@ let add_verbose d =
verbose := List.fold_left (fun x y -> SSet.add y x)
!verbose
(split_at_colon d)
let specs =
let specs lang ext =
let lang_str = lang_to_string lang in
let open!Getopt in [
'I', nolong, None, Some add_path;
'h', "help", Some help, None;
'h', "help", Some (help lang_str ext), None;
noshort, "columns", set columns true, None;
noshort, "verbose", None, Some add_verbose
]
@ -80,44 +87,38 @@ let specs =
let anonymous arg =
match !input with
None ->
(match Filename.extension arg with
".ligo" -> lang := Some PascaLIGO
| ".mligo" -> lang := Some CameLIGO
| ".religo" -> lang := Some ReasonLIGO
| _ -> abort (sprintf "Wrong file extension."));
input := Some arg
| Some _ -> abort (sprintf "Multiple inputs.")
None -> input := Some arg
| Some _ -> abort (sprintf "Multiple inputs")
(* Checking options and exporting them as non-mutable values *)
let check () =
let check lang ext =
let libs = !libs
and offsets = not !columns
and verbose = !verbose
and lang =
match !lang with
Some lang -> lang
| None -> assert false
and input =
match !input with
Some file -> file
| None -> abort "Missing input file."
None | Some "-" -> !input
| Some file_path ->
if Filename.check_suffix file_path ext
then if Sys.file_exists file_path
then Some file_path
else abort "Source file not found."
else abort ("Source file lacks the extension " ^ ext ^ ".")
in make ~input ~libs ~lang ~offsets ~verbose
in make ~input ~libs ~lang ~offsets ~verbose ~ext
(* Parsing the command-line options *)
let read () =
let read ~lang:(lang : language) ~ext:(ext : string) =
try
Getopt.parse_cmdline specs anonymous;
Getopt.parse_cmdline (specs lang ext) anonymous;
(verb_str :=
let apply e a =
if a = "" then e else sprintf "%s, %s" e a
in SSet.fold apply !verbose "");
check ()
check lang ext
with Getopt.Error msg -> abort msg

13
vendors/Preproc/EvalOpt.mli → vendors/Preprocessor/EvalOpt.mli vendored
View File

@ -3,27 +3,30 @@
(* 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
type options = <
input : string;
input : string option;
libs : string list;
lang : language;
verbose : SSet.t;
offsets : bool;
verbose : SSet.t
lang : language;
ext : string (* ".ligo", ".mligo", ".religo" *)
>
val make :
input:string ->
input:string option ->
libs:string list ->
lang:language ->
offsets:bool ->
verbose:SSet.t ->
ext:string ->
options
(* Parsing the command-line options on stdin. The first parameter is
the name of the concrete syntax. This is needed to correctly handle
comments. *)
val read : unit -> options
val read : lang:language -> ext:string -> options

0
vendors/Preproc/LICENSE → vendors/Preprocessor/LICENSE vendored
View File

0
vendors/Preproc/Makefile.cfg → vendors/Preprocessor/Makefile.cfg vendored
View File

0
vendors/Preproc/Preproc.mli → vendors/Preprocessor/Preproc.mli vendored
View File

1
vendors/Preproc/Preproc.mll → vendors/Preprocessor/Preproc.mll vendored
View File

@ -484,7 +484,6 @@ rule scan state = parse
let line = Lexing.(lexbuf.lex_curr_p.pos_lnum)
and file = Lexing.(lexbuf.lex_curr_p.pos_fname) in
let base = Filename.basename file
(* and dir = Filename.dirname file*)
and reg, incl_file = scan_inclusion state lexbuf in
let incl_dir = Filename.dirname incl_file in
let path = mk_path state in

33
vendors/Preprocessor/PreprocMain.ml vendored Normal file
View File

@ -0,0 +1,33 @@
(* Standalone preprocessor for PascaLIGO *)
module Region = Simple_utils.Region
let highlight msg = Printf.eprintf "\027[31m%s\027[0m\n%!" msg
let options = EvalOpt.read ~lang:EvalOpt.PascaLIGO ~ext:".ligo";;
let preproc cin =
let buffer = Lexing.from_channel cin in
let open Lexing in
let () =
match options#input with
None | Some "-" -> ()
| Some pos_fname ->
buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in
match Preproc.lex options buffer with
Stdlib.Ok pp_buffer -> print_string (Buffer.contents pp_buffer)
| Stdlib.Error (pp_buffer, err) ->
let formatted =
Preproc.format ~offsets:options#offsets ~file:true err in
begin
if EvalOpt.SSet.mem "preproc" options#verbose then
Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
highlight formatted.Region.value
end
let () =
match options#input with
Some "-" | None -> preproc stdin
| Some file_path ->
try open_in file_path |> preproc with
Sys_error msg -> highlight msg

0
vendors/Preproc/build.sh → vendors/Preprocessor/build.sh vendored
View File

0
vendors/Preproc/clean.sh → vendors/Preprocessor/clean.sh vendored
View File

2
vendors/Preproc/dune → vendors/Preprocessor/dune vendored
View File

@ -5,7 +5,7 @@
(modules E_Parser))
(library
(name Preproc)
(name Preprocessor)
(public_name ligo.preproc)
(libraries
getopt