From ddd438aaa84574fe5df32c8c004901d893d70e4f Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Sat, 4 Jan 2020 23:32:50 +0100 Subject: [PATCH] Forgot to add. --- src/passes/1-parser/shared/LexerUnit.ml | 65 +++++++++ src/passes/1-parser/shared/ParserUnit.ml | 167 +++++++++++++++++++++++ 2 files changed, 232 insertions(+) create mode 100644 src/passes/1-parser/shared/LexerUnit.ml create mode 100644 src/passes/1-parser/shared/ParserUnit.ml diff --git a/src/passes/1-parser/shared/LexerUnit.ml b/src/passes/1-parser/shared/LexerUnit.ml new file mode 100644 index 000000000..8094bdddd --- /dev/null +++ b/src/passes/1-parser/shared/LexerUnit.ml @@ -0,0 +1,65 @@ +(* Functor to build a standalone LIGO lexer *) + +module type S = + sig + val ext : string (* LIGO file extension *) + val options : EvalOpt.options (* CLI options *) + end + +module Make (IO: S) (Lexer: Lexer.S) = + struct + open Printf + (* Error printing and exception tracing *) + + let () = Printexc.record_backtrace true + + let external_ text = + Utils.highlight (sprintf "External error: %s" text); exit 1 + + (* 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 + + let () = + if Utils.String.Set.mem "cpp" IO.options#verbose + then eprintf "%s\n%!" cpp_cmd; + if Sys.command cpp_cmd <> 0 then + external_ (sprintf "the command \"%s\" failed." cpp_cmd) + + (* Running the lexer on the input file *) + + module Log = LexerLog.Make (Lexer) + + let () = Log.trace ~offsets:IO.options#offsets + IO.options#mode (Some pp_input) + IO.options#cmd + + end diff --git a/src/passes/1-parser/shared/ParserUnit.ml b/src/passes/1-parser/shared/ParserUnit.ml new file mode 100644 index 000000000..fe1af9559 --- /dev/null +++ b/src/passes/1-parser/shared/ParserUnit.ml @@ -0,0 +1,167 @@ +(* Functor to build a standalone LIGO parser *) + +module type S = + sig + val ext : string (* LIGO file extension *) + val options : EvalOpt.options (* CLI options *) + end + +module type Pretty = + sig + type state + type ast + val pp_ast : + state -> ast -> unit + val mk_state : + offsets:bool -> mode:[`Point|`Byte] -> buffer:Buffer.t -> state + val print_tokens : state -> ast -> unit + end + +module Make (IO: S) + (Lexer: Lexer.S) + (AST: sig type t type expr end) + (Parser: ParserAPI.PARSER + with type ast = AST.t + and type expr = AST.expr + and type token = Lexer.token) + (ParErr: sig val message : int -> string end) + (ParserLog: Pretty with type ast = AST.t) = + struct + open Printf + + (* Error printing and exception tracing *) + + let () = Printexc.record_backtrace true + + let external_ text = + Utils.highlight (sprintf "External error: %s" text); exit 1 + + (* Extracting the input file *) + + let file = + match IO.options#input with + None | Some "-" -> false + | Some _ -> 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 + + let () = + if Utils.String.Set.mem "cpp" IO.options#verbose + then eprintf "%s\n%!" cpp_cmd; + if Sys.command cpp_cmd <> 0 then + external_ (sprintf "the command \"%s\" failed." cpp_cmd) + + (* Instanciating the lexer *) + + module ParserFront = ParserAPI.Make (Lexer) (Parser) (ParErr) + + let lexer_inst = Lexer.open_token_stream (Some pp_input) + let Lexer.{read; buffer; get_win; get_pos; get_last; close} = lexer_inst + + and cout = stdout + + let close_all () = close (); close_out cout + + (* Tokeniser *) + + module Log = LexerLog.Make (Lexer) + + let log = Log.output_token ~offsets:IO.options#offsets + IO.options#mode IO.options#cmd cout + + let tokeniser = read ~log + + (* Main *) + + let () = + try + let ast = + if IO.options#mono + then ParserFront.mono_contract tokeniser buffer + else ParserFront.incr_contract lexer_inst in + if Utils.String.Set.mem "ast" IO.options#verbose + then let buffer = Buffer.create 131 in + let state = ParserLog.mk_state + ~offsets:IO.options#offsets + ~mode:IO.options#mode + ~buffer in + begin + ParserLog.pp_ast state ast; + Buffer.output_buffer stdout buffer + end + else if Utils.String.Set.mem "ast-tokens" IO.options#verbose + then let buffer = Buffer.create 131 in + let state = ParserLog.mk_state + ~offsets:IO.options#offsets + ~mode:IO.options#mode + ~buffer in + begin + ParserLog.print_tokens state ast; + Buffer.output_buffer stdout buffer + end + with + (* Lexing errors *) + Lexer.Error err -> + close_all (); + let msg = + Lexer.format_error ~offsets:IO.options#offsets + IO.options#mode err ~file + in prerr_string msg + + (* Incremental API of Menhir *) + | ParserFront.Point point -> + let () = close_all () in + let error = + ParserFront.format_error ~offsets:IO.options#offsets + IO.options#mode point + in eprintf "\027[31m%s\027[0m%!" error + + (* Monolithic API of Menhir *) + | Parser.Error -> + let () = close_all () in + let invalid, valid_opt = + match get_win () with + Lexer.Nil -> + assert false (* Safe: There is always at least EOF. *) + | Lexer.One invalid -> invalid, None + | Lexer.Two (invalid, valid) -> invalid, Some valid in + let point = "", valid_opt, invalid in + let error = + ParserFront.format_error ~offsets:IO.options#offsets + IO.options#mode point + in eprintf "\027[31m%s\027[0m%!" error + + (* I/O errors *) + | Sys_error msg -> Utils.highlight msg + + end