Skip to content

Commit 4bae89d

Browse files
cknittclaude
andcommitted
Find duplicate pattern variables in a set of the bound names
Why: Each new pattern variable was compared with every variable the pattern had bound so far, and a `let rec … and …` group is one pattern, so n bindings cost O(n²) string comparisons: 16,000 bindings took 2.7 s. They now take 2.0 s. The names are kept in a set next to the list of variables, in one value, so that resetting the pattern and the save and restore around or-patterns carry both. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_01Kbf3gK1dcjbe97yY1wRMgs Signed-off-by: Christoph Knittel <ck@cca.io>
1 parent bf35764 commit 4bae89d

8 files changed

Lines changed: 71 additions & 12 deletions
Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
- Speed up type checking of patterns that bind many variables, such as large `let rec` groups.

‎compiler/ml/typecore.ml‎

Lines changed: 24 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -148,6 +148,17 @@ let rp node =
148148

149149
type recarg = Allowed | Required | Rejected
150150

151+
(* The variables bound so far by the pattern being typed, most recent first,
152+
with their names: looking each new variable up in the list would make
153+
patterns that bind many variables, like a large [let rec], quadratic.
154+
Both are saved and restored together. *)
155+
type pattern_variables = {
156+
vars: (Ident.t * type_expr * string loc * Location.t * bool) list;
157+
names: Set_string.t;
158+
}
159+
160+
let no_pattern_variables = {vars = []; names = Set_string.empty}
161+
151162
(* Typing a request mutates these stacks while traversing expressions and
152163
patterns. A failed request must not leave them in another request. *)
153164
type request_state = {
@@ -156,8 +167,7 @@ type request_state = {
156167
break and continue must not leave. *)
157168
in_finally: bool ref;
158169
newtype_level: int option ref;
159-
pattern_variables:
160-
(Ident.t * type_expr * string loc * Location.t * bool) list ref;
170+
pattern_variables: pattern_variables ref;
161171
pattern_force: (unit -> unit) list ref;
162172
allow_modules: bool ref;
163173
module_variables: (string loc * Location.t) list ref;
@@ -168,7 +178,7 @@ let fresh_state () =
168178
loop_depth = ref 0;
169179
in_finally = ref false;
170180
newtype_level = ref None;
171-
pattern_variables = ref [];
181+
pattern_variables = ref no_pattern_variables;
172182
pattern_force = ref [];
173183
allow_modules = ref false;
174184
module_variables = ref [];
@@ -540,20 +550,21 @@ let has_variants p =
540550

541551
(* pattern environment *)
542552
let reset_pattern allow =
543-
pattern_variables_ref () := [];
553+
pattern_variables_ref () := no_pattern_variables;
544554
pattern_force_ref () := [];
545555
allow_modules_ref () := allow;
546556
module_variables_ref () := []
547557

548558
let enter_variable ?(is_module = false) ?(is_as_variable = false) loc name ty =
549-
if
550-
List.exists
551-
(fun (id, _, _, _, _) -> Ident.name id = name.txt)
552-
!(pattern_variables_ref ())
553-
then raise (Error (loc, Env.empty, Multiply_bound_variable name.txt));
559+
let {vars; names} = !(pattern_variables_ref ()) in
560+
if Set_string.mem name.txt names then
561+
raise (Error (loc, Env.empty, Multiply_bound_variable name.txt));
554562
let id = Ident.create name.txt in
555563
pattern_variables_ref () :=
556-
(id, ty, name, loc, is_as_variable) :: !(pattern_variables_ref ());
564+
{
565+
vars = (id, ty, name, loc, is_as_variable) :: vars;
566+
names = Set_string.add name.txt names;
567+
};
557568
if is_module then (
558569
(* Note: unpack patterns enter a variable of the same name *)
559570
if not !(allow_modules_ref ()) then
@@ -1831,7 +1842,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env sp
18311842
| Some p, None | None, Some p -> p (* no variables in this case *)
18321843
| Some p1, Some p2 ->
18331844
let alpha_env =
1834-
enter_orpat_variables loc !env p1_variables p2_variables
1845+
enter_orpat_variables loc !env p1_variables.vars p2_variables.vars
18351846
in
18361847
pattern_variables_ref () := p1_variables;
18371848
module_variables_ref () := p1_module_variables;
@@ -1959,7 +1970,8 @@ let check_unused ?(lev = get_current_level ()) env expected_ty cases =
19591970
cases
19601971
19611972
let add_pattern_variables ?check ?check_as env =
1962-
let pv = get_ref (pattern_variables_ref ()) in
1973+
let pv = !(pattern_variables_ref ()).vars in
1974+
pattern_variables_ref () := no_pattern_variables;
19631975
( List.fold_right
19641976
(fun (id, ty, _name, loc, as_var) env ->
19651977
let check = if as_var then check_as else check in
Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
2+
We've found a bug for you!
3+
/.../fixtures/multiply_bound_variable_alias.res:3:5-16
4+
5+
1 │ let f = x =>
6+
2 │ switch x {
7+
3 │ | Some(a) as a => a
8+
4 │ | None => None
9+
5 │ }
10+
11+
Variable a is bound several times in this pattern
Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
2+
We've found a bug for you!
3+
/.../fixtures/multiply_bound_variable_let_rec.res:3:5
4+
5+
1 │ let rec f = () => g()
6+
2 │ and g = () => 1
7+
3 │ and f = () => 2
8+
4 │
9+
10+
Variable f is bound several times in this pattern
Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
2+
We've found a bug for you!
3+
/.../fixtures/multiply_bound_variable_or_pattern.res:4:20
4+
5+
2 ┆ switch x {
6+
3 ┆ | (Some(a), None) | (None, Some(a)) => a
7+
4 ┆ | (Some(a), Some(a)) => a
8+
5 ┆ | (None, None) => 0
9+
6 ┆ }
10+
11+
Variable a is bound several times in this pattern
Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
let f = x =>
2+
switch x {
3+
| Some(a) as a => a
4+
| None => None
5+
}
Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
let rec f = () => g()
2+
and g = () => 1
3+
and f = () => 2
Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
let f = (x: (option<int>, option<int>)) =>
2+
switch x {
3+
| (Some(a), None) | (None, Some(a)) => a
4+
| (Some(a), Some(a)) => a
5+
| (None, None) => 0
6+
}

0 commit comments

Comments
 (0)