diff --git a/bin/iii.ml b/bin/iii.ml index 675225b7..a3c1c55c 100644 --- a/bin/iii.ml +++ b/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 diff --git a/libISA/error.ml b/libISA/error.ml index eadc39dd..85a6eaac 100644 --- a/libISA/error.ml +++ b/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) -> diff --git a/libISA/error.mli b/libISA/error.mli index 8f52a770..75cb4943 100644 --- a/libISA/error.mli +++ b/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 diff --git a/libISA/isa_lexer.mll b/libISA/isa_lexer.mll index b1f8be70..76e29d74 100644 --- a/libISA/isa_lexer.mll +++ b/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 } diff --git a/libISA/loadISA.ml b/libISA/loadISA.ml index aff345dc..e637993b 100644 --- a/libISA/loadISA.ml +++ b/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,19 +321,37 @@ 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 @@ -341,10 +359,16 @@ let read_stmts (tcenv : TC.Env.t) (s : string) : AST.stmt list = 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) diff --git a/libISA/loc.ml b/libISA/loc.ml index 64da1c72..2f04e825 100644 --- a/libISA/loc.ml +++ b/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") ) diff --git a/tests/asl_test.ml b/tests/asl_test.ml index 51fa5e69..c3a31a9b 100644 --- a/tests/asl_test.ml +++ b/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 *)