Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Manually applied changes from PR #11782 #1732

Merged
merged 5 commits into from
Sep 21, 2023
Merged

Manually applied changes from PR #11782 #1732

Show file tree
Hide file tree
Changes from 3 commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
f2a56e6
Manually applied changes from PR #11782
tonowak Aug 8, 2023
ded2ee0
Pass Uid through pattern_variable
tonowak Aug 30, 2023
92fd9b7
Pass Uid a bit further to loops and add comments when we stop passing it
tonowak Aug 30, 2023
04a5892
Fix test
mshinwell Sep 21, 2023
9dc2f03
Fix minimizer
mshinwell Sep 21, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion native_toplevel/opttoploop.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -378,7 +378,7 @@ let name_expression ~loc ~attrs sort exp =
in
let sg = [Sig_value(id, vd, Exported)] in
let pat =
{ pat_desc = Tpat_var(id, mknoloc name, Mode.Value.legacy);
{ pat_desc = Tpat_var(id, mknoloc name, vd.val_uid, Mode.Value.legacy);
pat_loc = loc;
pat_extra = [];
pat_type = exp.exp_type;
Expand Down
29 changes: 15 additions & 14 deletions ocaml/lambda/matching.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -234,8 +234,8 @@ end = struct
| Tpat_any
| Tpat_var _ ->
p
| Tpat_alias (q, id, s, mode) ->
{ p with pat_desc = Tpat_alias (simpl_under_orpat q, id, s, mode) }
| Tpat_alias (q, id, s, uid, mode) ->
{ p with pat_desc = Tpat_alias (simpl_under_orpat q, id, s, uid, mode) }
| Tpat_or (p1, p2, o) ->
let p1, p2 = (simpl_under_orpat p1, simpl_under_orpat p2) in
if le_pat p1 p2 then
Expand All @@ -258,8 +258,9 @@ end = struct
in
match p.pat_desc with
| `Any -> stop p `Any
| `Var (id, s, mode) -> continue p (`Alias (Patterns.omega, id, s, mode))
| `Alias (p, id, _, _) ->
| `Var (id, s, uid, mode) ->
continue p (`Alias (Patterns.omega, id, s, uid, mode))
| `Alias (p, id, _, _, _) ->
aux
( (General.view p, patl),
bind_alias p id ~arg ~arg_sort ~action )
Expand Down Expand Up @@ -354,10 +355,10 @@ end = struct
match p.pat_desc with
| `Or (p1, p2, _) ->
split_explode p1 aliases (split_explode p2 aliases rem)
| `Alias (p, id, _, _) -> split_explode p (id :: aliases) rem
| `Var (id, str, mode) ->
| `Alias (p, id, _, _, _) -> split_explode p (id :: aliases) rem
| `Var (id, str, uid, mode) ->
explode
{ p with pat_desc = `Alias (Patterns.omega, id, str, mode) }
{ p with pat_desc = `Alias (Patterns.omega, id, str, uid, mode) }
aliases rem
| #view as view ->
(* We are doing two things here:
Expand Down Expand Up @@ -595,7 +596,7 @@ end = struct
match p.pat_desc with
| `Or (p1, p2, _) ->
filter_rec ((left, p1, right) :: (left, p2, right) :: rem)
| `Alias (p, _, _, _) -> filter_rec ((left, p, right) :: rem)
| `Alias (p, _, _, _, _) -> filter_rec ((left, p, right) :: rem)
| `Var _ -> filter_rec ((left, Patterns.omega, right) :: rem)
| #Simple.view as view -> (
let p = { p with pat_desc = view } in
Expand Down Expand Up @@ -645,7 +646,7 @@ let rec flatten_pat_line size p k =
| Tpat_tuple args -> args :: k
| Tpat_or (p1, p2, _) ->
flatten_pat_line size p1 (flatten_pat_line size p2 k)
| Tpat_alias (p, _, _, _) ->
| Tpat_alias (p, _, _, _, _) ->
(* Note: we are only called from flatten_matrix,
which is itself only ever used in places
where variables do not matter (default environments,
Expand Down Expand Up @@ -722,7 +723,7 @@ end = struct
| (p, ps) :: rem -> (
let p = General.view p in
match p.pat_desc with
| `Alias (p, _, _, _) -> filter_rec ((p, ps) :: rem)
| `Alias (p, _, _, _, _) -> filter_rec ((p, ps) :: rem)
| `Var _ -> filter_rec ((Patterns.omega, ps) :: rem)
| `Or (p1, p2, _) -> filter_rec_or p1 p2 ps rem
| #Simple.view as view -> (
Expand Down Expand Up @@ -1208,7 +1209,7 @@ let rec omega_like p =
| Tpat_any
| Tpat_var _ ->
true
| Tpat_alias (p, _, _, _) -> omega_like p
| Tpat_alias (p, _, _, _, _) -> omega_like p
| Tpat_or (p1, p2, _) -> omega_like p1 || omega_like p2
| _ -> false

Expand Down Expand Up @@ -3314,8 +3315,8 @@ let rec comp_match_handlers value_kind comp_fun partial ctx first_match next_mat
let rec name_pattern default = function
| ((pat, _), _) :: rem -> (
match pat.pat_desc with
| Tpat_var (id, _, _) -> id
| Tpat_alias (_, id, _, _) -> id
| Tpat_var (id, _, _, _) -> id
| Tpat_alias (_, id, _, _, _) -> id
| _ -> name_pattern default rem
)
| _ -> Ident.create_local default
Expand Down Expand Up @@ -3819,7 +3820,7 @@ let for_let ~scopes ~arg_sort ~return_layout loc param pat body =
(* This eliminates a useless variable (and stack slot in bytecode)
for "let _ = ...". See #6865. *)
Lsequence (param, body)
| Tpat_var (id, _, _) ->
| Tpat_var (id, _, _, _) ->
(* fast path, and keep track of simple bindings to unboxable numbers *)
let k = Typeopt.layout pat.pat_env pat.pat_loc arg_sort pat.pat_type in
Llet (Strict, k, id, param, body)
Expand Down
4 changes: 2 additions & 2 deletions ocaml/lambda/translclass.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -152,8 +152,8 @@ let create_object cl obj init =

let name_pattern default p =
match p.pat_desc with
| Tpat_var (id, _, _) -> id
| Tpat_alias(_, id, _, _) -> id
| Tpat_var (id, _, _, _) -> id
| Tpat_alias(_, id, _, _, _) -> id
| _ -> Ident.create_local default

let rec build_object_init ~scopes cl_table obj params inh_init obj_init cl =
Expand Down
11 changes: 6 additions & 5 deletions ocaml/lambda/translcore.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -222,7 +222,7 @@ let rec trivial_pat pat =
match pat.pat_desc with
Tpat_var _
| Tpat_any -> true
| Tpat_alias (p, _, _, _) ->
| Tpat_alias (p, _, _, _, _) ->
trivial_pat p
| Tpat_construct (_, cd, [], _) ->
not cd.cstr_generalized && cd.cstr_consts = 1 && cd.cstr_nonconsts = 0
Expand Down Expand Up @@ -283,7 +283,8 @@ let rec push_defaults loc bindings use_lhs arg_mode arg_sort cases
arg_sort,
cases, partial) }
in
[{c_lhs = {pat with pat_desc = Tpat_var (param, mknoloc name, mode)};
[{c_lhs = {pat with
pat_desc = Tpat_var (param, mknoloc name, desc.val_uid, mode)};
c_guard = None; c_rhs= wrap_bindings bindings exp}]
| _ ->
cases
Expand Down Expand Up @@ -335,8 +336,8 @@ let assert_failed ~scopes exp =

let rec iter_exn_names f pat =
match pat.pat_desc with
| Tpat_var (id, _, _) -> f id
| Tpat_alias (p, id, _, _) ->
| Tpat_var (id, _, _, _) -> f id
| Tpat_alias (p, id, _, _, _) ->
f id;
iter_exn_names f p
| _ -> ()
Expand Down Expand Up @@ -1443,7 +1444,7 @@ and transl_let ~scopes ~return_layout ?(add_regions=false) ?(in_structure=false)
let idlist =
List.map
(fun {vb_pat=pat} -> match pat.pat_desc with
Tpat_var (id,_,_) -> id
Tpat_var (id,_,_,_) -> id
| _ -> assert false)
pat_expr_list in
let transl_case
Expand Down
18 changes: 9 additions & 9 deletions ocaml/ocamldoc/odoc_ast.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,7 @@ module Typedtree_search =

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

Expand Down Expand Up @@ -241,14 +241,14 @@ module Analyser =
let tt_param_info_from_pattern env f_desc pat =
let rec iter_pattern pat =
match pat.pat_desc with
Typedtree.Tpat_var (ident, _, _) ->
Typedtree.Tpat_var (ident, _, _, _) ->
let name = Name.from_ident ident in
Simple_name { sn_name = name ;
sn_text = f_desc name ;
sn_type = Odoc_env.subst_type env pat.pat_type
}

| Typedtree.Tpat_alias (pat, _, _, _) ->
| Typedtree.Tpat_alias (pat, _, _, _, _) ->
iter_pattern pat

| Typedtree.Tpat_tuple patlist ->
Expand Down Expand Up @@ -307,7 +307,7 @@ module Analyser =
(
(
match func_body.exp_desc with
Typedtree.Texp_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id, _, _) };
Typedtree.Texp_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id, _, _, _) };
vb_expr=exp} :: _, func_body2) ->
let name = Name.from_ident id in
let new_param = Simple_name
Expand Down Expand Up @@ -337,7 +337,7 @@ module Analyser =
let tt_analyse_value env current_module_name comment_opt loc pat_exp rec_flag =
let (pat, exp) = pat_exp in
match (pat.pat_desc, exp.exp_desc) with
(Typedtree.Tpat_var (ident, _, _), Typedtree.Texp_function { cases = pat_exp_list2; _ }) ->
(Typedtree.Tpat_var (ident, _, _, _), Typedtree.Texp_function { cases = pat_exp_list2; _ }) ->
(* a new function is defined *)
let name_pre = Name.from_ident ident in
let name = Name.parens_if_infix name_pre in
Expand All @@ -362,7 +362,7 @@ module Analyser =
in
[ new_value ]

| (Typedtree.Tpat_var (ident, _, _), _) ->
| (Typedtree.Tpat_var (ident, _, _, _), _) ->
(* a new value is defined *)
let name_pre = Name.from_ident ident in
let name = Name.parens_if_infix name_pre in
Expand Down Expand Up @@ -467,7 +467,7 @@ module Analyser =
(
(
match body.exp_desc with
Typedtree.Texp_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id, _, _) };
Typedtree.Texp_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id, _, _, _) };
vb_expr=exp} :: _, body2) ->
let name = Name.from_ident id in
let new_param = Simple_name
Expand Down Expand Up @@ -728,11 +728,11 @@ module Analyser =
a default value. In this case, we look for the good parameter pattern *)
let (parameter, next_tt_class_exp) =
match pat.Typedtree.pat_desc with
Typedtree.Tpat_var (ident, _, _) when String.starts_with (Name.from_ident ident) ~prefix:"*opt*" ->
Typedtree.Tpat_var (ident, _, _, _) when String.starts_with (Name.from_ident ident) ~prefix:"*opt*" ->
(
(* there must be a Tcl_let just after *)
match tt_class_expr2.Typedtree.cl_desc with
Typedtree.Tcl_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id,_,_) };
Typedtree.Tcl_let (_, {vb_pat={pat_desc = Typedtree.Tpat_var (id,_,_,_) };
vb_expr=exp} :: _, _, tt_class_expr3) ->
let name = Name.from_ident id in
let new_param = Simple_name
Expand Down
2 changes: 1 addition & 1 deletion ocaml/toplevel/native/topeval.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -134,7 +134,7 @@ let name_expression ~loc ~attrs sort exp =
in
let sg = [Sig_value(id, vd, Exported)] in
let pat =
{ pat_desc = Tpat_var(id, mknoloc name, Mode.Value.legacy);
{ pat_desc = Tpat_var(id, mknoloc name, vd.val_uid, Mode.Value.legacy);
pat_loc = loc;
pat_extra = [];
pat_type = exp.exp_type;
Expand Down
2 changes: 1 addition & 1 deletion ocaml/typing/cmt2annot.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ let variables_iterator scope =
let super = default_iterator in
let pat sub (type k) (p : k general_pattern) =
begin match p.pat_desc with
| Tpat_var (id, _, _) | Tpat_alias (_, id, _, _) ->
| Tpat_var (id, _, _, _) | Tpat_alias (_, id, _, _, _) ->
Stypes.record (Stypes.An_ident (p.pat_loc,
Ident.name id,
Annot.Idef scope))
Expand Down
35 changes: 18 additions & 17 deletions ocaml/typing/parmatch.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,8 @@ let omega_list = Patterns.omega_list

let extra_pat =
make_pat
(Tpat_var (Ident.create_local "+", mknoloc "+", Mode.Value.max_mode))
(Tpat_var (Ident.create_local "+", mknoloc "+",
Uid.internal_not_actually_unique, Mode.Value.max_mode))
Ctype.none Env.empty


Expand Down Expand Up @@ -283,8 +284,8 @@ module Compat
| ((Tpat_any|Tpat_var _),_)
| (_,(Tpat_any|Tpat_var _)) -> true
(* Structural induction *)
| Tpat_alias (p,_,_,_),_ -> compat p q
| _,Tpat_alias (q,_,_,_) -> compat p q
| Tpat_alias (p,_,_,_,_),_ -> compat p q
| _,Tpat_alias (q,_,_,_,_) -> compat p q
| Tpat_or (p1,p2,_),_ ->
(compat p1 q || compat p2 q)
| _,Tpat_or (q1,q2,_) ->
Expand Down Expand Up @@ -930,7 +931,7 @@ let build_other ext env =
make_pat
(Tpat_var (Ident.create_local "*extension*",
{txt="*extension*"; loc = d.pat_loc},
Mode.Value.max_mode))
Uid.internal_not_actually_unique, Mode.Value.max_mode))
Ctype.none Env.empty
| Construct _ ->
begin match ext with
Expand Down Expand Up @@ -1064,7 +1065,7 @@ let build_other ext env =
let rec has_instance p = match p.pat_desc with
| Tpat_variant (l,_,r) when is_absent l r -> false
| Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_variant (_,None,_) -> true
| Tpat_alias (p,_,_,_) | Tpat_variant (_,Some p,_) -> has_instance p
| Tpat_alias (p,_,_,_,_) | Tpat_variant (_,Some p,_) -> has_instance p
| Tpat_or (p1,p2,_) -> has_instance p1 || has_instance p2
| Tpat_construct (_,_,ps, _) | Tpat_tuple ps | Tpat_array (_, ps) ->
has_instances ps
Expand Down Expand Up @@ -1519,7 +1520,7 @@ let is_var_column rs =
(* Standard or-args for left-to-right matching *)
let rec or_args p = match p.pat_desc with
| Tpat_or (p1,p2,_) -> p1,p2
| Tpat_alias (p,_,_,_) -> or_args p
| Tpat_alias (p,_,_,_,_) -> or_args p
| _ -> assert false

(* Just remove current column *)
Expand Down Expand Up @@ -1699,8 +1700,8 @@ and every_both pss qs q1 q2 =
let rec le_pat p q =
match (p.pat_desc, q.pat_desc) with
| (Tpat_var _|Tpat_any),_ -> true
| Tpat_alias(p,_,_,_), _ -> le_pat p q
| _, Tpat_alias(q,_,_,_) -> le_pat p q
| Tpat_alias(p,_,_,_,_), _ -> le_pat p q
| _, Tpat_alias(q,_,_,_,_) -> le_pat p q
| Tpat_constant(c1), Tpat_constant(c2) -> const_compare c1 c2 = 0
| Tpat_construct(_,c1,ps,_), Tpat_construct(_,c2,qs,_) ->
Types.equal_tag c1.cstr_tag c2.cstr_tag && le_pats ps qs
Expand Down Expand Up @@ -1739,8 +1740,8 @@ let get_mins le ps =
*)

let rec lub p q = match p.pat_desc,q.pat_desc with
| Tpat_alias (p,_,_,_),_ -> lub p q
| _,Tpat_alias (q,_,_,_) -> lub p q
| Tpat_alias (p,_,_,_,_),_ -> lub p q
| _,Tpat_alias (q,_,_,_,_) -> lub p q
| (Tpat_any|Tpat_var _),_ -> q
| _,(Tpat_any|Tpat_var _) -> p
| Tpat_or (p1,p2,_),_ -> orlub p1 p2 q
Expand Down Expand Up @@ -1878,14 +1879,14 @@ module Conv = struct
match pat.pat_desc with
Tpat_or (pa,pb,_) ->
mkpat (Ppat_or (loop pa, loop pb))
| Tpat_var (_, ({txt="*extension*"} as nm), _) -> (* PR#7330 *)
| Tpat_var (_, ({txt="*extension*"} as nm), _, _) -> (* PR#7330 *)
mkpat (Ppat_var nm)
| Tpat_any
| Tpat_var _ ->
mkpat Ppat_any
| Tpat_constant c ->
mkpat (Ppat_constant (Untypeast.constant c))
| Tpat_alias (p,_,_,_) -> loop p
| Tpat_alias (p,_,_,_,_) -> loop p
| Tpat_tuple lst ->
mkpat (Ppat_tuple (List.map loop lst))
| Tpat_construct (cstr_lid, cstr, lst, _) ->
Expand Down Expand Up @@ -1936,7 +1937,7 @@ end
let contains_extension pat =
exists_pattern
(function
| {pat_desc=Tpat_var (_, {txt="*extension*"}, _)} -> true
| {pat_desc=Tpat_var (_, {txt="*extension*"}, _, _)} -> true
| _ -> false)
pat

Expand Down Expand Up @@ -2047,7 +2048,7 @@ let rec collect_paths_from_pat r p = match p.pat_desc with
List.fold_left
(fun r (_, _, p) -> collect_paths_from_pat r p)
r lps
| Tpat_variant (_, Some p, _) | Tpat_alias (p,_,_,_) -> collect_paths_from_pat r p
| Tpat_variant (_, Some p, _) | Tpat_alias (p,_,_,_,_) -> collect_paths_from_pat r p
| Tpat_or (p1,p2,_) ->
collect_paths_from_pat (collect_paths_from_pat r p1) p2
| Tpat_lazy p
Expand Down Expand Up @@ -2182,7 +2183,7 @@ let inactive ~partial pat =
| Tpat_tuple ps | Tpat_construct (_, _, ps, _)
| Tpat_array (Immutable, ps) ->
List.for_all (fun p -> loop p) ps
| Tpat_alias (p,_,_,_) | Tpat_variant (_, Some p, _) ->
| Tpat_alias (p,_,_,_,_) | Tpat_variant (_, Some p, _) ->
loop p
| Tpat_record (ldps,_) ->
List.for_all
Expand Down Expand Up @@ -2301,9 +2302,9 @@ type amb_row = { row : pattern list ; varsets : Ident.Set.t list; }
let simplify_head_amb_pat head_bound_variables varsets ~add_column p ps k =
let rec simpl head_bound_variables varsets p ps k =
match (Patterns.General.view p).pat_desc with
| `Alias (p,x,_,_) ->
| `Alias (p,x,_,_,_) ->
simpl (Ident.Set.add x head_bound_variables) varsets p ps k
| `Var (x, _, _) ->
| `Var (x, _, _, _) ->
simpl (Ident.Set.add x head_bound_variables) varsets Patterns.omega ps k
| `Or (p1,p2,_) ->
simpl head_bound_variables varsets p1 ps
Expand Down
Loading
Loading