Integrated the library for preprocessing.

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

View File

@ -1,8 +1,20 @@
$HOME/git/OCaml-build/Makefile $HOME/git/OCaml-build/Makefile
$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli $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/pos.ml
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli $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
$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.mli
../shared/Lexer.mll ../shared/Lexer.mll
../shared/EvalOpt.ml ../shared/EvalOpt.ml
@ -17,7 +29,12 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
../shared/Utils.ml ../shared/Utils.ml
../shared/ParserAPI.mli ../shared/ParserAPI.mli
../shared/ParserAPI.ml ../shared/ParserAPI.ml
../shared/LexerUnit.mli
../shared/LexerUnit.ml ../shared/LexerUnit.ml
../shared/ParserUnit.mli
../shared/ParserUnit.ml ../shared/ParserUnit.ml
Stubs/Simple_utils.ml Stubs/Simple_utils.ml
Stubs/Preprocessor.ml
$HOME/git/ligo/_build/default/src/passes/1-parser/cameligo/ParErr.ml $HOME/git/ligo/_build/default/src/passes/1-parser/cameligo/ParErr.ml

View File

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

View File

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

View File

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

View File

@ -1,8 +1,20 @@
$HOME/git/OCaml-build/Makefile $HOME/git/OCaml-build/Makefile
$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli $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/pos.ml
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli $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
$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.mli
../shared/Lexer.mll ../shared/Lexer.mll
../shared/EvalOpt.ml ../shared/EvalOpt.ml
@ -21,7 +33,8 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
../shared/LexerUnit.ml ../shared/LexerUnit.ml
../shared/ParserUnit.mli ../shared/ParserUnit.mli
../shared/ParserUnit.ml ../shared/ParserUnit.ml
../shared/Memo.mli
../shared/Memo.ml
Stubs/Simple_utils.ml Stubs/Simple_utils.ml
Stubs/Preprocessor.ml
$HOME/git/ligo/_build/default/src/passes/1-parser/pascaligo/ParErr.ml $HOME/git/ligo/_build/default/src/passes/1-parser/pascaligo/ParErr.ml

View File

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

View File

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

View File

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

View File

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

View File

@ -1,8 +1,20 @@
$HOME/git/OCaml-build/Makefile $HOME/git/OCaml-build/Makefile
$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli $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/pos.ml
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli $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
$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.mli
../shared/Lexer.mll ../shared/Lexer.mll
../shared/EvalOpt.ml ../shared/EvalOpt.ml
@ -17,13 +29,19 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
../shared/Utils.ml ../shared/Utils.ml
../shared/ParserAPI.mli ../shared/ParserAPI.mli
../shared/ParserAPI.ml ../shared/ParserAPI.ml
../shared/LexerUnit.mli
../shared/LexerUnit.ml ../shared/LexerUnit.ml
../shared/ParserUnit.mli
../shared/ParserUnit.ml ../shared/ParserUnit.ml
Stubs/Simple_utils.ml Stubs/Simple_utils.ml
Stubs/Parser_cameligo.ml Stubs/Parser_cameligo.ml
Stubs/Preprocessor.ml
../cameligo/AST.ml ../cameligo/AST.ml
../cameligo/ParserLog.mli ../cameligo/ParserLog.mli
../cameligo/ParserLog.ml ../cameligo/ParserLog.ml
../cameligo/Scoping.mli ../cameligo/Scoping.mli
../cameligo/Scoping.ml ../cameligo/Scoping.ml
$HOME/git/ligo/_build/default/src/passes/1-parser/reasonligo/ParErr.ml $HOME/git/ligo/_build/default/src/passes/1-parser/reasonligo/ParErr.ml

View File

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

View File

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

View File

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

View File

