Skip to content

Commit 96ec26a

Browse files
tonowaktonowak
authored
flambda-backend: Manually applied changes from PR #11782 (#1732)
1 parent ea484d0 commit 96ec26a

21 files changed

+155
-137
lines changed

‎lambda/matching.ml

Lines changed: 15 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -234,8 +234,8 @@ end = struct
234234
| Tpat_any
235235
| Tpat_var _ ->
236236
p
237-
| Tpat_alias (q, id, s, mode) ->
238-
{ p with pat_desc = Tpat_alias (simpl_under_orpat q, id, s, mode) }
237+
| Tpat_alias (q, id, s, uid, mode) ->
238+
{ p with pat_desc = Tpat_alias (simpl_under_orpat q, id, s, uid, mode) }
239239
| Tpat_or (p1, p2, o) ->
240240
let p1, p2 = (simpl_under_orpat p1, simpl_under_orpat p2) in
241241
if le_pat p1 p2 then
@@ -258,8 +258,9 @@ end = struct
258258
in
259259
match p.pat_desc with
260260
| `Any -> stop p `Any
261-
| `Var (id, s, mode) -> continue p (`Alias (Patterns.omega, id, s, mode))
262-
| `Alias (p, id, _, _) ->
261+
| `Var (id, s, uid, mode) ->
262+
continue p (`Alias (Patterns.omega, id, s, uid, mode))
263+
| `Alias (p, id, _, _, _) ->
263264
aux
264265
( (General.view p, patl),
265266
bind_alias p id ~arg ~arg_sort ~action )
@@ -354,10 +355,10 @@ end = struct
354355
match p.pat_desc with
355356
| `Or (p1, p2, _) ->
356357
split_explode p1 aliases (split_explode p2 aliases rem)
357-
| `Alias (p, id, _, _) -> split_explode p (id :: aliases) rem
358-
| `Var (id, str, mode) ->
358+
| `Alias (p, id, _, _, _) -> split_explode p (id :: aliases) rem
359+
| `Var (id, str, uid, mode) ->
359360
explode
360-
{ p with pat_desc = `Alias (Patterns.omega, id, str, mode) }
361+
{ p with pat_desc = `Alias (Patterns.omega, id, str, uid, mode) }
361362
aliases rem
362363
| #view as view ->
363364
(* We are doing two things here:
@@ -595,7 +596,7 @@ end = struct
595596
match p.pat_desc with
596597
| `Or (p1, p2, _) ->
597598
filter_rec ((left, p1, right) :: (left, p2, right) :: rem)
598-
| `Alias (p, _, _, _) -> filter_rec ((left, p, right) :: rem)
599+
| `Alias (p, _, _, _, _) -> filter_rec ((left, p, right) :: rem)
599600
| `Var _ -> filter_rec ((left, Patterns.omega, right) :: rem)
600601
| #Simple.view as view -> (
601602
let p = { p with pat_desc = view } in
@@ -645,7 +646,7 @@ let rec flatten_pat_line size p k =
645646
| Tpat_tuple args -> args :: k
646647
| Tpat_or (p1, p2, _) ->
647648
flatten_pat_line size p1 (flatten_pat_line size p2 k)
648-
| Tpat_alias (p, _, _, _) ->
649+
| Tpat_alias (p, _, _, _, _) ->
649650
(* Note: we are only called from flatten_matrix,
650651
which is itself only ever used in places
651652
where variables do not matter (default environments,
@@ -722,7 +723,7 @@ end = struct
722723
| (p, ps) :: rem -> (
723724
let p = General.view p in
724725
match p.pat_desc with
725-
| `Alias (p, _, _, _) -> filter_rec ((p, ps) :: rem)
726+
| `Alias (p, _, _, _, _) -> filter_rec ((p, ps) :: rem)
726727
| `Var _ -> filter_rec ((Patterns.omega, ps) :: rem)
727728
| `Or (p1, p2, _) -> filter_rec_or p1 p2 ps rem
728729
| #Simple.view as view -> (
@@ -1208,7 +1209,7 @@ let rec omega_like p =
12081209
| Tpat_any
12091210
| Tpat_var _ ->
12101211
true
1211-
| Tpat_alias (p, _, _, _) -> omega_like p
1212+
| Tpat_alias (p, _, _, _, _) -> omega_like p
12121213
| Tpat_or (p1, p2, _) -> omega_like p1 || omega_like p2
12131214
| _ -> false
12141215

@@ -3314,8 +3315,8 @@ let rec comp_match_handlers value_kind comp_fun partial ctx first_match next_mat
33143315
let rec name_pattern default = function
33153316
| ((pat, _), _) :: rem -> (
33163317
match pat.pat_desc with
3317-
| Tpat_var (id, _, _) -> id
3318-
| Tpat_alias (_, id, _, _) -> id
3318+
| Tpat_var (id, _, _, _) -> id
3319+
| Tpat_alias (_, id, _, _, _) -> id
33193320
| _ -> name_pattern default rem
33203321
)
33213322
| _ -> Ident.create_local default
@@ -3819,7 +3820,7 @@ let for_let ~scopes ~arg_sort ~return_layout loc param pat body =
38193820
(* This eliminates a useless variable (and stack slot in bytecode)
38203821
for "let _ = ...". See #6865. *)
38213822
Lsequence (param, body)
3822-
| Tpat_var (id, _, _) ->
3823+
| Tpat_var (id, _, _, _) ->
38233824
(* fast path, and keep track of simple bindings to unboxable numbers *)
38243825
let k = Typeopt.layout pat.pat_env pat.pat_loc arg_sort pat.pat_type in
38253826
Llet (Strict, k, id, param, body)

‎lambda/translclass.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -152,8 +152,8 @@ let create_object cl obj init =
152152

153153
let name_pattern default p =
154154
match p.pat_desc with
155-
| Tpat_var (id, _, _) -> id
156-
| Tpat_alias(_, id, _, _) -> id
155+
| Tpat_var (id, _, _, _) -> id
156+
| Tpat_alias(_, id, _, _, _) -> id
157157
| _ -> Ident.create_local default
158158

159159
let rec build_object_init ~scopes cl_table obj params inh_init obj_init cl =

‎lambda/translcore.ml

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -222,7 +222,7 @@ let rec trivial_pat pat =
222222
match pat.pat_desc with
223223
Tpat_var _
224224
| Tpat_any -> true
225-
| Tpat_alias (p, _, _, _) ->
225+
| Tpat_alias (p, _, _, _, _) ->
226226
trivial_pat p
227227
| Tpat_construct (_, cd, [], _) ->
228228
not cd.cstr_generalized && cd.cstr_consts = 1 && cd.cstr_nonconsts = 0
@@ -283,7 +283,8 @@ let rec push_defaults loc bindings use_lhs arg_mode arg_sort cases
283283
arg_sort,
284284
cases, partial) }
285285
in
286-
[{c_lhs = {pat with pat_desc = Tpat_var (param, mknoloc name, mode)};
286+
[{c_lhs = {pat with
287+
pat_desc = Tpat_var (param, mknoloc name, desc.val_uid, mode)};
287288
c_guard = None; c_rhs= wrap_bindings bindings exp}]
288289
| _ ->
289290
cases
@@ -335,8 +336,8 @@ let assert_failed ~scopes exp =
335336

336337
let rec iter_exn_names f pat =
337338
match pat.pat_desc with
338-
| Tpat_var (id, _, _) -> f id
339-
| Tpat_alias (p, id, _, _) ->
339+
| Tpat_var (id, _, _, _) -> f id
340+
| Tpat_alias (p, id, _, _, _) ->
340341
f id;
341342
iter_exn_names f p
342343
| _ -> ()
@@ -1443,7 +1444,7 @@ and transl_let ~scopes ~return_layout ?(add_regions=false) ?(in_structure=false)
14431444
let idlist =
14441445
List.map
14451446
(fun {vb_pat=pat} -> match pat.pat_desc with
1446-
Tpat_var (id,_,_) -> id
1447+
Tpat_var (id,_,_,_) -> id
14471448
| _ -> assert false)
14481449
pat_expr_list in
14491450
let transl_case

‎ocamldoc/odoc_ast.ml

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -50,7 +50,7 @@ module Typedtree_search =
5050

5151
let iter_val_pattern = function
5252
| Typedtree.Tpat_any -> None
53-
| Typedtree.Tpat_var (name, _, _) -> Some (Name.from_ident name)
53+
| Typedtree.Tpat_var (name, _, _, _) -> Some (Name.from_ident name)
5454
| Typedtree.Tpat_tuple _ -> None (* FIXME when we will handle tuples *)
5555
| _ -> None
5656

@@ -241,14 +241,14 @@ module Analyser =
241241
let tt_param_info_from_pattern env f_desc pat =
242242
let rec iter_pattern pat =
243243
match pat.pat_desc with
244-
Typedtree.Tpat_var (ident, _, _) ->
244+
Typedtree.Tpat_var (ident, _, _, _) ->
245245
let name = Name.from_ident ident in
246246
Simple_name { sn_name = name ;
247247
sn_text = f_desc name ;
248248
sn_type = Odoc_env.subst_type env pat.pat_type
249249
}
250250

251-
| Typedtree.Tpat_alias (pat, _, _, _) ->
251+
| Typedtree.Tpat_alias (pat, _, _, _, _) ->
252252
iter_pattern pat
253253

254254
| Typedtree.Tpat_tuple patlist ->
@@ -307,7 +307,7 @@ module Analyser =
307307
(
308308
(
309309
match func_body.exp_desc with
310-
Typedtree.Texp_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id, _, _) };
310+
Typedtree.Texp_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id, _, _, _) };
311311
vb_expr=exp} :: _, func_body2) ->
312312
let name = Name.from_ident id in
313313
let new_param = Simple_name
@@ -337,7 +337,7 @@ module Analyser =
337337
let tt_analyse_value env current_module_name comment_opt loc pat_exp rec_flag =
338338
let (pat, exp) = pat_exp in
339339
match (pat.pat_desc, exp.exp_desc) with
340-
(Typedtree.Tpat_var (ident, _, _), Typedtree.Texp_function { cases = pat_exp_list2; _ }) ->
340+
(Typedtree.Tpat_var (ident, _, _, _), Typedtree.Texp_function { cases = pat_exp_list2; _ }) ->
341341
(* a new function is defined *)
342342
let name_pre = Name.from_ident ident in
343343
let name = Name.parens_if_infix name_pre in
@@ -362,7 +362,7 @@ module Analyser =
362362
in
363363
[ new_value ]
364364

365-
| (Typedtree.Tpat_var (ident, _, _), _) ->
365+
| (Typedtree.Tpat_var (ident, _, _, _), _) ->
366366
(* a new value is defined *)
367367
let name_pre = Name.from_ident ident in
368368
let name = Name.parens_if_infix name_pre in
@@ -467,7 +467,7 @@ module Analyser =
467467
(
468468
(
469469
match body.exp_desc with
470-
Typedtree.Texp_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id, _, _) };
470+
Typedtree.Texp_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id, _, _, _) };
471471
vb_expr=exp} :: _, body2) ->
472472
let name = Name.from_ident id in
473473
let new_param = Simple_name
@@ -728,11 +728,11 @@ module Analyser =
728728
a default value. In this case, we look for the good parameter pattern *)
729729
let (parameter, next_tt_class_exp) =
730730
match pat.Typedtree.pat_desc with
731-
Typedtree.Tpat_var (ident, _, _) when String.starts_with (Name.from_ident ident) ~prefix:"*opt*" ->
731+
Typedtree.Tpat_var (ident, _, _, _) when String.starts_with (Name.from_ident ident) ~prefix:"*opt*" ->
732732
(
733733
(* there must be a Tcl_let just after *)
734734
match tt_class_expr2.Typedtree.cl_desc with
735-
Typedtree.Tcl_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id,_,_) };
735+
Typedtree.Tcl_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id,_,_,_) };
736736
vb_expr=exp} :: _, _, tt_class_expr3) ->
737737
let name = Name.from_ident id in
738738
let new_param = Simple_name

‎testsuite/tests/shapes/simple.ml

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -126,9 +126,9 @@ class c : object end
126126
class type c = object end
127127
[%%expect{|
128128
{
129-
"#c"[type] -> <.34>;
130-
"c"[type] -> <.34>;
131-
"c"[class type] -> <.34>;
129+
"#c"[type] -> <.35>;
130+
"c"[type] -> <.35>;
131+
"c"[class type] -> <.35>;
132132
}
133133
class type c = object end
134134
|}]

‎toplevel/native/topeval.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -134,7 +134,7 @@ let name_expression ~loc ~attrs sort exp =
134134
in
135135
let sg = [Sig_value(id, vd, Exported)] in
136136
let pat =
137-
{ pat_desc = Tpat_var(id, mknoloc name, Mode.Value.legacy);
137+
{ pat_desc = Tpat_var(id, mknoloc name, vd.val_uid, Mode.Value.legacy);
138138
pat_loc = loc;
139139
pat_extra = [];
140140
pat_type = exp.exp_type;

‎typing/cmt2annot.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@ let variables_iterator scope =
2323
let super = default_iterator in
2424
let pat sub (type k) (p : k general_pattern) =
2525
begin match p.pat_desc with
26-
| Tpat_var (id, _, _) | Tpat_alias (_, id, _, _) ->
26+
| Tpat_var (id, _, _, _) | Tpat_alias (_, id, _, _, _) ->
2727
Stypes.record (Stypes.An_ident (p.pat_loc,
2828
Ident.name id,
2929
Annot.Idef scope))

‎typing/parmatch.ml

Lines changed: 18 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,8 @@ let omega_list = Patterns.omega_list
3737

3838
let extra_pat =
3939
make_pat
40-
(Tpat_var (Ident.create_local "+", mknoloc "+", Mode.Value.max_mode))
40+
(Tpat_var (Ident.create_local "+", mknoloc "+",
41+
Uid.internal_not_actually_unique, Mode.Value.max_mode))
4142
Ctype.none Env.empty
4243

4344

@@ -283,8 +284,8 @@ module Compat
283284
| ((Tpat_any|Tpat_var _),_)
284285
| (_,(Tpat_any|Tpat_var _)) -> true
285286
(* Structural induction *)
286-
| Tpat_alias (p,_,_,_),_ -> compat p q
287-
| _,Tpat_alias (q,_,_,_) -> compat p q
287+
| Tpat_alias (p,_,_,_,_),_ -> compat p q
288+
| _,Tpat_alias (q,_,_,_,_) -> compat p q
288289
| Tpat_or (p1,p2,_),_ ->
289290
(compat p1 q || compat p2 q)
290291
| _,Tpat_or (q1,q2,_) ->
@@ -930,7 +931,7 @@ let build_other ext env =
930931
make_pat
931932
(Tpat_var (Ident.create_local "*extension*",
932933
{txt="*extension*"; loc = d.pat_loc},
933-
Mode.Value.max_mode))
934+
Uid.internal_not_actually_unique, Mode.Value.max_mode))
934935
Ctype.none Env.empty
935936
| Construct _ ->
936937
begin match ext with
@@ -1064,7 +1065,7 @@ let build_other ext env =
10641065
let rec has_instance p = match p.pat_desc with
10651066
| Tpat_variant (l,_,r) when is_absent l r -> false
10661067
| Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_variant (_,None,_) -> true
1067-
| Tpat_alias (p,_,_,_) | Tpat_variant (_,Some p,_) -> has_instance p
1068+
| Tpat_alias (p,_,_,_,_) | Tpat_variant (_,Some p,_) -> has_instance p
10681069
| Tpat_or (p1,p2,_) -> has_instance p1 || has_instance p2
10691070
| Tpat_construct (_,_,ps, _) | Tpat_tuple ps | Tpat_array (_, ps) ->
10701071
has_instances ps
@@ -1519,7 +1520,7 @@ let is_var_column rs =
15191520
(* Standard or-args for left-to-right matching *)
15201521
let rec or_args p = match p.pat_desc with
15211522
| Tpat_or (p1,p2,_) -> p1,p2
1522-
| Tpat_alias (p,_,_,_) -> or_args p
1523+
| Tpat_alias (p,_,_,_,_) -> or_args p
15231524
| _ -> assert false
15241525

15251526
(* Just remove current column *)
@@ -1699,8 +1700,8 @@ and every_both pss qs q1 q2 =
16991700
let rec le_pat p q =
17001701
match (p.pat_desc, q.pat_desc) with
17011702
| (Tpat_var _|Tpat_any),_ -> true
1702-
| Tpat_alias(p,_,_,_), _ -> le_pat p q
1703-
| _, Tpat_alias(q,_,_,_) -> le_pat p q
1703+
| Tpat_alias(p,_,_,_,_), _ -> le_pat p q
1704+
| _, Tpat_alias(q,_,_,_,_) -> le_pat p q
17041705
| Tpat_constant(c1), Tpat_constant(c2) -> const_compare c1 c2 = 0
17051706
| Tpat_construct(_,c1,ps,_), Tpat_construct(_,c2,qs,_) ->
17061707
Types.equal_tag c1.cstr_tag c2.cstr_tag && le_pats ps qs
@@ -1739,8 +1740,8 @@ let get_mins le ps =
17391740
*)
17401741

17411742
let rec lub p q = match p.pat_desc,q.pat_desc with
1742-
| Tpat_alias (p,_,_,_),_ -> lub p q
1743-
| _,Tpat_alias (q,_,_,_) -> lub p q
1743+
| Tpat_alias (p,_,_,_,_),_ -> lub p q
1744+
| _,Tpat_alias (q,_,_,_,_) -> lub p q
17441745
| (Tpat_any|Tpat_var _),_ -> q
17451746
| _,(Tpat_any|Tpat_var _) -> p
17461747
| Tpat_or (p1,p2,_),_ -> orlub p1 p2 q
@@ -1878,14 +1879,14 @@ module Conv = struct
18781879
match pat.pat_desc with
18791880
Tpat_or (pa,pb,_) ->
18801881
mkpat (Ppat_or (loop pa, loop pb))
1881-
| Tpat_var (_, ({txt="*extension*"} as nm), _) -> (* PR#7330 *)
1882+
| Tpat_var (_, ({txt="*extension*"} as nm), _, _) -> (* PR#7330 *)
18821883
mkpat (Ppat_var nm)
18831884
| Tpat_any
18841885
| Tpat_var _ ->
18851886
mkpat Ppat_any
18861887
| Tpat_constant c ->
18871888
mkpat (Ppat_constant (Untypeast.constant c))
1888-
| Tpat_alias (p,_,_,_) -> loop p
1889+
| Tpat_alias (p,_,_,_,_) -> loop p
18891890
| Tpat_tuple lst ->
18901891
mkpat (Ppat_tuple (List.map loop lst))
18911892
| Tpat_construct (cstr_lid, cstr, lst, _) ->
@@ -1936,7 +1937,7 @@ end
19361937
let contains_extension pat =
19371938
exists_pattern
19381939
(function
1939-
| {pat_desc=Tpat_var (_, {txt="*extension*"}, _)} -> true
1940+
| {pat_desc=Tpat_var (_, {txt="*extension*"}, _, _)} -> true
19401941
| _ -> false)
19411942
pat
19421943

@@ -2047,7 +2048,7 @@ let rec collect_paths_from_pat r p = match p.pat_desc with
20472048
List.fold_left
20482049
(fun r (_, _, p) -> collect_paths_from_pat r p)
20492050
r lps
2050-
| Tpat_variant (_, Some p, _) | Tpat_alias (p,_,_,_) -> collect_paths_from_pat r p
2051+
| Tpat_variant (_, Some p, _) | Tpat_alias (p,_,_,_,_) -> collect_paths_from_pat r p
20512052
| Tpat_or (p1,p2,_) ->
20522053
collect_paths_from_pat (collect_paths_from_pat r p1) p2
20532054
| Tpat_lazy p
@@ -2182,7 +2183,7 @@ let inactive ~partial pat =
21822183
| Tpat_tuple ps | Tpat_construct (_, _, ps, _)
21832184
| Tpat_array (Immutable, ps) ->
21842185
List.for_all (fun p -> loop p) ps
2185-
| Tpat_alias (p,_,_,_) | Tpat_variant (_, Some p, _) ->
2186+
| Tpat_alias (p,_,_,_,_) | Tpat_variant (_, Some p, _) ->
21862187
loop p
21872188
| Tpat_record (ldps,_) ->
21882189
List.for_all
@@ -2301,9 +2302,9 @@ type amb_row = { row : pattern list ; varsets : Ident.Set.t list; }
23012302
let simplify_head_amb_pat head_bound_variables varsets ~add_column p ps k =
23022303
let rec simpl head_bound_variables varsets p ps k =
23032304
match (Patterns.General.view p).pat_desc with
2304-
| `Alias (p,x,_,_) ->
2305+
| `Alias (p,x,_,_,_) ->
23052306
simpl (Ident.Set.add x head_bound_variables) varsets p ps k
2306-
| `Var (x, _, _) ->
2307+
| `Var (x, _, _, _) ->
23072308
simpl (Ident.Set.add x head_bound_variables) varsets Patterns.omega ps k
23082309
| `Or (p1,p2,_) ->
23092310
simpl head_bound_variables varsets p1 ps

0 commit comments

Comments
 (0)