Merge pull request #8959 from gasche/refactor-pat-bound-idents
clarify the implementation of Typedtree.pat_bound_idents_fullmaster
commit
b1848d3a27
7
Changes
7
Changes
|
@ -70,8 +70,11 @@ Working version
|
||||||
- #8928: Move contains_calls and num_stack_slots from Proc to Mach.fundecl
|
- #8928: Move contains_calls and num_stack_slots from Proc to Mach.fundecl
|
||||||
(Greta Yorsh, review by Florian Angeletti and Vincent Laviron)
|
(Greta Yorsh, review by Florian Angeletti and Vincent Laviron)
|
||||||
|
|
||||||
- #8968: refactor the generic pattern-traversal functions
|
- #8959, #8960, #8968: minor refactorings in the typing of patterns:
|
||||||
in Typecore and Typedtree.
|
+ refactor the {let,pat}_bound_idents* functions
|
||||||
|
+ minor bugfix in type_pat
|
||||||
|
+ refactor the generic pattern-traversal functions
|
||||||
|
in Typecore and Typedtree
|
||||||
(Gabriel Scherer, review by Thomas Refis)
|
(Gabriel Scherer, review by Thomas Refis)
|
||||||
|
|
||||||
### Code generation and optimizations:
|
### Code generation and optimizations:
|
||||||
|
|
|
@ -547,8 +547,9 @@ and transl_structure loc fields cc rootpath final_env = function
|
||||||
Lsequence(transl_exp expr, body), size
|
Lsequence(transl_exp expr, body), size
|
||||||
| Tstr_value(rec_flag, pat_expr_list) ->
|
| Tstr_value(rec_flag, pat_expr_list) ->
|
||||||
(* Translate bindings first *)
|
(* Translate bindings first *)
|
||||||
let mk_lam_let = transl_let rec_flag pat_expr_list in
|
let mk_lam_let = transl_let rec_flag pat_expr_list in
|
||||||
let ext_fields = rev_let_bound_idents pat_expr_list @ fields in
|
let ext_fields =
|
||||||
|
List.rev_append (let_bound_idents pat_expr_list) fields in
|
||||||
(* Then, translate remainder of struct *)
|
(* Then, translate remainder of struct *)
|
||||||
let body, size =
|
let body, size =
|
||||||
transl_structure loc ext_fields cc rootpath final_env rem
|
transl_structure loc ext_fields cc rootpath final_env rem
|
||||||
|
|
|
@ -1200,7 +1200,7 @@ and class_expr_aux cl_num val_env met_env scl =
|
||||||
((id', expr)
|
((id', expr)
|
||||||
:: vals,
|
:: vals,
|
||||||
Env.add_value id' desc met_env))
|
Env.add_value id' desc met_env))
|
||||||
(let_bound_idents_with_loc defs)
|
(let_bound_idents_full defs)
|
||||||
([], met_env)
|
([], met_env)
|
||||||
in
|
in
|
||||||
let cl = class_expr cl_num val_env met_env scl' in
|
let cl = class_expr cl_num val_env met_env scl' in
|
||||||
|
|
|
@ -638,41 +638,43 @@ let exists_pattern f p =
|
||||||
|
|
||||||
(* List the identifiers bound by a pattern or a let *)
|
(* List the identifiers bound by a pattern or a let *)
|
||||||
|
|
||||||
let idents = ref([]: (Ident.t * string loc * Types.type_expr) list)
|
let rec iter_bound_idents f pat =
|
||||||
|
|
||||||
let rec bound_idents pat =
|
|
||||||
match pat.pat_desc with
|
match pat.pat_desc with
|
||||||
| Tpat_var (id,s) -> idents := (id,s,pat.pat_type) :: !idents
|
| Tpat_var (id,s) ->
|
||||||
|
f (id,s,pat.pat_type)
|
||||||
| Tpat_alias(p, id, s) ->
|
| Tpat_alias(p, id, s) ->
|
||||||
bound_idents p; idents := (id,s,pat.pat_type) :: !idents
|
iter_bound_idents f p;
|
||||||
|
f (id,s,pat.pat_type)
|
||||||
| Tpat_or(p1, _, _) ->
|
| Tpat_or(p1, _, _) ->
|
||||||
(* Invariant : both arguments binds the same variables *)
|
(* Invariant : both arguments bind the same variables *)
|
||||||
bound_idents p1
|
iter_bound_idents f p1
|
||||||
| d -> shallow_iter_pattern_desc bound_idents d
|
| d ->
|
||||||
|
shallow_iter_pattern_desc (iter_bound_idents f) d
|
||||||
|
|
||||||
|
let rev_pat_bound_idents_full pat =
|
||||||
|
let idents_full = ref [] in
|
||||||
|
let add id_full = idents_full := id_full :: !idents_full in
|
||||||
|
iter_bound_idents add pat;
|
||||||
|
!idents_full
|
||||||
|
|
||||||
|
let rev_only_idents idents_full =
|
||||||
|
List.rev_map (fun (id,_,_) -> id) idents_full
|
||||||
|
|
||||||
let pat_bound_idents_full pat =
|
let pat_bound_idents_full pat =
|
||||||
idents := [];
|
List.rev (rev_pat_bound_idents_full pat)
|
||||||
bound_idents pat;
|
|
||||||
let res = !idents in
|
|
||||||
idents := [];
|
|
||||||
res
|
|
||||||
|
|
||||||
let pat_bound_idents pat =
|
let pat_bound_idents pat =
|
||||||
List.map (fun (id,_,_) -> id) (pat_bound_idents_full pat)
|
rev_only_idents (rev_pat_bound_idents_full pat)
|
||||||
|
|
||||||
let rev_let_bound_idents_with_loc bindings =
|
let rev_let_bound_idents_full bindings =
|
||||||
idents := [];
|
let idents_full = ref [] in
|
||||||
List.iter (fun vb -> bound_idents vb.vb_pat) bindings;
|
let add id_full = idents_full := id_full :: !idents_full in
|
||||||
let res = !idents in idents := []; res
|
List.iter (fun vb -> iter_bound_idents add vb.vb_pat) bindings;
|
||||||
|
!idents_full
|
||||||
let let_bound_idents_with_loc pat_expr_list =
|
|
||||||
List.rev(rev_let_bound_idents_with_loc pat_expr_list)
|
|
||||||
|
|
||||||
let rev_let_bound_idents pat =
|
|
||||||
List.map (fun (id,_,_) -> id) (rev_let_bound_idents_with_loc pat)
|
|
||||||
|
|
||||||
|
let let_bound_idents_full bindings =
|
||||||
|
List.rev (rev_let_bound_idents_full bindings)
|
||||||
let let_bound_idents pat =
|
let let_bound_idents pat =
|
||||||
List.map (fun (id,_,_) -> id) (let_bound_idents_with_loc pat)
|
rev_only_idents (rev_let_bound_idents_full pat)
|
||||||
|
|
||||||
let alpha_var env id = List.assoc id env
|
let alpha_var env id = List.assoc id env
|
||||||
|
|
||||||
|
|
|
@ -722,9 +722,7 @@ val iter_pattern: (pattern -> unit) -> pattern -> unit
|
||||||
val exists_pattern: (pattern -> bool) -> pattern -> bool
|
val exists_pattern: (pattern -> bool) -> pattern -> bool
|
||||||
|
|
||||||
val let_bound_idents: value_binding list -> Ident.t list
|
val let_bound_idents: value_binding list -> Ident.t list
|
||||||
val rev_let_bound_idents: value_binding list -> Ident.t list
|
val let_bound_idents_full:
|
||||||
|
|
||||||
val let_bound_idents_with_loc:
|
|
||||||
value_binding list -> (Ident.t * string loc * type_expr) list
|
value_binding list -> (Ident.t * string loc * type_expr) list
|
||||||
|
|
||||||
(** Alpha conversion of patterns *)
|
(** Alpha conversion of patterns *)
|
||||||
|
|
|
@ -2029,7 +2029,7 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
|
||||||
List.map (fun (id, { Asttypes.loc; _ }, _typ)->
|
List.map (fun (id, { Asttypes.loc; _ }, _typ)->
|
||||||
Signature_names.check_value names loc id;
|
Signature_names.check_value names loc id;
|
||||||
Sig_value(id, Env.find_value (Pident id) newenv, Exported)
|
Sig_value(id, Env.find_value (Pident id) newenv, Exported)
|
||||||
) (let_bound_idents_with_loc defs),
|
) (let_bound_idents_full defs),
|
||||||
newenv
|
newenv
|
||||||
| Pstr_primitive sdesc ->
|
| Pstr_primitive sdesc ->
|
||||||
let (desc, newenv) = Typedecl.transl_value_decl env loc sdesc in
|
let (desc, newenv) = Typedecl.transl_value_decl env loc sdesc in
|
||||||
|
|
Loading…
Reference in New Issue