diff options
Diffstat (limited to 'typing/untypeast.ml')
| -rw-r--r-- | typing/untypeast.ml | 24 |
1 files changed, 15 insertions, 9 deletions
diff --git a/typing/untypeast.ml b/typing/untypeast.ml index 34f465e536..e7222ad424 100644 --- a/typing/untypeast.ml +++ b/typing/untypeast.ml @@ -296,8 +296,10 @@ let pattern sub pat = let attrs = sub.attributes sub pat.pat_attributes in let desc = match pat with - { pat_extra=[Tpat_unpack, _, _attrs]; pat_desc = Tpat_var (_,name); _ } -> - Ppat_unpack name + { pat_extra=[Tpat_unpack, loc, _attrs]; pat_desc = Tpat_any; _ } -> + Ppat_unpack { txt = None; loc } + | { pat_extra=[Tpat_unpack, _, _attrs]; pat_desc = Tpat_var (_,name); _ } -> + Ppat_unpack { name with txt = Some name.txt } | { pat_extra=[Tpat_type (_path, lid), _, _attrs]; _ } -> Ppat_type (map_loc sub lid) | { pat_extra= (Tpat_constraint ct, _, _attrs) :: rem; _ } -> @@ -310,7 +312,7 @@ let pattern sub pat = begin match (Ident.name id).[0] with 'A'..'Z' -> - Ppat_unpack name + Ppat_unpack { name with txt = Some name.txt} | _ -> Ppat_var name end @@ -599,6 +601,11 @@ let class_declaration sub = class_infos sub.class_expr sub let class_description sub = class_infos sub.class_type sub let class_type_declaration sub = class_infos sub.class_type sub +let functor_parameter sub : functor_parameter -> Parsetree.functor_parameter = + function + | Unit -> Unit + | Named (_, name, mtype) -> Named (name, sub.module_type sub mtype) + let module_type sub mty = let loc = sub.location sub mty.mty_loc in let attrs = sub.attributes sub mty.mty_attributes in @@ -606,9 +613,8 @@ let module_type sub mty = Tmty_ident (_path, lid) -> Pmty_ident (map_loc sub lid) | Tmty_alias (_path, lid) -> Pmty_alias (map_loc sub lid) | Tmty_signature sg -> Pmty_signature (sub.signature sub sg) - | Tmty_functor (_id, name, mtype1, mtype2) -> - Pmty_functor (name, Option.map (sub.module_type sub) mtype1, - sub.module_type sub mtype2) + | Tmty_functor (arg, mtype2) -> + Pmty_functor (functor_parameter sub arg, sub.module_type sub mtype2) | Tmty_with (mtype, list) -> Pmty_with (sub.module_type sub mtype, List.map (sub.with_constraint sub) list) @@ -638,9 +644,9 @@ let module_expr sub mexpr = let desc = match mexpr.mod_desc with Tmod_ident (_p, lid) -> Pmod_ident (map_loc sub lid) | Tmod_structure st -> Pmod_structure (sub.structure sub st) - | Tmod_functor (_id, name, mtype, mexpr) -> - Pmod_functor (name, Option.map (sub.module_type sub) mtype, - sub.module_expr sub mexpr) + | Tmod_functor (arg, mexpr) -> + Pmod_functor + (functor_parameter sub arg, sub.module_expr sub mexpr) | Tmod_apply (mexp1, mexp2, _) -> Pmod_apply (sub.module_expr sub mexp1, sub.module_expr sub mexp2) | Tmod_constraint (mexpr, _, Tmodtype_explicit mtype, _) -> |