Same error formatting for the incremental and monolithic API of Menhir.

src/passes/1-parser/cameligo/ParserAPI.ml

@@ -1,10 +1,4 @@
-(** Generic parser for LIGO *)
+(* 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 *)
 
@@ -12,12 +6,6 @@ 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 *)
 
@@ -42,6 +30,13 @@ 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
+
+    exception Point of error
+
     let failure get_win checkpoint =
       let message = ParErr.message (state checkpoint) in
       match get_win () with
@@ -51,7 +46,7 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
       | Lexer.Two (invalid, valid) ->
           raise (Point (message, Some valid, invalid))
 
-    (* The generic parsing function *)
+    (* 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
@@ -61,4 +56,24 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
       in close (); ast
 
     let mono_contract = Parser.contract
+
+    (* Errors *)
+
+    let format_error ?(offsets=true) mode (message, valid_opt, invalid) =
+      let invalid_lexeme = LexToken.to_lexeme invalid in
+      let invalid_region = LexToken.to_region invalid in
+      let header =
+        "Parse error " ^
+          invalid_region#to_string ~offsets mode in
+      let after =
+        match valid_opt with
+          None -> ","
+        | Some valid ->
+            let valid_lexeme = LexToken.to_lexeme valid
+            in Printf.sprintf ", after \"%s\" and" valid_lexeme in
+      let header = header ^ after in
+      let before = Printf.sprintf " before \"%s\"" invalid_lexeme in
+      let header = header ^ before in
+      header ^ (if message = "" then ".\n" else ":\n" ^ message)
+
   end

src/passes/1-parser/cameligo/ParserAPI.mli

@@ -1,23 +1,22 @@
 (** Generic parser API for LIGO *)
 
-(* Errors *)
-
-val format_error :
-  ?offsets:bool -> [`Byte | `Point] ->
-  string Region.reg -> file:bool -> string
-
-(* Main functor *)
-
 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
+    (* Monolithic and incremental APIs of Menhir for parsing *)
-    type valid   = Lexer.token
-    type invalid = Lexer.token
-
-    exception Point of message * valid option * invalid
 
     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

src/passes/1-parser/cameligo/ParserMain.ml

@@ -119,43 +119,27 @@ let () =
       in prerr_string msg
 
   (* Incremental API of Menhir *)
-  | ParserFront.Point (message, valid_opt, invalid) ->
+  | ParserFront.Point point ->
-     let () = close_all () in
+      let () = close_all () in
-     let invalid_lexeme = Lexer.Token.to_lexeme invalid in
+      let error =
-     let invalid_region = Lexer.Token.to_region invalid in
+        ParserFront.format_error ~offsets:options#offsets
-     let header =
+                                 options#mode point
-       "Parse error " ^
+      in eprintf "\027[31m%s\027[0m%!" error
-       invalid_region#to_string ~offsets:options#offsets
-                                options#mode in
-     let after =
-       match valid_opt with
-         None -> ","
-       | Some valid ->
-          let valid_lexeme = Lexer.Token.to_lexeme valid
-          in sprintf ", after \"%s\" and" valid_lexeme in
-     let header = header ^ after in
-     let before = sprintf " before \"%s\"" invalid_lexeme in
-     let header = header ^ before in
-     eprintf "\027[31m%s:\n%s\027[0m%!" header message
 
   (* Monolithic API of Menhir *)
   | Parser.Error ->
       let () = close_all () in
-      let token =
+      let invalid, valid_opt =
         match get_win () with
           Lexer.Nil ->
             assert false (* Safe: There is always at least EOF. *)
-        | Lexer.One token
+        | Lexer.One invalid -> invalid, None
-        | Lexer.Two (token, _) -> token in
+        | Lexer.Two (invalid, valid) -> invalid, Some valid in
-      let lexeme = Lexer.Token.to_lexeme token
+      let point = "", valid_opt, invalid in
-      and region = Lexer.Token.to_region token in
+      let error =
-      let msg    = sprintf "Syntax error on \"%s\".\n" lexeme in
+        ParserFront.format_error ~offsets:options#offsets
-      let error  = Region.{region; value=msg} in
+                                 options#mode point
-      let ()     = close_all () in
+      in eprintf "\027[31m%s\027[0m%!" error
-      let msg    =
-        ParserAPI.format_error ~offsets:options#offsets
-                               options#mode error ~file
-      in prerr_string msg
 
   (* I/O errors *)
   | Sys_error msg -> Utils.highlight msg

src/passes/1-parser/pascaligo/ParserAPI.ml

@@ -1,10 +1,4 @@
-(** Generic parser for LIGO *)
+(* 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 *)
 
@@ -12,12 +6,6 @@ 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 *)
 
