Find duplicate pattern variables in a set of the bound names

changes/pattern-variable-names.polish.md

@@ -0,0 +1 @@
+- Speed up type checking of patterns that bind many variables, such as large `let rec` groups.

compiler/ml/typecore.ml

@@ -148,6 +148,17 @@ let rp node =
 
 type recarg = Allowed | Required | Rejected
 
+(* The variables bound so far by the pattern being typed, most recent first,
+   with their names: looking each new variable up in the list would make
+   patterns that bind many variables, like a large [let rec], quadratic.
+   Both are saved and restored together. *)
+type pattern_variables = {
+  vars: (Ident.t * type_expr * string loc * Location.t * bool) list;
+  names: Set_string.t;
+}
+
+let no_pattern_variables = {vars = []; names = Set_string.empty}
+
 (* Typing a request mutates these stacks while traversing expressions and
    patterns. A failed request must not leave them in another request. *)
 type request_state = {
@@ -156,8 +167,7 @@ type request_state = {
      break and continue must not leave. *)
   in_finally: bool ref;
   newtype_level: int option ref;
-  pattern_variables:
-    (Ident.t * type_expr * string loc * Location.t * bool) list ref;
+  pattern_variables: pattern_variables ref;
   pattern_force: (unit -> unit) list ref;
   allow_modules: bool ref;
   module_variables: (string loc * Location.t) list ref;
@@ -168,7 +178,7 @@ let fresh_state () =
     loop_depth = ref 0;
     in_finally = ref false;
     newtype_level = ref None;
-    pattern_variables = ref [];
+    pattern_variables = ref no_pattern_variables;
     pattern_force = ref [];
     allow_modules = ref false;
     module_variables = ref [];
@@ -540,20 +550,21 @@ let has_variants p =
 
 (* pattern environment *)
 let reset_pattern allow =
-  pattern_variables_ref () := [];
+  pattern_variables_ref () := no_pattern_variables;
   pattern_force_ref () := [];
   allow_modules_ref () := allow;
   module_variables_ref () := []
 
 let enter_variable ?(is_module = false) ?(is_as_variable = false) loc name ty =
-  if
-    List.exists
-      (fun (id, _, _, _, _) -> Ident.name id = name.txt)
-      !(pattern_variables_ref ())
-  then raise (Error (loc, Env.empty, Multiply_bound_variable name.txt));
+  let {vars; names} = !(pattern_variables_ref ()) in
+  if Set_string.mem name.txt names then
+    raise (Error (loc, Env.empty, Multiply_bound_variable name.txt));
   let id = Ident.create name.txt in
   pattern_variables_ref () :=
-    (id, ty, name, loc, is_as_variable) :: !(pattern_variables_ref ());
+    {
+      vars = (id, ty, name, loc, is_as_variable) :: vars;
+      names = Set_string.add name.txt names;
+    };
   if is_module then (
     (* Note: unpack patterns enter a variable of the same name *)
     if not !(allow_modules_ref ()) then
@@ -1831,7 +1842,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
       | Some p, None | None, Some p -> p (* no variables in this case *)
       | Some p1, Some p2 ->
         let alpha_env =
-          enter_orpat_variables loc !env p1_variables p2_variables
+          enter_orpat_variables loc !env p1_variables.vars p2_variables.vars
         in
         pattern_variables_ref () := p1_variables;
         module_variables_ref () := p1_module_variables;
@@ -1959,7 +1970,8 @@ let check_unused ?(lev = get_current_level ()) env expected_ty cases =
     cases
 
 let add_pattern_variables ?check ?check_as env =
-  let pv = get_ref (pattern_variables_ref ()) in
+  let pv = !(pattern_variables_ref ()).vars in
+  pattern_variables_ref () := no_pattern_variables;
   ( List.fold_right
       (fun (id, ty, _name, loc, as_var) env ->
         let check = if as_var then check_as else check in

tests/build_tests/super_errors/expected/multiply_bound_variable_alias.res.expected

@@ -0,0 +1,11 @@
+
+  We've found a bug for you!
+  /.../fixtures/multiply_bound_variable_alias.res:3:5-16
+
+  1 │ let f = x =>
+  2 │   switch x {
+  3 │   | Some(a) as a => a
+  4 │   | None => None
+  5 │   }
+
+  Variable a is bound several times in this pattern

tests/build_tests/super_errors/expected/multiply_bound_variable_let_rec.res.expected

@@ -0,0 +1,10 @@
+
+  We've found a bug for you!
+  /.../fixtures/multiply_bound_variable_let_rec.res:3:5
+
+  1 │ let rec f = () => g()
+  2 │ and g = () => 1
+  3 │ and f = () => 2
+  4 │ 
+
+  Variable f is bound several times in this pattern

tests/build_tests/super_errors/expected/multiply_bound_variable_or_pattern.res.expected

@@ -0,0 +1,11 @@
+
+  We've found a bug for you!
+  /.../fixtures/multiply_bound_variable_or_pattern.res:4:20
+
+  2 ┆ switch x {
+  3 ┆ | (Some(a), None) | (None, Some(a)) => a
+  4 ┆ | (Some(a), Some(a)) => a
+  5 ┆ | (None, None) => 0
+  6 ┆ }
+
+  Variable a is bound several times in this pattern

tests/build_tests/super_errors/fixtures/multiply_bound_variable_alias.res

@@ -0,0 +1,5 @@
+let f = x =>
+  switch x {
+  | Some(a) as a => a
+  | None => None
+  }

tests/build_tests/super_errors/fixtures/multiply_bound_variable_let_rec.res

@@ -0,0 +1,3 @@
+let rec f = () => g()
+and g = () => 1
+and f = () => 2

tests/build_tests/super_errors/fixtures/multiply_bound_variable_or_pattern.res

@@ -0,0 +1,6 @@
+let f = (x: (option<int>, option<int>)) =>
+  switch x {
+  | (Some(a), None) | (None, Some(a)) => a
+  | (Some(a), Some(a)) => a
+  | (None, None) => 0
+  }