From 75b6251b438862e00e9125445ff0014ef2444b3b Mon Sep 17 00:00:00 2001 From: Aminata-Dev Date: Mon, 26 Jun 2023 16:30:08 +0200 Subject: [PATCH] Match the compiler code to the new type of error message content --- compiler/catala_utils/catala_utils.mld | 5 +- compiler/catala_utils/message.ml | 17 +++--- compiler/catala_utils/suggestions.ml | 57 +++++++++++-------- compiler/desugared/from_surface.ml | 21 ++++--- compiler/surface/parser_driver.ml | 43 +------------- .../tests/test_nsw_social_housie.catala_en | 8 +-- .../bad/quick_pattern_fail.catala_en | 4 +- tests/test_enum/bad/wrong_cons.catala_en | 9 +-- 8 files changed, 67 insertions(+), 97 deletions(-) diff --git a/compiler/catala_utils/catala_utils.mld b/compiler/catala_utils/catala_utils.mld index f791a05c..99a837bb 100644 --- a/compiler/catala_utils/catala_utils.mld +++ b/compiler/catala_utils/catala_utils.mld @@ -41,7 +41,4 @@ Related modules: Related modules: -{!modules: Catala_utils.File Catala_utils.Mark Catala_utils.Cli Catala_utils.String} - -(*description à compléter*) -{!modules: Catala_utils.Myown} \ No newline at end of file +{!modules: Catala_utils.File Catala_utils.Mark Catala_utils.Cli Catala_utils.String Catala_utils.Suggestions} \ No newline at end of file diff --git a/compiler/catala_utils/message.ml b/compiler/catala_utils/message.ml index 5e7432a8..b5cc6da9 100644 --- a/compiler/catala_utils/message.ml +++ b/compiler/catala_utils/message.ml @@ -197,16 +197,13 @@ let raise_spanned_error ?(suggestion : Content.message option) (span : Pos.t) format = - Format.kdprintf - (fun message -> - raise - (CompilerError - ([ - MainMessage message; - Position { pos_message = span_msg; pos = span }; - ] - @ match suggestion with None -> [] | Some sug -> [Suggestion sug]))) - format + let continuation (message : Format.formatter -> unit) = + raise + (CompilerError + ([MainMessage message; Position { pos_message = span_msg; pos = span }] + @ match suggestion with None -> [] | Some sug -> [Suggestion sug])) + in + Format.kdprintf continuation format let raise_multispanned_error_full (spans : (Content.message option * Pos.t) list) diff --git a/compiler/catala_utils/suggestions.ml b/compiler/catala_utils/suggestions.ml index ff3ef6a0..d530ddf1 100644 --- a/compiler/catala_utils/suggestions.ml +++ b/compiler/catala_utils/suggestions.ml @@ -15,7 +15,7 @@ License for the specific language governing permissions and limitations under the License. *) -(* Three-way minimum *) +(** Three-way minimum *) let minimum a b c = min a (min b c) (** Computes the levenshtein distance between two strings, used to provide error @@ -50,37 +50,44 @@ let levenshtein_distance (s : string) (t : string) : int = d.(m).(n) -(*On crée la liste des distances minimales, c'est à dire tous les couples (>=1) - qui partagent la distance minimale*) +(*We're creating a string list composed by those who satisfy the following rule + : they share the same levenshtein distance, which is the minimal distance + found between the reference word "keyword" and all the strings in + "string_list".*) let suggestion_minimum_levenshtein_distance_association - (l : string list) - (mot : string) : string list = - let rec insertion ((x, y) : int * string) (l : (int * string) list) : - (int * string) list = - match l with - | (current_x, current_y) :: t -> - if x <= current_x then (x, y) :: l - (*égalité car insertion du dernier au premier élément*) - else (current_x, current_y) :: insertion (x, y) t - | [] -> l @ [x, y] + (string_list : string list) + (keyword : string) : string list = + let rec insertion ((new_x, new_y) : int * 'a) (n_tuple_list : (int * 'a) list) + : (int * 'a) list = + match n_tuple_list with + | (current_x, current_y) :: tail -> + if new_x <= current_x then (new_x, new_y) :: n_tuple_list + (*= to satisfy first-come first-served basis (because the last element + is inserted first (see levenshtein_distance_association))*) + else (current_x, current_y) :: insertion (new_x, new_y) tail + | [] -> [new_x, new_y] in - (*on associe à chaque string de l sa distance de levenshtein avec un mot - commun. La liste en sortie est triée (principe premier arrivé, premier - inscrit)*) - (*sauf accumulateur*) - let rec levenshtein_distance_association (l' : string list) (mot' : string) : - (int * string) list = - match l' with + (*Here we associate each elements of "string_list'" with its levenshtein + distance with "keyword'"*) + (*It returns a 2-tuple list with the following format (levenshein_distance, + word_from_string_list). 2-tuples are sorted on the first-come first-served + basis*) + let rec levenshtein_distance_association + (string_list' : string list) + (keyword' : string) : (int * string) list = + match string_list' with | h :: t -> insertion - (levenshtein_distance h mot', h) - (levenshtein_distance_association t mot') + (levenshtein_distance h keyword', h) + (levenshtein_distance_association t keyword') | [] -> [] in - let final_list = levenshtein_distance_association l mot in + let final_list = levenshtein_distance_association string_list keyword in match final_list with | h :: _ -> - (*on filtre les minimums et on récupère les strings*) + (*We collect the strings from "string_list" with the minimum levenshtein + distance found (i.e. the distance of the first element of the sorted + list*) List.map snd (List.filter (fun (x, _) -> x == fst h) final_list) - (*< impossible car déjà la liste est déjà triée*) + (*< impossible because the list is already sorted in ascending order*) | [] -> [] diff --git a/compiler/desugared/from_surface.ml b/compiler/desugared/from_surface.ml index a3ba877e..51d2785a 100644 --- a/compiler/desugared/from_surface.ml +++ b/compiler/desugared/from_surface.ml @@ -130,15 +130,18 @@ let raise_error_cons_not_found Suggestions.suggestion_minimum_levenshtein_distance_association constructors (Mark.remove constructor) in - Message.raise_spanned_error (Mark.get constructor) - "The name of this constructor has not been defined before, maybe it is a \ - typo?%a" - (fun fmt closest_constructors -> - match closest_constructors with - | [] -> Format.fprintf fmt "" - | hd :: _ -> - Format.fprintf fmt " Maybe you wanted to say @{\"%s\"@}?" hd) - closest_constructors + let print_string_list (ppf : Format.formatter) (string_list : string list) = + Format.pp_print_list + ~pp_sep:(fun ppf () -> Format.pp_print_string ppf " or ") + (fun ppf str -> Format.fprintf ppf "\"@{%s@}\"" str) + ppf string_list + in + Message.raise_spanned_error + ~span_msg:(fun ppf -> Format.fprintf ppf "Here is your code :") + ~suggestion:(fun ppf -> print_string_list ppf closest_constructors) + (Mark.get constructor) + "The name of this constructor has not been defined before (it's probably a \ + typographical error)." let disambiguate_constructor (ctxt : Name_resolution.context) diff --git a/compiler/surface/parser_driver.ml b/compiler/surface/parser_driver.ml index 7bb8efa1..7d393a95 100644 --- a/compiler/surface/parser_driver.ml +++ b/compiler/surface/parser_driver.ml @@ -21,43 +21,6 @@ open Sedlexing open Catala_utils -(** {1 Internal functions} *) - -(** Three-way minimum *) -let minimum a b c = min a (min b c) - -(** Computes the levenshtein distance between two strings, used to provide error - messages suggestions *) -let levenshtein_distance (s : string) (t : string) : int = - let m = String.length s and n = String.length t in - (* for all i and j, d.(i).(j) will hold the Levenshtein distance between the - first i characters of s and the first j characters of t *) - let d = Array.make_matrix (m + 1) (n + 1) 0 in - - for i = 0 to m do - d.(i).(0) <- i - (* the distance of any first string to an empty second string *) - done; - for j = 0 to n do - d.(0).(j) <- j - (* the distance of any second string to an empty first string *) - done; - - for j = 1 to n do - for i = 1 to m do - if s.[i - 1] = t.[j - 1] then d.(i).(j) <- d.(i - 1).(j - 1) - (* no operation required *) - else - d.(i).(j) <- - minimum - (d.(i - 1).(j) + 1) (* a deletion *) - (d.(i).(j - 1) + 1) (* an insertion *) - (d.(i - 1).(j - 1) + 1) (* a substitution *) - done - done; - - d.(m).(n) - (** After parsing, heading structure is completely flat because of the [source_file_item] rule. We need to tree-i-fy the flat structure, by looking at the precedence of the law headings. *) @@ -174,8 +137,8 @@ module ParserAux (LocalisedLexer : Lexer_common.LocalisedLexer) = struct String.sub y 0 (String.length wrong_token) else y in - let levx = levenshtein_distance truncated_x wrong_token in - let levy = levenshtein_distance truncated_y wrong_token in + let levx = Suggestions.levenshtein_distance truncated_x wrong_token in + let levy = Suggestions.levenshtein_distance truncated_y wrong_token in if levx = levy then String.length x - String.length y else levx - levy) acceptable_tokens in @@ -187,7 +150,7 @@ module ParserAux (LocalisedLexer : Lexer_common.LocalisedLexer) = struct (fun ppf -> Format.fprintf ppf "did you mean %a?" (Format.pp_print_list - ~pp_sep:(fun ppf () -> Format.fprintf ppf ",@ or@ maybe@ ") + ~pp_sep:(fun ppf () -> Format.fprintf ppf ",@ or@ maybe@ ") (fun ppf (ts, _) -> pp_hint ppf ts)) tokens) in diff --git a/examples/NSW_community_gaming/tests/test_nsw_social_housie.catala_en b/examples/NSW_community_gaming/tests/test_nsw_social_housie.catala_en index be1f0de1..21989770 100644 --- a/examples/NSW_community_gaming/tests/test_nsw_social_housie.catala_en +++ b/examples/NSW_community_gaming/tests/test_nsw_social_housie.catala_en @@ -31,7 +31,7 @@ $ catala Interpret -s Test1 [ERROR] Syntax error at token "scope" Message: expected either 'condition', or 'content' followed by the expected variable type -Autosuggestion: did you mean "content", or maybe "condition"? +Autosuggestion: did you mean "content", or maybe "condition"? Error token: ┌─⯈ examples/NSW_community_gaming/tests/test_nsw_social_housie.catala_en:11.21-11.26: └──┐ @@ -74,7 +74,7 @@ $ catala Interpret -s Test2 [ERROR] Syntax error at token "scope" Message: expected either 'condition', or 'content' followed by the expected variable type -Autosuggestion: did you mean "content", or maybe "condition"? +Autosuggestion: did you mean "content", or maybe "condition"? Error token: ┌─⯈ examples/NSW_community_gaming/tests/test_nsw_social_housie.catala_en:11.21-11.26: └──┐ @@ -117,7 +117,7 @@ $ catala Interpret -s Test3 [ERROR] Syntax error at token "scope" Message: expected either 'condition', or 'content' followed by the expected variable type -Autosuggestion: did you mean "content", or maybe "condition"? +Autosuggestion: did you mean "content", or maybe "condition"? Error token: ┌─⯈ examples/NSW_community_gaming/tests/test_nsw_social_housie.catala_en:11.21-11.26: └──┐ @@ -162,7 +162,7 @@ $ catala Interpret -s Test4 [ERROR] Syntax error at token "scope" Message: expected either 'condition', or 'content' followed by the expected variable type -Autosuggestion: did you mean "content", or maybe "condition"? +Autosuggestion: did you mean "content", or maybe "condition"? Error token: ┌─⯈ examples/NSW_community_gaming/tests/test_nsw_social_housie.catala_en:11.21-11.26: └──┐ diff --git a/tests/test_enum/bad/quick_pattern_fail.catala_en b/tests/test_enum/bad/quick_pattern_fail.catala_en index 9b261388..4f88035f 100644 --- a/tests/test_enum/bad/quick_pattern_fail.catala_en +++ b/tests/test_enum/bad/quick_pattern_fail.catala_en @@ -18,11 +18,13 @@ scope A: ```catala-test-inline $ catala Interpret -s A [ERROR] -The name of this constructor has not been defined before, maybe it is a typo? Maybe you wanted to say "Case1"? +The name of this constructor has not been defined before (it's probably a typographical error). +Here is your code : ┌─⯈ tests/test_enum/bad/quick_pattern_fail.catala_en:15.38-15.43: └──┐ 15 │ definition y equals x with pattern Case3 │ ‾‾‾‾‾ └─ Article +Maybe you wanted to write "Case1" or "Case2" #return code 123# ``` diff --git a/tests/test_enum/bad/wrong_cons.catala_en b/tests/test_enum/bad/wrong_cons.catala_en index f4405a99..b133ff47 100644 --- a/tests/test_enum/bad/wrong_cons.catala_en +++ b/tests/test_enum/bad/wrong_cons.catala_en @@ -4,7 +4,6 @@ declaration enumeration E: -- Case1 - declaration scope A: context e content E @@ -15,11 +14,13 @@ scope A: ```catala-test-inline $ catala Typecheck [ERROR] -The name of this constructor has not been defined before, maybe it is a typo? Maybe you wanted to say "Case1"? -┌─⯈ tests/test_enum/bad/wrong_cons.catala_en:12.23-12.28: +The name of this constructor has not been defined before (it's probably a typographical error). +Here is your code : +┌─⯈ tests/test_enum/bad/wrong_cons.catala_en:11.23-11.28: └──┐ -12 │ definition e equals Case2 +11 │ definition e equals Case2 │ ‾‾‾‾‾ └─ Article +Maybe you wanted to write "Case1" #return code 123# ```