@@ -42,6 +30,13 @@ 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
+
+    exception Point of error
+
     let failure get_win checkpoint =
       let message = ParErr.message (state checkpoint) in
       match get_win () with
@@ -51,7 +46,7 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
       | Lexer.Two (invalid, valid) ->
           raise (Point (message, Some valid, invalid))
 
-    (* The generic parsing function *)
+    (* 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
@@ -61,4 +56,24 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
       in close (); ast
 
     let mono_contract = Parser.contract
+
+    (* Errors *)
+
+    let format_error ?(offsets=true) mode (message, valid_opt, invalid) =
+      let invalid_lexeme = LexToken.to_lexeme invalid in
+      let invalid_region = LexToken.to_region invalid in
+      let header =
+        "Parse error " ^
+          invalid_region#to_string ~offsets mode in
+      let after =
+        match valid_opt with
+          None -> ","
+        | Some valid ->
+            let valid_lexeme = LexToken.to_lexeme valid
+            in Printf.sprintf ", after \"%s\" and" valid_lexeme in
+      let header = header ^ after in
+      let before = Printf.sprintf " before \"%s\"" invalid_lexeme in
+      let header = header ^ before in
+      header ^ (if message = "" then ".\n" else ":\n" ^ message)
+
   end

src/passes/1-parser/pascaligo/ParserAPI.mli

@@ -1,23 +1,22 @@
 (** Generic parser API for LIGO *)
 
-(* Errors *)
-
-val format_error :
-  ?offsets:bool -> [`Byte | `Point] ->
-  string Region.reg -> file:bool -> string
-
-(* Main functor *)
-
 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
+    (* Monolithic and incremental APIs of Menhir for parsing *)
-    type valid   = Lexer.token
-    type invalid = Lexer.token
-
-    exception Point of message * valid option * invalid
 
     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

src/passes/1-parser/pascaligo/ParserMain.ml

@@ -119,43 +119,27 @@ let () =
       in prerr_string msg
 
   (* Incremental API of Menhir *)
-  | ParserFront.Point (message, valid_opt, invalid) ->
+  | ParserFront.Point point ->
-     let () = close_all () in
+      let () = close_all () in
-     let invalid_lexeme = Lexer.Token.to_lexeme invalid in
+      let error =
-     let invalid_region = Lexer.Token.to_region invalid in
+        ParserFront.format_error ~offsets:options#offsets
-     let header =
+                                 options#mode point
-       "Parse error " ^
+      in eprintf "\027[31m%s\027[0m%!" error
-       invalid_region#to_string ~offsets:options#offsets
-                                options#mode in
-     let after =
-       match valid_opt with
-         None -> ","
-       | Some valid ->
-          let valid_lexeme = Lexer.Token.to_lexeme valid
-          in sprintf ", after \"%s\" and" valid_lexeme in
-     let header = header ^ after in
-     let before = sprintf " before \"%s\"" invalid_lexeme in
-     let header = header ^ before in
-     eprintf "\027[31m%s:\n%s\027[0m%!" header message
 
   (* Monolithic API of Menhir *)
   | Parser.Error ->
       let () = close_all () in
-      let token =
+      let invalid, valid_opt =
         match get_win () with
           Lexer.Nil ->
             assert false (* Safe: There is always at least EOF. *)
-        | Lexer.One token
+        | Lexer.One invalid -> invalid, None
-        | Lexer.Two (token, _) -> token in
+        | Lexer.Two (invalid, valid) -> invalid, Some valid in
-      let lexeme = Lexer.Token.to_lexeme token
+      let point = "", valid_opt, invalid in
-      and region = Lexer.Token.to_region token in
+      let error =
-      let msg    = sprintf "Syntax error on \"%s\".\n" lexeme in
+        ParserFront.format_error ~offsets:options#offsets
-      let error  = Region.{region; value=msg} in
+                                 options#mode point
-      let ()     = close_all () in
+      in eprintf "\027[31m%s\027[0m%!" error
-      let msg    =
-        ParserAPI.format_error ~offsets:options#offsets
-                               options#mode error ~file
-      in prerr_string msg
 
   (* I/O errors *)
   | Sys_error msg -> Utils.highlight msg

src/passes/1-parser/reasonligo/ParserAPI.ml

@@ -1,10 +1,4 @@
-(** Generic parser for LIGO *)
+(* 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 *)
 
@@ -12,12 +6,6 @@ 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 *)
 
