From d097440ff41e441985c7b3eeb8feec80eb99ceba Mon Sep 17 00:00:00 2001 From: Alastair Reid Date: Thu, 23 Apr 2026 09:12:39 +0100 Subject: [PATCH 1/4] iii: drop unneeded import --- bin/iii.ml | 1 - 1 file changed, 1 deletion(-) 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 From 50e9ec107c953a9887098c4fd6514bd932c441b6 Mon Sep 17 00:00:00 2001 From: Alastair Reid Date: Thu, 23 Apr 2026 09:36:05 +0100 Subject: [PATCH 2/4] Parsing error messages: always include a source location Also, when there is no filename (e.g., because the input comes from the terminal), print "line 1" instead of "file line 1" Fixes #119 --- libISA/error.ml | 2 +- libISA/loadISA.ml | 46 +++++++++++++++++++++++++++++++++++----------- libISA/loc.ml | 27 +++++++++++---------------- tests/asl_test.ml | 2 +- 4 files changed, 48 insertions(+), 29 deletions(-) diff --git a/libISA/error.ml b/libISA/error.ml index eadc39dd..f553a151 100644 --- a/libISA/error.ml +++ b/libISA/error.ml @@ -34,7 +34,7 @@ let print_exception (e : exn) : unit = | Parser.Error -> Printf.printf " Parser error\n"; | ParseError loc -> - Printf.printf " Parser error\n%s\n" (Loc.to_string loc); + Printf.printf " Parser error at %s\n" (Loc.to_string loc); | 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/loadISA.ml b/libISA/loadISA.ml index aff345dc..e8fbfca9 100644 --- a/libISA/loadISA.ml +++ b/libISA/loadISA.ml @@ -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 *) From e0c22d37aa51d988bd5610c8f3e8b4e8af1e3708 Mon Sep 17 00:00:00 2001 From: Alastair Reid Date: Thu, 23 Apr 2026 09:56:31 +0100 Subject: [PATCH 3/4] Lexer: don't exit on reading a bad lexer token This was a really bad issue because it meant that you could be in the middle of an interactive session, type an incorrect lexeme, and the session would be aborted. The fix is easy: report it as a parsing error Fixes #82 --- libISA/isa_lexer.mll | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/libISA/isa_lexer.mll b/libISA/isa_lexer.mll index b1f8be70..b52259da 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 { Printf.printf "Unrecognized character: '%c'\n" c; + let loc = Loc.Range (lexbuf.lex_start_p, lexbuf.lex_curr_p) in + raise (Error.ParseError loc) + } and comment depth = parse | "/*" { comment (depth+1) lexbuf } From b8bdddcf040ee0a1a4b2c0b2c783a705f45164e8 Mon Sep 17 00:00:00 2001 From: Alastair Reid Date: Wed, 29 Apr 2026 17:00:20 +0100 Subject: [PATCH 4/4] Add string to ParseError exception object --- libISA/error.ml | 6 +++--- libISA/error.mli | 2 +- libISA/isa_lexer.mll | 4 ++-- libISA/loadISA.ml | 12 ++++++------ 4 files changed, 12 insertions(+), 12 deletions(-) diff --git a/libISA/error.ml b/libISA/error.ml index f553a151..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 at %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 b52259da..76e29d74 100644 --- a/libISA/isa_lexer.mll +++ b/libISA/isa_lexer.mll @@ -198,9 +198,9 @@ rule token = parse | "{" { LBRACE } | "}" { RBRACE } | eof { EOF } - | _ as c { Printf.printf "Unrecognized character: '%c'\n" c; + | _ 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) + raise (Error.ParseError (loc, msg)) } and comment depth = parse diff --git a/libISA/loadISA.ml b/libISA/loadISA.ml index e8fbfca9..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 @@ -328,7 +328,7 @@ let read_expr (tcenv : TC.Env.t) (loc : Loc.t) (s : string) : AST.expr = 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 read_stmt (tcenv : TC.Env.t) (s : string) : AST.stmt list = @@ -339,7 +339,7 @@ let read_stmt (tcenv : TC.Env.t) (s : string) : AST.stmt list = 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 read_stmts (tcenv : TC.Env.t) (s : string) : AST.stmt list = @@ -350,7 +350,7 @@ let read_stmts (tcenv : TC.Env.t) (s : string) : AST.stmt list = 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, "")) ) (* This entrypoint is used for testing so it does not sort its inputs to make @@ -368,7 +368,7 @@ let read_declarations_unsorted (tcenv : TC.GlobalEnv.t) (s : string) : 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 read_files (paths : string list) (filenames : string list) (verbose : bool)