diff --git a/typing/tast_iterator.ml b/typing/tast_iterator.ml index ab485e571ca..546963f9b6f 100644 --- a/typing/tast_iterator.ml +++ b/typing/tast_iterator.ml @@ -76,7 +76,16 @@ let module_declaration sub {md_type; _} = sub.module_type sub md_type let module_substitution _ _ = () -let include_infos f {incl_mod; _} = f incl_mod +let include_kind sub = function + | Tincl_structure -> () + | Tincl_functor ccs -> + List.iter (fun (_, cc) -> sub.module_coercion sub cc) ccs + | Tincl_gen_functor ccs -> + List.iter (fun (_, cc) -> sub.module_coercion sub cc) ccs + +let str_include_infos sub {incl_mod; incl_kind} = + sub.module_expr sub incl_mod; + include_kind sub incl_kind let class_type_declaration sub x = class_infos sub (sub.class_type sub) x @@ -100,7 +109,7 @@ let structure_item sub {str_desc; str_env; _} = List.iter (fun (cls,_) -> sub.class_declaration sub cls) list | Tstr_class_type list -> List.iter (fun (_, _, cltd) -> sub.class_type_declaration sub cltd) list - | Tstr_include incl -> include_infos (sub.module_expr sub) incl + | Tstr_include incl -> str_include_infos sub incl | Tstr_open od -> sub.open_declaration sub od | Tstr_attribute _ -> () @@ -286,6 +295,10 @@ let signature sub {sig_items; sig_final_env; _} = sub.env sub sig_final_env; List.iter (sub.signature_item sub) sig_items +let sig_include_infos sub {incl_mod; incl_kind} = + sub.module_type sub incl_mod; + include_kind sub incl_kind + let signature_item sub {sig_desc; sig_env; _} = sub.env sub sig_env; match sig_desc with @@ -298,7 +311,7 @@ let signature_item sub {sig_desc; sig_env; _} = | Tsig_modsubst x -> sub.module_substitution sub x | Tsig_recmodule list -> List.iter (sub.module_declaration sub) list | Tsig_modtype x -> sub.module_type_declaration sub x - | Tsig_include incl -> include_infos (sub.module_type sub) incl + | Tsig_include incl -> sig_include_infos sub incl | Tsig_class list -> List.iter (sub.class_description sub) list | Tsig_class_type list -> List.iter (sub.class_type_declaration sub) list | Tsig_open od -> sub.open_description sub od diff --git a/typing/tast_mapper.ml b/typing/tast_mapper.ml index c233cef788d..f4e12f09c3d 100644 --- a/typing/tast_mapper.ml +++ b/typing/tast_mapper.ml @@ -96,7 +96,18 @@ let module_declaration sub x = let module_substitution _ x = x -let include_infos f x = {x with incl_mod = f x.incl_mod} +let include_kind sub = function + | Tincl_structure -> Tincl_structure + | Tincl_functor ccs -> + Tincl_functor + (List.map (fun (nm, cc) -> (nm, sub.module_coercion sub cc)) ccs) + | Tincl_gen_functor ccs -> + Tincl_gen_functor + (List.map (fun (nm, cc) -> (nm, sub.module_coercion sub cc)) ccs) + +let str_include_infos sub x = + { x with incl_mod = sub.module_expr sub x.incl_mod; + incl_kind = include_kind sub x.incl_kind } let class_type_declaration sub x = class_infos sub (sub.class_type sub) x @@ -129,7 +140,7 @@ let structure_item sub {str_desc; str_loc; str_env} = Tstr_class_type (List.map (tuple3 id id (sub.class_type_declaration sub)) list) | Tstr_include incl -> - Tstr_include (include_infos (sub.module_expr sub) incl) + Tstr_include (str_include_infos sub incl) | Tstr_open od -> Tstr_open (sub.open_declaration sub od) | Tstr_attribute _ as d -> d in @@ -417,6 +428,10 @@ let signature sub x = let sig_items = List.map (sub.signature_item sub) x.sig_items in {x with sig_items; sig_final_env} +let sig_include_infos sub x = + { x with incl_mod = sub.module_type sub x.incl_mod; + incl_kind = include_kind sub x.incl_kind } + let signature_item sub x = let sig_env = sub.env sub x.sig_env in let sig_desc = @@ -442,7 +457,7 @@ let signature_item sub x = | Tsig_modtype x -> Tsig_modtype (sub.module_type_declaration sub x) | Tsig_include incl -> - Tsig_include (include_infos (sub.module_type sub) incl) + Tsig_include (sig_include_infos sub incl) | Tsig_class list -> Tsig_class (List.map (sub.class_description sub) list) | Tsig_class_type list ->