Match the compiler code to the new type of error message content

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}
+{!modules: Catala_utils.File Catala_utils.Mark Catala_utils.Cli Catala_utils.String Catala_utils.Suggestions}

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)

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*)
   | [] -> []

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 @{<yellow>\"%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 "\"@{<yellow>%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)

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

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:
 └──┐

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#
 ```

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#
 ```