Improve lexing parsing error messages

bin/iii.ml

@@ -10,7 +10,6 @@
 
 open LibISA
 open Isa_ast
-module Parser = Asl_parser
 module TC = Tcheck
 module AST = Isa_ast
 module FMT = Isa_fmt

libISA/error.ml

@@ -20,7 +20,7 @@ exception IsNotA of (Loc.t * string * string)
 exception Ambiguous of (Loc.t * string * string)
 exception TypeError of (Loc.t * string)
 
-exception ParseError of Loc.t
+exception ParseError of (Loc.t * string)
 
 let print_exception (e : exn) : unit =
   match e with
@@ -33,8 +33,8 @@ let print_exception (e : exn) : unit =
         (pp_binop op1) (pp_binop op2) (Loc.to_string loc);
   | Parser.Error ->
       Printf.printf "  Parser error\n";
-  | ParseError loc ->
-      Printf.printf "  Parser error\n%s\n" (Loc.to_string loc);
+  | ParseError (loc, msg) ->
+      Printf.printf "  %s: Parser error %s\n" (Loc.to_string loc) msg;
   | UnknownObject (loc, what, x) ->
     Printf.printf "  %s: Type error: Unknown %s %s\n" (Loc.to_string loc) what x
   | DoesNotMatch (loc, what, x, y) ->

libISA/error.mli

@@ -11,7 +11,7 @@ exception DoesNotMatch of (Loc.t * string * string * string)
 exception IsNotA of (Loc.t * string * string)
 exception Ambiguous of (Loc.t * string * string)
 exception TypeError of (Loc.t * string)
-exception ParseError of Loc.t
+exception ParseError of (Loc.t * string)
 
 val print_exception : exn -> unit
 

libISA/isa_lexer.mll

@@ -198,11 +198,10 @@ rule token = parse
     | "{"  { LBRACE      }
     | "}"  { RBRACE      }
     | eof  { EOF         }
-    | _ as c { Printf.printf "%s:%d Unrecognized character '%c'\n"
-                   lexbuf.lex_curr_p.pos_fname
-                   lexbuf.lex_curr_p.pos_lnum
-                   c;
-               exit 0 }
+    | _ as c { let msg = Printf.sprintf "unrecognized character: '%c'" c in
+               let loc = Loc.Range (lexbuf.lex_start_p, lexbuf.lex_curr_p) in
+               raise (Error.ParseError (loc, msg))
+             }
 
 and comment depth = parse
   | "/*"     { comment (depth+1) lexbuf }

libISA/loadISA.ml

@@ -229,7 +229,7 @@ let parse_asl_file (paths : string list) (filename : string) (verbose : bool) :
   with
   | ASL_Parser.Error ->
     let loc = Loc.Range (lexbuf.lex_start_p, lexbuf.lex_curr_p) in
