diff --git a/src/passes/1-parser/cameligo/.links b/src/passes/1-parser/cameligo/.links
index eca6c8680..a29429a42 100644
--- a/src/passes/1-parser/cameligo/.links
+++ b/src/passes/1-parser/cameligo/.links
@@ -16,4 +16,8 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
../shared/Markup.mli
../shared/Utils.mli
../shared/Utils.ml
+../shared/ParserAPI.mli
+../shared/ParserAPI.ml
+../shared/LexerUnit.ml
+../shared/ParserUnit.ml
Stubs/Simple_utils.ml
diff --git a/src/passes/1-parser/cameligo/LexerMain.ml b/src/passes/1-parser/cameligo/LexerMain.ml
index 80ae8b00d..e9775b803 100644
--- a/src/passes/1-parser/cameligo/LexerMain.ml
+++ b/src/passes/1-parser/cameligo/LexerMain.ml
@@ -1,56 +1,9 @@
-(** Driver for the LIGO lexer *)
+(** Driver for the CameLIGO lexer *)
-let extension = ".mligo"
-let options = EvalOpt.read "CameLIGO" extension
+module IO =
+ struct
+ let ext = ".mligo"
+ let options = EvalOpt.read "CameLIGO" ext
+ end
-(** Error printing and exception tracing
-*)
-let () = Printexc.record_backtrace true
-
-let external_ text =
- Utils.highlight (Printf.sprintf "External error: %s" text); exit 1;;
-
-(** {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 Running the lexer on the input file} *)
-
-module Log = LexerLog.Make (Lexer.Make (LexToken))
-
-let () = Log.trace ~offsets:options#offsets
- options#mode (Some pp_input) options#cmd
+module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))
diff --git a/src/passes/1-parser/cameligo/ParserAPI.mli b/src/passes/1-parser/cameligo/ParserAPI.mli
deleted file mode 100644
index 7d969a33c..000000000
--- a/src/passes/1-parser/cameligo/ParserAPI.mli
+++ /dev/null
@@ -1,22 +0,0 @@
-(** Generic parser API for LIGO *)
-
-module Make (Lexer: Lexer.S with module Token := LexToken)
- (Parser: module type of Parser)
- (ParErr: sig val message: int -> string end) :
- sig
- (* Monolithic and incremental APIs of Menhir for parsing *)
-
- val mono_contract : (Lexing.lexbuf -> Lexer.token) -> Lexing.lexbuf -> AST.t
- val incr_contract : Lexer.instance -> AST.t
-
- (* Error handling *)
-
- type message = string
- type valid = Lexer.token
- type invalid = Lexer.token
- type error = message * valid option * invalid
-
- exception Point of error
-
- val format_error : ?offsets:bool -> [`Byte | `Point] -> error -> string
- end
diff --git a/src/passes/1-parser/cameligo/ParserMain.ml b/src/passes/1-parser/cameligo/ParserMain.ml
index 8ed546f50..855dc639e 100644
--- a/src/passes/1-parser/cameligo/ParserMain.ml
+++ b/src/passes/1-parser/cameligo/ParserMain.ml
@@ -1,145 +1,27 @@
(** Driver for the CameLIGO parser *)
-let extension = ".mligo"
-let options = EvalOpt.read "CameLIGO" extension
+module IO =
+ struct
+ let ext = ".mligo"
+ let options = EvalOpt.read "CameLIGO" ext
+ end
-open Printf
+module ExtParser =
+ struct
+ type ast = AST.t
+ type expr = AST.expr
+ include Parser
+ end
-(** Error printing and exception tracing
-*)
-let () = Printexc.record_backtrace true
+module ExtParserLog =
+ struct
+ type ast = AST.t
+ include ParserLog
+ end
-(** 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 (sprintf "External error: %s" text); exit 1;;
-
-(** {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 = 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 "-" ->
- 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" options#verbose
- then eprintf "%s\n%!" cpp_cmd;
- if Sys.command cpp_cmd <> 0 then
- external_ (sprintf "the command \"%s\" failed." cpp_cmd)
-
-(** {1 Instanciating the lexer} *)
-
-module Lexer = Lexer.Make (LexToken)
-module Log = LexerLog.Make (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 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 =
- if options#mono
- then ParserFront.mono_contract tokeniser buffer
- else ParserFront.incr_contract lexer_inst 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
- (* Lexing errors *)
- Lexer.Error err ->
- close_all ();
- let msg =
- Lexer.format_error ~offsets:options#offsets
- 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:options#offsets
- 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:options#offsets
- options#mode point
- in eprintf "\027[31m%s\027[0m%!" error
-
- (* I/O errors *)
- | Sys_error msg -> Utils.highlight msg
+module M = ParserUnit.Make (IO)
+ (Lexer.Make (LexToken))
+ (AST)
+ (ExtParser)
+ (ParErr)
+ (ExtParserLog)
diff --git a/src/passes/1-parser/cameligo/dune b/src/passes/1-parser/cameligo/dune
index 95290beb8..e9f496034 100644
--- a/src/passes/1-parser/cameligo/dune
+++ b/src/passes/1-parser/cameligo/dune
@@ -15,9 +15,9 @@
str
simple-utils
tezos-utils
- getopt )
+ getopt)
(preprocess
- (pps bisect_ppx --conditional) )
+ (pps bisect_ppx --conditional))
(flags (:standard -open Simple_utils -open Parser_shared)))
(executable
@@ -32,7 +32,7 @@
(name ParserMain)
(libraries parser_cameligo)
(modules
- ParErr ParserAPI ParserMain)
+ ParErr ParserMain)
(preprocess
(pps bisect_ppx --conditional))
(flags (:standard -open Simple_utils -open Parser_shared -open Parser_cameligo)))
diff --git a/src/passes/1-parser/pascaligo/.links b/src/passes/1-parser/pascaligo/.links
index eca6c8680..a29429a42 100644
--- a/src/passes/1-parser/pascaligo/.links
+++ b/src/passes/1-parser/pascaligo/.links
@@ -16,4 +16,8 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
../shared/Markup.mli
../shared/Utils.mli
../shared/Utils.ml
+../shared/ParserAPI.mli
+../shared/ParserAPI.ml
+../shared/LexerUnit.ml
+../shared/ParserUnit.ml
Stubs/Simple_utils.ml
diff --git a/src/passes/1-parser/pascaligo/LexerMain.ml b/src/passes/1-parser/pascaligo/LexerMain.ml
index 9838fcbc4..4f1940204 100644
--- a/src/passes/1-parser/pascaligo/LexerMain.ml
+++ b/src/passes/1-parser/pascaligo/LexerMain.ml
@@ -1,56 +1,9 @@
-(** Driver for the LIGO lexer *)
+(** Driver for the PascaLIGO lexer *)
-let extension = ".ligo"
-let options = EvalOpt.read "PascaLIGO" extension
+module IO =
+ struct
+ let ext = ".ligo"
+ let options = EvalOpt.read "PascaLIGO" ext
+ end
-(** Error printing and exception tracing
-*)
-let () = Printexc.record_backtrace true
-
-let external_ text =
- Utils.highlight (Printf.sprintf "External error: %s" text); exit 1;;
-
-(** {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 Running the lexer on the input file} *)
-
-module Log = LexerLog.Make (Lexer.Make (LexToken))
-
-let () = Log.trace ~offsets:options#offsets
- options#mode (Some pp_input) options#cmd
+module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))
diff --git a/src/passes/1-parser/pascaligo/ParserAPI.ml b/src/passes/1-parser/pascaligo/ParserAPI.ml
deleted file mode 100644
index df82173a9..000000000
--- a/src/passes/1-parser/pascaligo/ParserAPI.ml
+++ /dev/null
@@ -1,82 +0,0 @@
-(* Generic parser for LIGO *)
-
-(* Main functor *)
-
-module Make (Lexer: Lexer.S with module Token := LexToken)
- (Parser: module type of Parser)
- (ParErr: sig val message : int -> string end) =
- struct
- module I = Parser.MenhirInterpreter
- module S = MenhirLib.General (* Streams *)
-
- (* The call [stack checkpoint] extracts the parser's stack out of
- a checkpoint. *)
-
- let stack = function
- I.HandlingError env -> I.stack env
- | _ -> assert false
-
- (* The call [state checkpoint] extracts the number of the current
- state out of a parser checkpoint. *)
-
- let state checkpoint : int =
- match Lazy.force (stack checkpoint) with
- S.Nil -> 0 (* WARNING: Hack. The first state should be 0. *)
- | S.Cons (I.Element (s,_,_,_),_) -> I.number s
-
- (* The parser has successfully produced a semantic value. *)
-
- let success v = v
-
- (* The parser has suspended itself because of a syntax error. Stop. *)
-
- type message = string
- type valid = Lexer.token
- type invalid = Lexer.token
- type error = message * valid option * invalid
-
- exception Point of error
-
- let failure get_win checkpoint =
- let message = ParErr.message (state checkpoint) in
- match get_win () with
- Lexer.Nil -> assert false
- | Lexer.One invalid ->
- raise (Point (message, None, invalid))
- | Lexer.Two (invalid, valid) ->
- raise (Point (message, Some valid, invalid))
-
- (* The two Menhir APIs are called from the following two functions. *)
-
- let incr_contract Lexer.{read; buffer; get_win; close; _} : AST.t =
- let supplier = I.lexer_lexbuf_to_supplier read buffer
- and failure = failure get_win in
- let parser = Parser.Incremental.contract buffer.Lexing.lex_curr_p in
- let ast = I.loop_handle success failure supplier parser
- in close (); ast
-
- let mono_contract = Parser.contract
-
- (* Errors *)
-
- let format_error ?(offsets=true) mode (msg, valid_opt, invalid) =
- let invalid_region = LexToken.to_region invalid in
- let header =
- "Parse error " ^ invalid_region#to_string ~offsets mode in
- let trailer =
- match valid_opt with
- None ->
- if LexToken.is_eof invalid then ""
- else let invalid_lexeme = LexToken.to_lexeme invalid in
- Printf.sprintf ", before \"%s\"" invalid_lexeme
- | Some valid ->
- let valid_lexeme = LexToken.to_lexeme valid in
- let s = Printf.sprintf ", after \"%s\"" valid_lexeme in
- if LexToken.is_eof invalid then s
- else
- let invalid_lexeme = LexToken.to_lexeme invalid in
- Printf.sprintf "%s and before \"%s\"" s invalid_lexeme in
- let header = header ^ trailer in
- header ^ (if msg = "" then ".\n" else ":\n" ^ msg)
-
- end
diff --git a/src/passes/1-parser/pascaligo/ParserAPI.mli b/src/passes/1-parser/pascaligo/ParserAPI.mli
deleted file mode 100644
index afc0fb8ba..000000000
--- a/src/passes/1-parser/pascaligo/ParserAPI.mli
+++ /dev/null
@@ -1,22 +0,0 @@
-(** Generic parser API for LIGO *)
-
-module Make (Lexer: Lexer.S with module Token := LexToken)
- (Parser: module type of Parser)
- (ParErr: module type of ParErr) :
- sig
- (* Monolithic and incremental APIs of Menhir for parsing *)
-
- val mono_contract : (Lexing.lexbuf -> Lexer.token) -> Lexing.lexbuf -> AST.t
- val incr_contract : Lexer.instance -> AST.t
-
- (* Error handling *)
-
- type message = string
- type valid = Lexer.token
- type invalid = Lexer.token
- type error = message * valid option * invalid
-
- exception Point of error
-
- val format_error : ?offsets:bool -> [`Byte | `Point] -> error -> string
- end
diff --git a/src/passes/1-parser/pascaligo/ParserMain.ml b/src/passes/1-parser/pascaligo/ParserMain.ml
index 489008453..3fcae9dec 100644
--- a/src/passes/1-parser/pascaligo/ParserMain.ml
+++ b/src/passes/1-parser/pascaligo/ParserMain.ml
@@ -1,145 +1,27 @@
(** Driver for the PascaLIGO parser *)
-let extension = ".ligo"
-let options = EvalOpt.read "PascaLIGO" extension
+module IO =
+ struct
+ let ext = ".ligo"
+ let options = EvalOpt.read "PascaLIGO" ext
+ end
-open Printf
+module ExtParser =
+ struct
+ type ast = AST.t
+ type expr = AST.expr
+ include Parser
+ end
-(** Error printing and exception tracing
-*)
-let () = Printexc.record_backtrace true
+module ExtParserLog =
+ struct
+ type ast = AST.t
+ include ParserLog
+ end
-(** 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 (sprintf "External error: %s" text); exit 1;;
-
-(** {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 = 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 "-" ->
- 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" options#verbose
- then eprintf "%s\n%!" cpp_cmd;
- if Sys.command cpp_cmd <> 0 then
- external_ (sprintf "the command \"%s\" failed." cpp_cmd)
-
-(** {1 Instanciating the lexer} *)
-
-module Lexer = Lexer.Make (LexToken)
-module Log = LexerLog.Make (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 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 =
- if options#mono
- then ParserFront.mono_contract tokeniser buffer
- else ParserFront.incr_contract lexer_inst 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
- (* Lexing errors *)
- Lexer.Error err ->
- close_all ();
- let msg =
- Lexer.format_error ~offsets:options#offsets
- 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:options#offsets
- 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:options#offsets
- options#mode point
- in eprintf "\027[31m%s\027[0m%!" error
-
- (* I/O errors *)
- | Sys_error msg -> Utils.highlight msg
+module M = ParserUnit.Make (IO)
+ (Lexer.Make (LexToken))
+ (AST)
+ (ExtParser)
+ (ParErr)
+ (ExtParserLog)
diff --git a/src/passes/1-parser/pascaligo/dune b/src/passes/1-parser/pascaligo/dune
index 908455acb..1c12ca706 100644
--- a/src/passes/1-parser/pascaligo/dune
+++ b/src/passes/1-parser/pascaligo/dune
@@ -10,15 +10,14 @@
(public_name ligo.parser.pascaligo)
(modules AST pascaligo Parser ParserLog LexToken)
(libraries
- menhirLib
- parser_shared
- hex
- simple-utils
- tezos-utils
- )
+ menhirLib
+ parser_shared
+ hex
+ simple-utils
+ tezos-utils)
(preprocess
(pps bisect_ppx --conditional))
- (flags (:standard -open Parser_shared -open Simple_utils)))
+ (flags (:standard -open Parser_shared -open Simple_utils)))
(executable
(name LexerMain)
@@ -33,7 +32,7 @@
(name ParserMain)
(libraries parser_pascaligo)
(modules
- ParErr ParserAPI ParserMain)
+ ParErr ParserMain)
(preprocess
(pps bisect_ppx --conditional))
(flags (:standard -open Simple_utils -open Parser_shared -open Parser_pascaligo)))
diff --git a/src/passes/1-parser/reasonligo/.links b/src/passes/1-parser/reasonligo/.links
index e827ae13e..e972ad9c6 100644
--- a/src/passes/1-parser/reasonligo/.links
+++ b/src/passes/1-parser/reasonligo/.links
@@ -16,6 +16,10 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
../shared/Markup.mli
../shared/Utils.mli
../shared/Utils.ml
+../shared/ParserAPI.mli
+../shared/ParserAPI.ml
+../shared/LexerUnit.ml
+../shared/ParserUnit.ml
Stubs/Simple_utils.ml
Stubs/Parser_cameligo.ml
../cameligo/AST.mli
diff --git a/src/passes/1-parser/reasonligo/LexerMain.ml b/src/passes/1-parser/reasonligo/LexerMain.ml
index b49af81ff..756a2f103 100644
--- a/src/passes/1-parser/reasonligo/LexerMain.ml
+++ b/src/passes/1-parser/reasonligo/LexerMain.ml
@@ -1,56 +1,9 @@
-(** Driver for the LIGO lexer *)
+(** Driver for the ReasonLIGO lexer *)
-let extension = ".religo"
-let options = EvalOpt.read "ReasonLIGO" extension
+module IO =
+ struct
+ let ext = ".religo"
+ let options = EvalOpt.read "ReasonLIGO" ext
+ end
-(** Error printing and exception tracing
-*)
-let () = Printexc.record_backtrace true
-
-let external_ text =
- Utils.highlight (Printf.sprintf "External error: %s" text); exit 1;;
-
-(** {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 Running the lexer on the input file} *)
-
-module Log = LexerLog.Make (Lexer.Make (LexToken))
-
-let () = Log.trace ~offsets:options#offsets
- options#mode (Some pp_input) options#cmd
+module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))
diff --git a/src/passes/1-parser/reasonligo/ParserAPI.ml b/src/passes/1-parser/reasonligo/ParserAPI.ml
deleted file mode 100644
index df82173a9..000000000
--- a/src/passes/1-parser/reasonligo/ParserAPI.ml
+++ /dev/null
@@ -1,82 +0,0 @@
-(* Generic parser for LIGO *)
-
-(* Main functor *)
-
-module Make (Lexer: Lexer.S with module Token := LexToken)
- (Parser: module type of Parser)
- (ParErr: sig val message : int -> string end) =
- struct
- module I = Parser.MenhirInterpreter
- module S = MenhirLib.General (* Streams *)
-
- (* The call [stack checkpoint] extracts the parser's stack out of
- a checkpoint. *)
-
- let stack = function
- I.HandlingError env -> I.stack env
- | _ -> assert false
-
- (* The call [state checkpoint] extracts the number of the current
- state out of a parser checkpoint. *)
-
- let state checkpoint : int =
- match Lazy.force (stack checkpoint) with
- S.Nil -> 0 (* WARNING: Hack. The first state should be 0. *)
- | S.Cons (I.Element (s,_,_,_),_) -> I.number s
-
- (* The parser has successfully produced a semantic value. *)
-
- let success v = v
-
- (* The parser has suspended itself because of a syntax error. Stop. *)
-
- type message = string
- type valid = Lexer.token
- type invalid = Lexer.token
- type error = message * valid option * invalid
-
- exception Point of error
-
- let failure get_win checkpoint =
- let message = ParErr.message (state checkpoint) in
- match get_win () with
- Lexer.Nil -> assert false
- | Lexer.One invalid ->
- raise (Point (message, None, invalid))
- | Lexer.Two (invalid, valid) ->
- raise (Point (message, Some valid, invalid))
-
- (* The two Menhir APIs are called from the following two functions. *)
-
- let incr_contract Lexer.{read; buffer; get_win; close; _} : AST.t =
- let supplier = I.lexer_lexbuf_to_supplier read buffer
- and failure = failure get_win in
- let parser = Parser.Incremental.contract buffer.Lexing.lex_curr_p in
- let ast = I.loop_handle success failure supplier parser
- in close (); ast
-
- let mono_contract = Parser.contract
-
- (* Errors *)
-
- let format_error ?(offsets=true) mode (msg, valid_opt, invalid) =
- let invalid_region = LexToken.to_region invalid in
- let header =
- "Parse error " ^ invalid_region#to_string ~offsets mode in
- let trailer =
- match valid_opt with
- None ->
- if LexToken.is_eof invalid then ""
- else let invalid_lexeme = LexToken.to_lexeme invalid in
- Printf.sprintf ", before \"%s\"" invalid_lexeme
- | Some valid ->
- let valid_lexeme = LexToken.to_lexeme valid in
- let s = Printf.sprintf ", after \"%s\"" valid_lexeme in
- if LexToken.is_eof invalid then s
- else
- let invalid_lexeme = LexToken.to_lexeme invalid in
- Printf.sprintf "%s and before \"%s\"" s invalid_lexeme in
- let header = header ^ trailer in
- header ^ (if msg = "" then ".\n" else ":\n" ^ msg)
-
- end
diff --git a/src/passes/1-parser/reasonligo/ParserAPI.mli b/src/passes/1-parser/reasonligo/ParserAPI.mli
deleted file mode 100644
index 7d969a33c..000000000
--- a/src/passes/1-parser/reasonligo/ParserAPI.mli
+++ /dev/null
@@ -1,22 +0,0 @@
-(** Generic parser API for LIGO *)
-
-module Make (Lexer: Lexer.S with module Token := LexToken)
- (Parser: module type of Parser)
- (ParErr: sig val message: int -> string end) :
- sig
- (* Monolithic and incremental APIs of Menhir for parsing *)
-
- val mono_contract : (Lexing.lexbuf -> Lexer.token) -> Lexing.lexbuf -> AST.t
- val incr_contract : Lexer.instance -> AST.t
-
- (* Error handling *)
-
- type message = string
- type valid = Lexer.token
- type invalid = Lexer.token
- type error = message * valid option * invalid
-
- exception Point of error
-
- val format_error : ?offsets:bool -> [`Byte | `Point] -> error -> string
- end
diff --git a/src/passes/1-parser/reasonligo/ParserMain.ml b/src/passes/1-parser/reasonligo/ParserMain.ml
index 0af4c4a76..ee7d562de 100644
--- a/src/passes/1-parser/reasonligo/ParserMain.ml
+++ b/src/passes/1-parser/reasonligo/ParserMain.ml
@@ -1,145 +1,27 @@
-(** Driver for the Reason LIGO parser *)
+(** Driver for the ReasonLIGO parser *)
-let extension = ".religo"
-let options = EvalOpt.read "ReasonLIGO" extension
+module IO =
+ struct
+ let ext = ".religo"
+ let options = EvalOpt.read "ReasonLIGO" ext
+ end
-open Printf
+module ExtParser =
+ struct
+ type ast = AST.t
+ type expr = AST.expr
+ include Parser
+ end
-(** Error printing and exception tracing
-*)
-let () = Printexc.record_backtrace true
+module ExtParserLog =
+ struct
+ type ast = AST.t
+ include ParserLog
+ end
-(** 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 (sprintf "External error: %s" text); exit 1;;
-
-(** {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 = 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 "-" ->
- 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" options#verbose
- then eprintf "%s\n%!" cpp_cmd;
- if Sys.command cpp_cmd <> 0 then
- external_ (sprintf "the command \"%s\" failed." cpp_cmd)
-
-(** {1 Instanciating the lexer} *)
-
-module Lexer = Lexer.Make (LexToken)
-module Log = LexerLog.Make (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 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 =
- if options#mono
- then ParserFront.mono_contract tokeniser buffer
- else ParserFront.incr_contract lexer_inst 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
- (* Lexing errors *)
- Lexer.Error err ->
- close_all ();
- let msg =
- Lexer.format_error ~offsets:options#offsets
- 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:options#offsets
- 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:options#offsets
- options#mode point
- in eprintf "\027[31m%s\027[0m%!" error
-
- (* I/O errors *)
- | Sys_error msg -> Utils.highlight msg
+module M = ParserUnit.Make (IO)
+ (Lexer.Make (LexToken))
+ (AST)
+ (ExtParser)
+ (ParErr)
+ (ExtParserLog)
diff --git a/src/passes/1-parser/reasonligo/dune b/src/passes/1-parser/reasonligo/dune
index 39250ecc8..e59426b63 100644
--- a/src/passes/1-parser/reasonligo/dune
+++ b/src/passes/1-parser/reasonligo/dune
@@ -36,7 +36,7 @@
parser_reasonligo
parser_cameligo)
(modules
- ParErr ParserAPI ParserMain)
+ ParErr ParserMain)
(preprocess
(pps bisect_ppx --conditional))
(flags (:standard -open Simple_utils -open Parser_cameligo -open Parser_shared -open Parser_reasonligo)))
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/cameligo/ParserAPI.ml b/src/passes/1-parser/shared/ParserAPI.ml
similarity index 59%
rename from src/passes/1-parser/cameligo/ParserAPI.ml
rename to src/passes/1-parser/shared/ParserAPI.ml
index df82173a9..e24be2b48 100644
--- a/src/passes/1-parser/cameligo/ParserAPI.ml
+++ b/src/passes/1-parser/shared/ParserAPI.ml
@@ -1,9 +1,47 @@
(* Generic parser for LIGO *)
+module type PARSER =
+ sig
+ (* The type of tokens, abstract syntax trees and expressions *)
+
+ type token
+ type ast
+ type expr
+
+ (* This exception is raised by the monolithic API functions. *)
+
+ exception Error
+
+ (* The monolithic API. *)
+
+ val interactive_expr :
+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> expr
+ val contract :
+ (Lexing.lexbuf -> token) -> Lexing.lexbuf -> ast
+
+ module MenhirInterpreter :
+ sig
+ (* The incremental API. *)
+
+ include MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE
+ with type token = token
+ end
+
+ (* The entry point(s) to the incremental API. *)
+
+ module Incremental :
+ sig
+ val interactive_expr :
+ Lexing.position -> expr MenhirInterpreter.checkpoint
+ val contract :
+ Lexing.position -> ast MenhirInterpreter.checkpoint
+ end
+ end
+
(* Main functor *)
-module Make (Lexer: Lexer.S with module Token := LexToken)
- (Parser: module type of Parser)
+module Make (Lexer: Lexer.S)
+ (Parser: PARSER with type token = Lexer.Token.token)
(ParErr: sig val message : int -> string end) =
struct
module I = Parser.MenhirInterpreter
@@ -31,9 +69,9 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
(* The parser has suspended itself because of a syntax error. Stop. *)
type message = string
- type valid = Lexer.token
- type invalid = Lexer.token
- type error = message * valid option * invalid
+ type valid = Parser.token
+ type invalid = Parser.token
+ type error = message * valid option * invalid
exception Point of error
@@ -48,7 +86,7 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
(* The two Menhir APIs are called from the following two functions. *)
- let incr_contract Lexer.{read; buffer; get_win; close; _} : AST.t =
+ let incr_contract Lexer.{read; buffer; get_win; close; _} : Parser.ast =
let supplier = I.lexer_lexbuf_to_supplier read buffer
and failure = failure get_win in
let parser = Parser.Incremental.contract buffer.Lexing.lex_curr_p in
@@ -60,21 +98,21 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
(* Errors *)
let format_error ?(offsets=true) mode (msg, valid_opt, invalid) =
- let invalid_region = LexToken.to_region invalid in
+ let invalid_region = Lexer.Token.to_region invalid in
let header =
"Parse error " ^ invalid_region#to_string ~offsets mode in
let trailer =
match valid_opt with
None ->
- if LexToken.is_eof invalid then ""
- else let invalid_lexeme = LexToken.to_lexeme invalid in
+ if Lexer.Token.is_eof invalid then ""
+ else let invalid_lexeme = Lexer.Token.to_lexeme invalid in
Printf.sprintf ", before \"%s\"" invalid_lexeme
| Some valid ->
- let valid_lexeme = LexToken.to_lexeme valid in
+ let valid_lexeme = Lexer.Token.to_lexeme valid in
let s = Printf.sprintf ", after \"%s\"" valid_lexeme in
- if LexToken.is_eof invalid then s
+ if Lexer.Token.is_eof invalid then s
else
- let invalid_lexeme = LexToken.to_lexeme invalid in
+ let invalid_lexeme = Lexer.Token.to_lexeme invalid in
Printf.sprintf "%s and before \"%s\"" s invalid_lexeme in
let header = header ^ trailer in
header ^ (if msg = "" then ".\n" else ":\n" ^ msg)
diff --git a/src/passes/1-parser/shared/ParserAPI.mli b/src/passes/1-parser/shared/ParserAPI.mli
new file mode 100644
index 000000000..79ca137c4
--- /dev/null
+++ b/src/passes/1-parser/shared/ParserAPI.mli
@@ -0,0 +1,60 @@
+(* Generic parser API for LIGO *)
+
+module type PARSER =
+ sig
+ (* The type of tokens. *)
+
+ type token
+ type ast
+ type expr
+
+ (* This exception is raised by the monolithic API functions. *)
+
+ exception Error
+
+ (* The monolithic API. *)
+
+ val interactive_expr : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> expr
+ val contract : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> ast
+
+ (* The incremental API. *)
+
+ module MenhirInterpreter :
+ sig
+ include MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE
+ with type token = token
+ end
+
+ (* The entry point(s) to the incremental API. *)
+
+ module Incremental :
+ sig
+ val interactive_expr :
+ Lexing.position -> expr MenhirInterpreter.checkpoint
+ val contract :
+ Lexing.position -> ast MenhirInterpreter.checkpoint
+ end
+ end
+
+module Make (Lexer: Lexer.S)
+ (Parser: PARSER with type token = Lexer.Token.token)
+ (ParErr: sig val message : int -> string end) :
+ sig
+ (* Monolithic and incremental APIs of Menhir for parsing *)
+
+ val mono_contract :
+ (Lexing.lexbuf -> Lexer.token) -> Lexing.lexbuf -> Parser.ast
+ val incr_contract :
+ Lexer.instance -> Parser.ast
+
+ (* Error handling *)
+
+ type message = string
+ type valid = Parser.token
+ type invalid = Parser.token
+ type error = message * valid option * invalid
+
+ exception Point of error
+
+ val format_error : ?offsets:bool -> [`Byte | `Point] -> error -> string
+ 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
diff --git a/src/passes/1-parser/shared/dune b/src/passes/1-parser/shared/dune
index ca41804a8..10e377a93 100644
--- a/src/passes/1-parser/shared/dune
+++ b/src/passes/1-parser/shared/dune
@@ -4,15 +4,17 @@
(name parser_shared)
(public_name ligo.parser.shared)
(libraries
+ menhirLib
simple-utils
uutf
getopt
- zarith
- )
+ zarith)
(preprocess
- (pps bisect_ppx --conditional)
- )
+ (pps bisect_ppx --conditional))
(modules
+ LexerUnit
+ ParserUnit
+ ParserAPI
Lexer
LexerLog
Utils