adapt existing errors to changes

This commit is contained in:
vbot 2024-07-30 15:20:51 +02:00
parent c83e247d5d
commit 7f4824bed6
No known key found for this signature in database
GPG Key ID: A2CE1BDBED95DA38
4 changed files with 56 additions and 44 deletions

View File

@ -224,7 +224,7 @@ let record_type_error _ctx (A.AnyExpr e) t1 t2 =
t2_pos );
]
in
Message.delayed_error () ~fmt_pos
Message.delayed_error ~kind:Typing () ~fmt_pos
"Error during typechecking, incompatible types:@\n\
@[<v>@{<blue>@<2>%s@} @[<hov>%a@]@,\
@{<blue>@<2>%s@} @[<hov>%a@]@]" "" pp_typ t1_repr "" pp_typ t2_repr

View File

@ -58,10 +58,11 @@ let code_buffer : Buffer.t = Buffer.create 4000
let update_acc (lexbuf : lexbuf) : unit =
Buffer.add_string code_buffer (Utf8.lexeme lexbuf)
exception Lexing_error of (Pos.t * string)
(** Error-generating helper *)
let raise_lexer_error (loc : Pos.t) (token : string) =
Message.error ~pos:loc
"Parsing error after token \"%s\": what comes after is unknown" token
raise (Lexing_error (loc, token))
(** Associative list matching each punctuation string part of the Catala syntax
with its {!module: Surface.Parser} token. Same for all the input languages

View File

@ -31,6 +31,8 @@ val code_buffer : Buffer.t
val update_acc : Sedlexing.lexbuf -> unit
(** Updates {!val:code_buffer} with the current lexeme *)
exception Lexing_error of (Catala_utils.Pos.t * string)
val raise_lexer_error : Catala_utils.Pos.t -> string -> 'a
(** Error-generating helper *)

View File

@ -97,8 +97,7 @@ module ParserAux (LocalisedLexer : Lexer_common.LocalisedLexer) = struct
let error_loc = Pos.from_lpos (lexing_positions lexbuf) in
let wrong_token = Utf8.lexeme lexbuf in
let msg = custom_menhir_message in
Message.delayed_error () ?suggestion
~extra_pos:["", error_loc]
Message.delayed_error ~kind:Parsing () ?suggestion ~pos:error_loc
"@[<hov>Syntax error at %a:@ %t@]"
(fun ppf string -> Format.fprintf ppf "@{<yellow>\"%s\"@}" string)
wrong_token msg
@ -264,12 +263,12 @@ module ParserAux (LocalisedLexer : Lexer_common.LocalisedLexer) = struct
let target_rule =
target_rule (fst @@ Sedlexing.lexing_positions lexbuf)
in
Message.with_delayed_errors
@@ fun () -> loop lexer_buffer token_list lexbuf None target_rule
with Sedlexing.MalFormed | Sedlexing.InvalidCodepoint _ ->
Lexer_common.raise_lexer_error
(Pos.from_lpos (lexing_positions lexbuf))
(Utf8.lexeme lexbuf)
loop lexer_buffer token_list lexbuf None target_rule
with Lexer_common.Lexing_error (pos, token) ->
(* The encapsulating [Message.with_delayed_errors] will raise an
exception: we are safe returning a dummy value. *)
Message.delayed_error ~kind:Lexing [] ~pos
"Parsing error after token \"%s\": what comes after is unknown" token
let commands_or_includes (lexbuf : lexbuf) : Ast.source_file =
sedlex_with_menhir LocalisedLexer.lexer LocalisedLexer.token_list
@ -349,7 +348,7 @@ and expand_includes (source_file : string) (commands : Ast.law_structure list) :
match acc.Ast.program_module, name_opt with
| opt, None | None, opt -> opt
| Some id1, Some id2 ->
Message.error
Message.error ~kind:Parsing
~extra_pos:
["", Mark.get id1.module_name; "", Mark.get id2.module_name]
"Multiple definitions of the module name"
@ -374,6 +373,12 @@ and expand_includes (source_file : string) (commands : Ast.law_structure list) :
| Ast.LawInclude (Ast.CatalaFile inc_file) ->
let source_dir = Filename.dirname source_file in
let sub_source = File.(source_dir / Mark.remove inc_file) in
let pos = Mark.get inc_file in
if File.check_file sub_source = None then
Message.delayed_error ~kind:Parsing ~pos acc
"Included file '%s' is not a regular file or does not exist."
sub_source
else
with_sedlex_file sub_source
@@ fun lexbuf ->
let includ_program = parse_source lexbuf in
@ -381,15 +386,16 @@ and expand_includes (source_file : string) (commands : Ast.law_structure list) :
includ_program.Ast.program_module
|> Option.iter
@@ fun id ->
Message.error
Message.error ~kind:Parsing
~extra_pos:
[
"File include", Mark.get inc_file;
"Module declaration", Mark.get id.Ast.module_name;
]
"A file that declares a module cannot be used through the raw \
'@{<yellow>> Include@}'@ directive.@ You should use it as a \
module with@ '@{<yellow>> Use @{<blue>%s@}@}'@ instead."
"A file that declares a module cannot be used through the \
raw '@{<yellow>> Include@}'@ directive.@ You should use it \
as a module with@ '@{<yellow>> Use @{<blue>%s@}@}'@ \
instead."
(Mark.remove id.Ast.module_name)
in
{
@ -398,7 +404,8 @@ and expand_includes (source_file : string) (commands : Ast.law_structure list) :
List.rev_append includ_program.program_source_files
acc.Ast.program_source_files;
Ast.program_items =
List.rev_append includ_program.program_items acc.Ast.program_items;
List.rev_append includ_program.program_items
acc.Ast.program_items;
Ast.program_used_modules =
List.rev_append includ_program.program_used_modules
acc.Ast.program_used_modules;
@ -490,7 +497,7 @@ let check_modname program source_file =
| ( Some { module_name = mname, pos; _ },
(Global.FileName file | Global.Contents (_, file) | Global.Stdin file) )
when not File.(equal mname Filename.(remove_extension (basename file))) ->
Message.error ~pos
Message.error ~kind:Parsing ~pos
"Module declared as@ @{<blue>%s@},@ which@ does@ not@ match@ the@ file@ \
name@ %a.@ Rename the module to@ @{<blue>%s@}@ or@ the@ file@ to@ %a."
mname File.format file
@ -512,7 +519,7 @@ let load_interface ?default_module_name source_file =
module_external = false;
}
| None, None ->
Message.error
Message.error ~kind:Parsing
"%a doesn't define a module name. It should contain a '@{<cyan>> \
Module %s@}' directive."
File.format
@ -530,6 +537,8 @@ let load_interface ?default_module_name source_file =
}
let parse_top_level_file (source_file : File.t Global.input_src) : Ast.program =
Message.with_delayed_errors
@@ fun () ->
let program = with_sedlex_source source_file parse_source in
check_modname program source_file;
{