0226b9f23c
Refactoring of parsing command-line arguments
* The type [options] is now abstract and implemented as an
object type to avoid struggling with scoping and type
inference when record types share some common field names.
Refactoring of ParserLog for PascaLIGO and CameLIGO
* The immediate motivation behind that refactoring was to
remove the use of a couple of global references. A
consequence is that we have a nicer and more compact code, by
threading a state. The files [pascaligo/Tests/pp.ligo] and
[ligodity/Tests/pp.mligo].
* Another consequence is that the choice of making strings from
AST nodes depends on the CLI (offsets? mode?). After this
refactoring, that choice is hardcoded in the simplifiers in a
few places (TODO), waiting for a general solution that would
have all CL options flow through the compiler.
* I removed the use of vendors [x_option.ml], [x_map.ml] and
[x_list.ml] when handling optional values. (Less dependencies
this way.)
Refactoring of the ASTs
* I removed the node [local_decl], which was set to [[]]
already in a previous commit (which removed local
declarations as being redundant, as statements could already
be instructions or declarations).
* I changed [StrLit] to [String] in the AST of CameLIGO and
ReasonLIGO.
* I also changed the type [fun_expr] so now either a block is
present, and therefore followed by the [with] keyword, or it
is not. (Before, the presence of a block was not enforced in
the type with the presence of the keyword.)
Notes
* [LexerMain.ml] and [ParserMain.ml] for CameLIGO and PascaLIGO
are almost identical and differ in the same way (language
name and file extension), which suggests that they should be
in the [shared] folder and instanciated as a functor in the
future (TODO).
* I removed the blank characters at the end of many lines in
the parser of ReasonLIGO.
134 lines
3.5 KiB
OCaml
134 lines
3.5 KiB
OCaml
(** Driver for the parser of PascaLIGO *)
|
|
|
|
let extension = ".ligo"
|
|
let options = EvalOpt.read "PascaLIGO" extension
|
|
|
|
(** Error printing and exception tracing
|
|
*)
|
|
let () = Printexc.record_backtrace true
|
|
|
|
(** Auxiliary functions
|
|
*)
|
|
let sprintf = Printf.sprintf
|
|
|
|
(** Extracting the input file
|
|
*)
|
|
let file =
|
|
match options#input with
|
|
None | Some "-" -> false
|
|
| Some _ -> true
|
|
|
|
(** {1 Error printing and exception tracing} *)
|
|
|
|
let () = Printexc.record_backtrace true
|
|
|
|
let external_ text =
|
|
Utils.highlight (Printf.sprintf "External error: %s" text); exit 1;;
|
|
|
|
type Error.t += ParseError
|
|
|
|
let error_to_string = function
|
|
ParseError -> "Syntax error.\n"
|
|
| _ -> assert false
|
|
|
|
let print_error ?(offsets=true) mode Region.{region; value} ~file =
|
|
let msg = error_to_string value in
|
|
let reg = region#to_string ~file ~offsets mode in
|
|
Utils.highlight (sprintf "Parse error %s:\n%s%!" reg msg)
|
|
|
|
(** {1 Preprocessing the input source and opening the input channels} *)
|
|
|
|
(** Path for CPP inclusions (#include)
|
|
*)
|
|
let lib_path =
|
|
match options#libs with
|
|
[] -> ""
|
|
| libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path
|
|
in List.fold_right mk_I libs ""
|
|
|
|
let prefix =
|
|
match options#input with
|
|
None | Some "-" -> "temp"
|
|
| Some file -> Filename.(file |> basename |> remove_extension)
|
|
|
|
let suffix = ".pp" ^ extension
|
|
|
|
let pp_input =
|
|
if Utils.String.Set.mem "cpp" 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 options#input with
|
|
None | Some "-" ->
|
|
Printf.sprintf "cpp -traditional-cpp%s - > %s"
|
|
lib_path pp_input
|
|
| Some file ->
|
|
Printf.sprintf "cpp -traditional-cpp%s %s > %s"
|
|
lib_path file pp_input
|
|
|
|
let () =
|
|
if Utils.String.Set.mem "cpp" options#verbose
|
|
then Printf.eprintf "%s\n%!" cpp_cmd;
|
|
if Sys.command cpp_cmd <> 0 then
|
|
external_ (Printf.sprintf "the command \"%s\" failed." cpp_cmd)
|
|
|
|
(** {1 Instanciating the lexer} *)
|
|
|
|
module Lexer = Lexer.Make (LexToken)
|
|
|
|
module Log = LexerLog.Make (Lexer)
|
|
|
|
let Lexer.{read; buffer; get_pos; get_last; close} =
|
|
Lexer.open_token_stream (Some pp_input)
|
|
|
|
and cout = stdout
|
|
|
|
let log = Log.output_token ~offsets:options#offsets
|
|
options#mode options#cmd cout
|
|
|
|
and close_all () = close (); close_out cout
|
|
|
|
(** {1 Tokeniser} *)
|
|
|
|
let tokeniser = read ~log
|
|
|
|
(** {1 Main} *)
|
|
|
|
let () =
|
|
try
|
|
let ast = Parser.contract tokeniser buffer in
|
|
if Utils.String.Set.mem "ast" options#verbose
|
|
then let buffer = Buffer.create 131 in
|
|
let state = ParserLog.mk_state
|
|
~offsets:options#offsets
|
|
~mode:options#mode
|
|
~buffer in
|
|
begin
|
|
ParserLog.pp_ast state ast;
|
|
Buffer.output_buffer stdout buffer
|
|
end
|
|
else if Utils.String.Set.mem "ast-tokens" options#verbose
|
|
then let buffer = Buffer.create 131 in
|
|
let state = ParserLog.mk_state
|
|
~offsets:options#offsets
|
|
~mode:options#mode
|
|
~buffer in
|
|
begin
|
|
ParserLog.print_tokens state ast;
|
|
Buffer.output_buffer stdout buffer
|
|
end
|
|
with
|
|
Lexer.Error err ->
|
|
close_all ();
|
|
Lexer.print_error ~offsets:options#offsets
|
|
options#mode err ~file
|
|
| Parser.Error ->
|
|
let region = get_last () in
|
|
let error = Region.{region; value=ParseError} in
|
|
let () = close_all () in
|
|
print_error ~offsets:options#offsets
|
|
options#mode error ~file
|
|
| Sys_error msg -> Utils.highlight msg
|