From 379311a7488fd54f1b85f6fed46f4499124cf4ec Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Thu, 26 Dec 2019 18:17:57 +0100 Subject: [PATCH] Shortened the parser's API. Unfortunately, even thought all the front-ends use the same ParserAPI.ml, that file cannot be moved to the folder `shared` due to a dependency on AST.ml produced by Menhir. --- src/passes/1-parser/cameligo/ParserAPI.ml | 162 ++++++++----------- src/passes/1-parser/cameligo/ParserAPI.mli | 40 +---- src/passes/1-parser/pascaligo/ParserAPI.ml | 162 ++++++++----------- src/passes/1-parser/pascaligo/ParserAPI.mli | 40 +---- src/passes/1-parser/reasonligo/ParserAPI.ml | 162 ++++++++----------- src/passes/1-parser/reasonligo/ParserAPI.mli | 40 +---- src/passes/1-parser/shared/dune | 4 +- 7 files changed, 202 insertions(+), 408 deletions(-) diff --git a/src/passes/1-parser/cameligo/ParserAPI.ml b/src/passes/1-parser/cameligo/ParserAPI.ml index 0c78cdeec..abfdad840 100644 --- a/src/passes/1-parser/cameligo/ParserAPI.ml +++ b/src/passes/1-parser/cameligo/ParserAPI.ml @@ -1,98 +1,64 @@ -(** Generic parser for LIGO *) - -module type PARSER = - sig - (* The type of tokens *) - - type token - - (* This exception is raised by the monolithic API functions *) - - exception Error - - (* The monolithic API *) - - val contract : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> AST.t - - (* The incremental API *) - - module MenhirInterpreter : - sig - include MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE - with type token = token - end - - module Incremental : - sig - val contract : Lexing.position -> AST.t MenhirInterpreter.checkpoint - end - end - -(* Errors *) - -module type PAR_ERR = - sig - val message : int -> string (* From error states to messages *) - end - -let format_error ?(offsets=true) mode Region.{region; value} ~file = - let reg = region#to_string ~file ~offsets mode in - Printf.sprintf "\027[31mParse error %s:\n%s\027[0m%!" reg value - -(* Main functor *) - -module Make (Lexer: Lexer.S) - (Parser: PARSER with type token = Lexer.Token.token) - (ParErr: PAR_ERR) = - struct - type message = string - type valid = Lexer.token - type invalid = Lexer.token - - exception Point of message * valid option * invalid - - 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. *) - - 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 generic parsing function *) - - 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 - - end +(** Generic parser for LIGO *) + +(* Errors *) + +let format_error ?(offsets=true) mode Region.{region; value} ~file = + let reg = region#to_string ~file ~offsets mode in + Printf.sprintf "\027[31mParse error %s:\n%s\027[0m%!" reg value + +(* Main functor *) + +module Make (Lexer: Lexer.S with module Token := LexToken) + (Parser: module type of Parser) + (ParErr: sig val message : int -> string end) = + struct + type message = string + type valid = Lexer.token + type invalid = Lexer.token + + exception Point of message * valid option * invalid + + 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. *) + + 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 generic parsing function *) + + 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 + end diff --git a/src/passes/1-parser/cameligo/ParserAPI.mli b/src/passes/1-parser/cameligo/ParserAPI.mli index f3eeaaba8..239d076ee 100644 --- a/src/passes/1-parser/cameligo/ParserAPI.mli +++ b/src/passes/1-parser/cameligo/ParserAPI.mli @@ -1,50 +1,16 @@ (** Generic parser API for LIGO *) -module type PARSER = - sig - (* The type of tokens *) - - type token - - (* This exception is raised by the monolithic API functions *) - - exception Error - - (* The monolithic API *) - - val contract : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> AST.t - - (* The incremental API *) - - module MenhirInterpreter : - sig - include MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE - with type token = token - end - - module Incremental : - sig - val contract : Lexing.position -> AST.t MenhirInterpreter.checkpoint - end - - end - (* Errors *) -module type PAR_ERR = - sig - val message : int -> string (* From error states to messages *) - end - val format_error : ?offsets:bool -> [`Byte | `Point] -> string Region.reg -> file:bool -> string (* Main functor *) -module Make (Lexer: Lexer.S) - (Parser: PARSER with type token = Lexer.Token.token) - (ParErr: PAR_ERR) : +module Make (Lexer: Lexer.S with module Token := LexToken) + (Parser: module type of Parser) + (ParErr: sig val message: int -> string end) : sig type message = string type valid = Lexer.token diff --git a/src/passes/1-parser/pascaligo/ParserAPI.ml b/src/passes/1-parser/pascaligo/ParserAPI.ml index 0c78cdeec..abfdad840 100644 --- a/src/passes/1-parser/pascaligo/ParserAPI.ml +++ b/src/passes/1-parser/pascaligo/ParserAPI.ml @@ -1,98 +1,64 @@ -(** Generic parser for LIGO *) - -module type PARSER = - sig - (* The type of tokens *) - - type token - - (* This exception is raised by the monolithic API functions *) - - exception Error - - (* The monolithic API *) - - val contract : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> AST.t - - (* The incremental API *) - - module MenhirInterpreter : - sig - include MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE - with type token = token - end - - module Incremental : - sig - val contract : Lexing.position -> AST.t MenhirInterpreter.checkpoint - end - end - -(* Errors *) - -module type PAR_ERR = - sig - val message : int -> string (* From error states to messages *) - end - -let format_error ?(offsets=true) mode Region.{region; value} ~file = - let reg = region#to_string ~file ~offsets mode in - Printf.sprintf "\027[31mParse error %s:\n%s\027[0m%!" reg value - -(* Main functor *) - -module Make (Lexer: Lexer.S) - (Parser: PARSER with type token = Lexer.Token.token) - (ParErr: PAR_ERR) = - struct - type message = string - type valid = Lexer.token - type invalid = Lexer.token - - exception Point of message * valid option * invalid - - 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. *) - - 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 generic parsing function *) - - 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 - - end +(** Generic parser for LIGO *) + +(* Errors *) + +let format_error ?(offsets=true) mode Region.{region; value} ~file = + let reg = region#to_string ~file ~offsets mode in + Printf.sprintf "\027[31mParse error %s:\n%s\027[0m%!" reg value + +(* Main functor *) + +module Make (Lexer: Lexer.S with module Token := LexToken) + (Parser: module type of Parser) + (ParErr: sig val message : int -> string end) = + struct + type message = string + type valid = Lexer.token + type invalid = Lexer.token + + exception Point of message * valid option * invalid + + 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. *) + + 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 generic parsing function *) + + 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 + end diff --git a/src/passes/1-parser/pascaligo/ParserAPI.mli b/src/passes/1-parser/pascaligo/ParserAPI.mli index f3eeaaba8..239d076ee 100644 --- a/src/passes/1-parser/pascaligo/ParserAPI.mli +++ b/src/passes/1-parser/pascaligo/ParserAPI.mli @@ -1,50 +1,16 @@ (** Generic parser API for LIGO *) -module type PARSER = - sig - (* The type of tokens *) - - type token - - (* This exception is raised by the monolithic API functions *) - - exception Error - - (* The monolithic API *) - - val contract : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> AST.t - - (* The incremental API *) - - module MenhirInterpreter : - sig - include MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE - with type token = token - end - - module Incremental : - sig - val contract : Lexing.position -> AST.t MenhirInterpreter.checkpoint - end - - end - (* Errors *) -module type PAR_ERR = - sig - val message : int -> string (* From error states to messages *) - end - val format_error : ?offsets:bool -> [`Byte | `Point] -> string Region.reg -> file:bool -> string (* Main functor *) -module Make (Lexer: Lexer.S) - (Parser: PARSER with type token = Lexer.Token.token) - (ParErr: PAR_ERR) : +module Make (Lexer: Lexer.S with module Token := LexToken) + (Parser: module type of Parser) + (ParErr: sig val message: int -> string end) : sig type message = string type valid = Lexer.token diff --git a/src/passes/1-parser/reasonligo/ParserAPI.ml b/src/passes/1-parser/reasonligo/ParserAPI.ml index 0c78cdeec..abfdad840 100644 --- a/src/passes/1-parser/reasonligo/ParserAPI.ml +++ b/src/passes/1-parser/reasonligo/ParserAPI.ml @@ -1,98 +1,64 @@ -(** Generic parser for LIGO *) - -module type PARSER = - sig - (* The type of tokens *) - - type token - - (* This exception is raised by the monolithic API functions *) - - exception Error - - (* The monolithic API *) - - val contract : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> AST.t - - (* The incremental API *) - - module MenhirInterpreter : - sig - include MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE - with type token = token - end - - module Incremental : - sig - val contract : Lexing.position -> AST.t MenhirInterpreter.checkpoint - end - end - -(* Errors *) - -module type PAR_ERR = - sig - val message : int -> string (* From error states to messages *) - end - -let format_error ?(offsets=true) mode Region.{region; value} ~file = - let reg = region#to_string ~file ~offsets mode in - Printf.sprintf "\027[31mParse error %s:\n%s\027[0m%!" reg value - -(* Main functor *) - -module Make (Lexer: Lexer.S) - (Parser: PARSER with type token = Lexer.Token.token) - (ParErr: PAR_ERR) = - struct - type message = string - type valid = Lexer.token - type invalid = Lexer.token - - exception Point of message * valid option * invalid - - 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. *) - - 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 generic parsing function *) - - 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 - - end +(** Generic parser for LIGO *) + +(* Errors *) + +let format_error ?(offsets=true) mode Region.{region; value} ~file = + let reg = region#to_string ~file ~offsets mode in + Printf.sprintf "\027[31mParse error %s:\n%s\027[0m%!" reg value + +(* Main functor *) + +module Make (Lexer: Lexer.S with module Token := LexToken) + (Parser: module type of Parser) + (ParErr: sig val message : int -> string end) = + struct + type message = string + type valid = Lexer.token + type invalid = Lexer.token + + exception Point of message * valid option * invalid + + 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. *) + + 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 generic parsing function *) + + 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 + end diff --git a/src/passes/1-parser/reasonligo/ParserAPI.mli b/src/passes/1-parser/reasonligo/ParserAPI.mli index f3eeaaba8..239d076ee 100644 --- a/src/passes/1-parser/reasonligo/ParserAPI.mli +++ b/src/passes/1-parser/reasonligo/ParserAPI.mli @@ -1,50 +1,16 @@ (** Generic parser API for LIGO *) -module type PARSER = - sig - (* The type of tokens *) - - type token - - (* This exception is raised by the monolithic API functions *) - - exception Error - - (* The monolithic API *) - - val contract : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> AST.t - - (* The incremental API *) - - module MenhirInterpreter : - sig - include MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE - with type token = token - end - - module Incremental : - sig - val contract : Lexing.position -> AST.t MenhirInterpreter.checkpoint - end - - end - (* Errors *) -module type PAR_ERR = - sig - val message : int -> string (* From error states to messages *) - end - val format_error : ?offsets:bool -> [`Byte | `Point] -> string Region.reg -> file:bool -> string (* Main functor *) -module Make (Lexer: Lexer.S) - (Parser: PARSER with type token = Lexer.Token.token) - (ParErr: PAR_ERR) : +module Make (Lexer: Lexer.S with module Token := LexToken) + (Parser: module type of Parser) + (ParErr: sig val message: int -> string end) : sig type message = string type valid = Lexer.token diff --git a/src/passes/1-parser/shared/dune b/src/passes/1-parser/shared/dune index 61c43fb28..2dafdbd17 100644 --- a/src/passes/1-parser/shared/dune +++ b/src/passes/1-parser/shared/dune @@ -15,9 +15,7 @@ Markup FQueue EvalOpt - Version - )) - + Version)) (rule (targets Version.ml)