@ -1,7 +1,7 @@
$HOME/git/OCaml-build/Makefile $HOME/git/OCaml-build/Makefile
$HOME/git/OCaml-build/Makefile.cfg $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.mli
$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml $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.mli
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.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 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 = < type options = <
input : string option; input : string option;
libs : string list; libs : string list;
verbose : Utils.String.Set.t; verbose : Utils.String.Set.t;
offsets : bool; offsets : bool;
lang : language;
ext : string; (* ".ligo", ".mligo", ".religo" *)
mode : [`Byte | `Point]; mode : [`Byte | `Point];
cmd : command; cmd : command;
mono : bool; mono : bool;
expr : 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 object
method input = input method input = input
method libs = libs method libs = libs
method verbose = verbose method verbose = verbose
method offsets = offsets method offsets = offsets
method lang = lang
method ext = ext
method mode = mode method mode = mode
method cmd = cmd method cmd = cmd
method mono = mono method mono = mono
method expr = expr method expr = expr
end end
(** {1 Auxiliary functions} *) (* Auxiliary functions *)
let printf = Printf.printf let printf = Printf.printf
let sprintf = Printf.sprintf let sprintf = Printf.sprintf
@ -39,7 +50,7 @@ let print = print_endline
let abort msg = let abort msg =
Utils.highlight (sprintf "Command-line error: %s\n" msg); exit 1 Utils.highlight (sprintf "Command-line error: %s\n" msg); exit 1
(** {1 Help} *) (* Help *)
let help language extension () = let help language extension () =
let file = Filename.basename Sys.argv.(0) in let file = Filename.basename Sys.argv.(0) in
@ -55,16 +66,16 @@ let help language extension () =
print " --bytes Bytes for source locations"; print " --bytes Bytes for source locations";
print " --mono Use Menhir monolithic API"; print " --mono Use Menhir monolithic API";
print " --expr Parse an expression"; 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 " --version Commit hash on stdout";
print " -h, --help This help"; print " -h, --help This help";
exit 0 exit 0
(** {1 Version} *) (* Version *)
let version () = printf "%s\n" Version.version; exit 0 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 let copy = ref false
and tokens = ref false and tokens = ref false
@ -89,6 +100,7 @@ let add_verbose d =
(split_at_colon d) (split_at_colon d)
let specs language extension = let specs language extension =
let language = lang_to_string language in
let open! Getopt in [ let open! Getopt in [
'I', nolong, None, Some add_path; 'I', nolong, None, Some add_path;
'c', "copy", set copy true, None; '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 = let anonymous arg =
match !input with match !input with
None -> input := Some arg None -> input := Some arg
| Some s -> Printf.printf "s=%s\n" s; | Some _ -> abort (sprintf "Multiple inputs")
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 let string_of convert = function
None -> "None" None -> "None"
| Some s -> sprintf "Some %s" (convert s) | Some s -> sprintf "Some %s" (convert s)
@ -139,9 +149,8 @@ let print_opt () =
printf "verbose = %s\n" !verb_str; printf "verbose = %s\n" !verb_str;
printf "input = %s\n" (string_of quote !input); printf "input = %s\n" (string_of quote !input);
printf "libs = %s\n" (string_of_path !libs) printf "libs = %s\n" (string_of_path !libs)
;;
let check extension = let check lang ext =
let () = let () =
if Utils.String.Set.mem "cli" !verbose then print_opt () in if Utils.String.Set.mem "cli" !verbose then print_opt () in
@ -149,11 +158,11 @@ let check extension =
match !input with match !input with
None | Some "-" -> !input None | Some "-" -> !input
| Some file_path -> | 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 if Sys.file_exists file_path
then Some file_path then Some file_path
else abort "Source file not found." 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 *) (* Exporting remaining options as non-mutable values *)
@ -194,16 +203,16 @@ let check extension =
| false, false, false, true -> Tokens | false, false, false, true -> Tokens
| _ -> abort "Choose one of -q, -c, -u, -t." | _ -> 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 try
Getopt.parse_cmdline (specs language extension) anonymous; Getopt.parse_cmdline (specs lang ext) anonymous;
(verb_str := (verb_str :=
let apply e a = let apply e a =
if a = "" then e else Printf.sprintf "%s, %s" e a if a = "" then e else Printf.sprintf "%s, %s" e a
in Utils.String.Set.fold apply !verbose ""); in Utils.String.Set.fold apply !verbose "");
check extension check lang ext
with Getopt.Error msg -> abort msg with Getopt.Error msg -> abort msg

View File

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

View File

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

View File

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

View File

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

View File

@ -1,71 +1,46 @@
(* Functor to build a standalone LIGO lexer *) (* Functor to build a standalone LIGO lexer *)
module Region = Simple_utils.Region module Region = Simple_utils.Region
module Preproc = Preprocessor.Preproc
module type IO = module type IO =
sig sig
val ext : string (* LIGO file extension *)
val options : EvalOpt.options (* CLI options *) val options : EvalOpt.options (* CLI options *)
end end
module Make (IO: IO) (Lexer: Lexer.S) = module Make (IO: IO) (Lexer: Lexer.S) =
struct struct
open Printf
module SSet = Utils.String.Set
(* Error printing and exception tracing *) (* Error printing and exception tracing *)
let () = Printexc.record_backtrace true let () = Printexc.record_backtrace true
(* Preprocessing the input source and opening the input channels *) (* Preprocessing and lexing the input source *)
(* 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 *)
let scan () : (Lexer.token list, string Region.reg) Stdlib.result = let scan () : (Lexer.token list, string Region.reg) Stdlib.result =
(* Preprocessing the input *) (* Preprocessing the input source *)
if SSet.mem "cpp" IO.options#verbose let preproc cin =
then eprintf "%s\n%!" cpp_cmd let buffer = Lexing.from_channel cin in
else (); 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 preproc_str = Buffer.contents pp_buffer in
let msg = match Lexer.open_token_stream (Lexer.String preproc_str) with
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; _} -> Ok Lexer.{read; buffer; close; _} ->
let close_all () = close (); close_out stdout in let close_all () = flush_all (); close () in
let rec read_tokens tokens = let rec read_tokens tokens =
match read ~log:(fun _ _ -> ()) buffer with match read ~log:(fun _ _ -> ()) buffer with
token -> token ->
@ -84,27 +59,48 @@ module Make (IO: IO) (Lexer: Lexer.S) =
let result = read_tokens [] let result = read_tokens []
in close_all (); result in close_all (); result
| Stdlib.Error (Lexer.File_opening msg) -> | Stdlib.Error (Lexer.File_opening msg) ->
close_out stdout; Stdlib.Error (Region.wrap_ghost 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) module Log = LexerLog.Make (Lexer)
let trace () : (unit, string Region.reg) Stdlib.result = let trace () : (unit, string Region.reg) Stdlib.result =
(* Preprocessing the input *) (* Preprocessing the input *)
let preproc cin =
if SSet.mem "cpp" IO.options#verbose let buffer = Lexing.from_channel cin in
then eprintf "%s\n%!" cpp_cmd let open Lexing in
else (); let () =
match IO.options#input with
if Sys.command cpp_cmd <> 0 then None | Some "-" -> ()
let msg = | Some pos_fname ->
sprintf "External error: the command \"%s\" failed." cpp_cmd buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in
in Stdlib.Error (Region.wrap_ghost msg) match Preproc.lex IO.options buffer with
else Stdlib.Error (pp_buffer, err) ->
Log.trace ~offsets:IO.options#offsets if Utils.String.Set.mem "preproc" IO.options#verbose then
IO.options#mode Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
(Some pp_input) let formatted =
IO.options#cmd 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 end

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

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

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

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

