Skip to content

Commit

Permalink
Restore locations to Typedtree.{pat,let}_bound_idents_full
Browse files Browse the repository at this point in the history
  • Loading branch information
stedolan committed Jan 4, 2022
1 parent e450b6c commit 7751faa
Show file tree
Hide file tree
Showing 4 changed files with 14 additions and 14 deletions.
8 changes: 4 additions & 4 deletions lambda/matching.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1482,8 +1482,8 @@ and precompile_or ~arg_id (cls : Simple.clause list) ors args def k =
(* bound variables of the or-pattern and used in the orpm
actions *)
Typedtree.pat_bound_idents_full orp
|> List.filter (fun (id, _) -> Ident.Set.mem id pm_fv)
|> List.map (fun (id, ty) ->
|> List.filter (fun (id, _, _) -> Ident.Set.mem id pm_fv)
|> List.map (fun (id, _, ty) ->
(id, Typeopt.value_kind orp.pat_env ty))
in
let or_num = next_raise_count () in
Expand Down Expand Up @@ -3595,10 +3595,10 @@ let for_let ~scopes loc param pat body =
let catch_ids = pat_bound_idents_full pat in
let ids_with_kinds =
List.map
(fun (id, typ) -> (id, Typeopt.value_kind pat.pat_env typ))
(fun (id, _, typ) -> (id, Typeopt.value_kind pat.pat_env typ))
catch_ids
in
let ids = List.map (fun (id, _) -> id) catch_ids in
let ids = List.map (fun (id, _, _) -> id) catch_ids in
let bind =
map_return (assign_pat ~scopes opt nraise ids loc pat) param in
if !opt then
Expand Down
4 changes: 2 additions & 2 deletions lambda/translcore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1336,9 +1336,9 @@ and transl_match ~scopes e arg pat_expr_list partial =
(* Simplif doesn't like it if binders are not uniq, so we make sure to
use different names in the value and the exception branches. *)
let ids_full = Typedtree.pat_bound_idents_full pv in
let ids = List.map (fun (id, _) -> id) ids_full in
let ids = List.map (fun (id, _, _) -> id) ids_full in
let ids_kinds =
List.map (fun (id, ty) -> id, Typeopt.value_kind pv.pat_env ty)
List.map (fun (id, _, ty) -> id, Typeopt.value_kind pv.pat_env ty)
ids_full
in
let vids = List.map Ident.rename ids in
Expand Down
12 changes: 6 additions & 6 deletions typing/typedtree.ml
Original file line number Diff line number Diff line change
Expand Up @@ -779,11 +779,11 @@ let rec iter_bound_idents
: type k . _ -> k general_pattern -> _
= fun f pat ->
match pat.pat_desc with
| Tpat_var (id, _) ->
f (id, pat.pat_type)
| Tpat_alias(p, id, _) ->
| Tpat_var (id, s) ->
f (id,s,pat.pat_type)
| Tpat_alias(p, id, s) ->
iter_bound_idents f p;
f (id, pat.pat_type)
f (id,s,pat.pat_type)
| Tpat_or(p1, _, _) ->
(* Invariant : both arguments bind the same variables *)
iter_bound_idents f p1
Expand All @@ -799,7 +799,7 @@ let rev_pat_bound_idents_full pat =
!idents_full
let rev_only_idents idents_full =
List.rev_map (fun (id,_) -> id) idents_full
List.rev_map (fun (id,_,_) -> id) idents_full
let pat_bound_idents_full pat =
List.rev (rev_pat_bound_idents_full pat)
Expand All @@ -826,7 +826,7 @@ let let_bound_idents_with_modes bindings =
in
List.iter (fun vb -> loop vb.vb_pat) bindings;
List.rev_map
(fun (id, _) -> id, List.rev (Ident.Tbl.find_all modes id))
(fun (id, _, _) -> id, List.rev (Ident.Tbl.find_all modes id))
(rev_let_bound_idents_full bindings)
let let_bound_idents_full bindings =
Expand Down
4 changes: 2 additions & 2 deletions typing/typedtree.mli
Original file line number Diff line number Diff line change
Expand Up @@ -821,7 +821,7 @@ val exists_pattern: (pattern -> bool) -> pattern -> bool

val let_bound_idents: value_binding list -> Ident.t list
val let_bound_idents_full:
value_binding list -> (Ident.t * Types.type_expr) list
value_binding list -> (Ident.t * string loc * Types.type_expr) list
val let_bound_idents_with_modes:
value_binding list
-> (Ident.t * (Location.t * Types.value_mode) list) list
Expand All @@ -835,7 +835,7 @@ val mkloc: 'a -> Location.t -> 'a Asttypes.loc

val pat_bound_idents: 'k general_pattern -> Ident.t list
val pat_bound_idents_full:
'k general_pattern -> (Ident.t * Types.type_expr) list
'k general_pattern -> (Ident.t * string loc * Types.type_expr) list

(** Splits an or pattern into its value (left) and exception (right) parts. *)
val split_pattern:
Expand Down

0 comments on commit 7751faa

Please sign in to comment.