-    raise (Error.ParseError loc)
+    raise (Error.ParseError (loc, ""))
 
 (* [parse_isa_file paths filename verbose]
    searches for [filename] in the search path list [paths]
@@ -258,7 +258,7 @@ let parse_isa_file (paths : string list) (filename : string) (verbose : bool) :
   with
   | ISA_Parser.Error ->
     let loc = Loc.Range (lexbuf.lex_start_p, lexbuf.lex_curr_p) in
-    raise (Error.ParseError loc)
+    raise (Error.ParseError (loc, ""))
 
 let parse_file (paths : string list) (filename : string) (verbose : bool) : AST.declaration list =
   if String.ends_with filename ~suffix:".asl" then
@@ -321,30 +321,54 @@ let read_config (tcenv : TC.Env.t) (loc : Loc.t) (s : string) : Ident.t * AST.ex
 
 let read_expr (tcenv : TC.Env.t) (loc : Loc.t) (s : string) : AST.expr =
   let lexbuf = Lexing.from_string s in
-  let e = ISA_Parser.expr_command_start ISA_Lexer.token lexbuf in
-  let (e', _) = TC.tc_expr tcenv loc e in
-  e'
+  ( try
+      let e = ISA_Parser.expr_command_start ISA_Lexer.token lexbuf in
+      let (e', _) = TC.tc_expr tcenv loc e in
+      e'
+  with
+  | ISA_Parser.Error ->
+    let loc = Loc.Range (lexbuf.lex_start_p, lexbuf.lex_curr_p) in
+    raise (Error.ParseError (loc, ""))
+  )
 
 let read_stmt (tcenv : TC.Env.t) (s : string) : AST.stmt list =
   let lexbuf = Lexing.from_string s in
-  let s = ISA_Parser.stmt_command_start ISA_Lexer.token lexbuf in
-  TC.tc_stmt tcenv s
+  ( try
+      let s = ISA_Parser.stmt_command_start ISA_Lexer.token lexbuf in
+      TC.tc_stmt tcenv s
+  with
+  | ISA_Parser.Error ->
+    let loc = Loc.Range (lexbuf.lex_start_p, lexbuf.lex_curr_p) in
+    raise (Error.ParseError (loc, ""))
+  )
 
 let read_stmts (tcenv : TC.Env.t) (s : string) : AST.stmt list =
   let lexbuf = Lexing.from_string s in
-  let s = ISA_Parser.stmts_command_start ISA_Lexer.token lexbuf in
-  TC.tc_stmts tcenv Loc.Unknown s
+  ( try
+      let s = ISA_Parser.stmts_command_start ISA_Lexer.token lexbuf in
+      TC.tc_stmts tcenv Loc.Unknown s
+  with
+  | ISA_Parser.Error ->
+    let loc = Loc.Range (lexbuf.lex_start_p, lexbuf.lex_curr_p) in
+    raise (Error.ParseError (loc, ""))
+  )
 
 (* This entrypoint is used for testing so it does not sort its inputs to make
  * the output easier to predict/control
  *)
 let read_declarations_unsorted (tcenv : TC.GlobalEnv.t) (s : string) :
     AST.declaration list =
   let lexbuf = Lexing.from_string s in
-  let s = ASL_Parser.declarations_start ASL_Lexer.token lexbuf in
-  ( match TC.tc_declarations tcenv ~isPrelude:false ~sort_decls:false s with
-  | None -> exit 1
-  | Some s' -> s'
+  ( try
+      let s = ISA_Parser.declarations_file ISA_Lexer.token lexbuf in
+      ( match TC.tc_declarations tcenv ~isPrelude:false ~sort_decls:false s with
+      | None -> exit 1
+      | Some s' -> s'
+      )
+  with
+  | ISA_Parser.Error ->
+    let loc = Loc.Range (lexbuf.lex_start_p, lexbuf.lex_curr_p) in
+    raise (Error.ParseError (loc, ""))
   )
 
 let read_files (paths : string list) (filenames : string list) (verbose : bool)

libISA/loc.ml

@@ -20,29 +20,24 @@ let rec to_string (l : t) : string =
     | Unknown -> "no location information available"
     | Generated l -> Printf.sprintf "Generated: %s"  (to_string l)
     | Range(p1, p2) ->
-        if String.equal p1.Lexing.pos_fname p2.Lexing.pos_fname then begin
-            if p1.Lexing.pos_lnum = p2.Lexing.pos_lnum then
-                Printf.sprintf "file %s line %d char %d - %d"
-                    p1.Lexing.pos_fname
+        let f = if String.length p1.Lexing.pos_fname == 0
+          then ""
+          else Printf.sprintf "file %s " p1.Lexing.pos_fname
+        in
+        let p = if p1.Lexing.pos_lnum = p2.Lexing.pos_lnum
+                then
+                  Printf.sprintf "line %d char %d - %d"
                     p1.Lexing.pos_lnum
                     (p1.Lexing.pos_cnum - p1.Lexing.pos_bol)
                     (p2.Lexing.pos_cnum - p2.Lexing.pos_bol)
-            else
-                Printf.sprintf "file %s line %d char %d - line %d char %d"
-                    p1.Lexing.pos_fname
+                else
+                  Printf.sprintf "line %d char %d - line %d char %d"
                     p1.Lexing.pos_lnum
                     (p1.Lexing.pos_cnum - p1.Lexing.pos_bol)
                     p2.Lexing.pos_lnum
                     (p2.Lexing.pos_cnum - p2.Lexing.pos_bol)
-        end else begin
-            Printf.sprintf "file %s line %d char %d - file %s line %d char %d"
-                p1.Lexing.pos_fname
-                p1.Lexing.pos_lnum
-                (p1.Lexing.pos_cnum - p1.Lexing.pos_bol)
-                p2.Lexing.pos_fname
-                p2.Lexing.pos_lnum
-                (p2.Lexing.pos_cnum - p2.Lexing.pos_bol)
-        end
+        in
+        f ^ p
     | Int(s,lo) -> Printf.sprintf "%s %s" s (match lo with Some l -> to_string l | None -> "none")
     )
 

tests/asl_test.ml

@@ -152,7 +152,7 @@ let tests : unit Alcotest.test_case list =
           F1(Std::Bits::Zero(16));
       end
      "
-     (Some "TypeError(file  line 4 char 10 - 34,unable to synthesize type parameter N)")
+     (Some "TypeError(line 4 char 10 - 34,unable to synthesize type parameter N)")
      None;
     test_static globals false "parameter synthesis 1"
       (* parameters can be synthesized from explicit argument values *)