View File

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

View File

@ -2,25 +2,32 @@
(* The type [options] gathers the command-line options. *) (* The type [options] gathers the command-line options. *)
type language = PascaLIGO | CameLIGO | ReasonLIGO
module SSet = Set.Make (String) module SSet = Set.Make (String)
type language = PascaLIGO | CameLIGO | ReasonLIGO
let lang_to_string = function
PascaLIGO -> "PascaLIGO"
| CameLIGO -> "CameLIGO"
| ReasonLIGO -> "ReasonLIGO"
type options = < type options = <
input : string; input : string option;
libs : string list; libs : string list;
lang : language; verbose : SSet.t;
offsets : bool; 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 object
method input = input method input = input
method libs = libs method libs = libs
method lang = lang method lang = lang
method offsets = offsets method offsets = offsets
method verbose = verbose method verbose = verbose
method ext = ext
end end
(* Auxiliary functions and modules *) (* Auxiliary functions and modules *)
@ -40,10 +47,10 @@ let abort msg =
(* Help *) (* Help *)
let help () = let help lang ext () =
let file = Filename.basename Sys.argv.(0) in let file = Filename.basename Sys.argv.(0) in
printf "Usage: %s [<option> ...] <input>\n" file; printf "Usage: %s [<option> ...] [<input>%s | \"-\"]\n" file ext;
printf "where <input> is the source file,\n"; 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 "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";
@ -55,7 +62,6 @@ let help () =
let input = ref None let input = ref None
and libs = ref [] and libs = ref []
and lang = ref None
and columns = ref false and columns = ref false
and verbose = ref SSet.empty and verbose = ref SSet.empty
and verb_str = ref "" and verb_str = ref ""
@ -68,10 +74,11 @@ 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 = let specs lang 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, None; 'h', "help", Some (help lang_str 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
] ]
@ -80,44 +87,38 @@ let specs =
let anonymous arg = let anonymous arg =
match !input with match !input with
None -> None -> input := Some arg
(match Filename.extension arg with | Some _ -> abort (sprintf "Multiple inputs")
".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.")
(* Checking options and exporting them as non-mutable values *) (* Checking options and exporting them as non-mutable values *)
let check () = let check lang ext =
let libs = !libs let libs = !libs
and offsets = not !columns and offsets = not !columns
and verbose = !verbose and verbose = !verbose
and lang =
match !lang with
Some lang -> lang
| None -> assert false
and input = and input =
match !input with match !input with
Some file -> file None | Some "-" -> !input
| None -> abort "Missing input file." | 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 *) (* Parsing the command-line options *)
let read () = let read ~lang:(lang : language) ~ext:(ext : string) =
try try
Getopt.parse_cmdline specs anonymous; Getopt.parse_cmdline (specs lang 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 () check lang ext
with Getopt.Error msg -> abort msg with Getopt.Error msg -> abort msg

View File

@ -3,27 +3,30 @@
(* The type [options] gathers the command-line options. *) (* The type [options] gathers the command-line options. *)
type language = PascaLIGO | CameLIGO | ReasonLIGO type language = PascaLIGO | CameLIGO | ReasonLIGO
val lang_to_string : language -> string
module SSet : Set.S with type elt = string module SSet : Set.S with type elt = string
type options = < type options = <
input : string; input : string option;
libs : string list; libs : string list;
lang : language; verbose : SSet.t;
offsets : bool; offsets : bool;
verbose : SSet.t lang : language;
ext : string (* ".ligo", ".mligo", ".religo" *)
> >
val make : val make :
input:string -> input:string option ->
libs:string list -> libs:string list ->
lang:language -> lang:language ->
offsets:bool -> offsets:bool ->
verbose:SSet.t -> verbose:SSet.t ->
ext:string ->
options options
(* Parsing the command-line options on stdin. The first parameter is (* Parsing the command-line options on stdin. The first parameter is
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 : unit -> options val read : lang:language -> ext:string -> options

View File

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

View File

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