@@ -42,6 +30,13 @@ 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
+
+    exception Point of error
+
     let failure get_win checkpoint =
       let message = ParErr.message (state checkpoint) in
       match get_win () with
@@ -51,7 +46,7 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
       | Lexer.Two (invalid, valid) ->
           raise (Point (message, Some valid, invalid))
 
-    (* The generic parsing function *)
+    (* 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
@@ -61,4 +56,24 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
       in close (); ast
 
     let mono_contract = Parser.contract
+
+    (* Errors *)
+
+    let format_error ?(offsets=true) mode (message, valid_opt, invalid) =
+      let invalid_lexeme = LexToken.to_lexeme invalid in
+      let invalid_region = LexToken.to_region invalid in
+      let header =
+        "Parse error " ^
+          invalid_region#to_string ~offsets mode in
+      let after =
+        match valid_opt with
+          None -> ","
+        | Some valid ->
+            let valid_lexeme = LexToken.to_lexeme valid
+            in Printf.sprintf ", after \"%s\" and" valid_lexeme in
+      let header = header ^ after in
+      let before = Printf.sprintf " before \"%s\"" invalid_lexeme in
+      let header = header ^ before in
+      header ^ (if message = "" then ".\n" else ":\n" ^ message)
+
   end

src/passes/1-parser/reasonligo/ParserAPI.mli

@@ -1,23 +1,22 @@
 (** Generic parser API for LIGO *)
 
-(* Errors *)
-
-val format_error :
-  ?offsets:bool -> [`Byte | `Point] ->
-  string Region.reg -> file:bool -> string
-
-(* Main functor *)
-
 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
+    (* Monolithic and incremental APIs of Menhir for parsing *)
-    type valid   = Lexer.token
-    type invalid = Lexer.token
-
-    exception Point of message * valid option * invalid
 
     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

src/passes/1-parser/reasonligo/ParserMain.ml

@@ -119,43 +119,27 @@ let () =
       in prerr_string msg
 
   (* Incremental API of Menhir *)
-  | ParserFront.Point (message, valid_opt, invalid) ->
+  | ParserFront.Point point ->
-     let () = close_all () in
+      let () = close_all () in
-     let invalid_lexeme = Lexer.Token.to_lexeme invalid in
+      let error =
-     let invalid_region = Lexer.Token.to_region invalid in
+        ParserFront.format_error ~offsets:options#offsets
-     let header =
+                                 options#mode point
-       "Parse error " ^
+      in eprintf "\027[31m%s\027[0m%!" error
-       invalid_region#to_string ~offsets:options#offsets
-                                options#mode in
-     let after =
-       match valid_opt with
-         None -> ","
-       | Some valid ->
-          let valid_lexeme = Lexer.Token.to_lexeme valid
-          in sprintf ", after \"%s\" and" valid_lexeme in
-     let header = header ^ after in
-     let before = sprintf " before \"%s\"" invalid_lexeme in
-     let header = header ^ before in
-     eprintf "\027[31m%s:\n%s\027[0m%!" header message
 
   (* Monolithic API of Menhir *)
   | Parser.Error ->
       let () = close_all () in
-      let token =
+      let invalid, valid_opt =
         match get_win () with
           Lexer.Nil ->
             assert false (* Safe: There is always at least EOF. *)
-        | Lexer.One token
+        | Lexer.One invalid -> invalid, None
-        | Lexer.Two (token, _) -> token in
+        | Lexer.Two (invalid, valid) -> invalid, Some valid in
-      let lexeme = Lexer.Token.to_lexeme token
+      let point = "", valid_opt, invalid in
-      and region = Lexer.Token.to_region token in
+      let error =
-      let msg    = sprintf "Syntax error on \"%s\".\n" lexeme in
+        ParserFront.format_error ~offsets:options#offsets
-      let error  = Region.{region; value=msg} in
+                                 options#mode point
-      let ()     = close_all () in
+      in eprintf "\027[31m%s\027[0m%!" error
-      let msg    =
-        ParserAPI.format_error ~offsets:options#offsets
-                               options#mode error ~file
-      in prerr_string msg
 
   (* I/O errors *)
   | Sys_error msg -> Utils.highlight msg