From c61984d62a92e179d5536bf57dbe422b8be7edc6 Mon Sep 17 00:00:00 2001 From: octachron Date: Wed, 6 Jan 2021 18:19:42 +0100 Subject: Module type substitutions: core --- parsing/ast_iterator.ml | 4 ++++ parsing/ast_mapper.ml | 4 ++++ parsing/depend.ml | 2 ++ parsing/parsetree.mli | 4 ++++ parsing/pprintast.ml | 41 ++++++++++++++++++++++++----------------- parsing/printast.ml | 8 ++++++++ 6 files changed, 46 insertions(+), 17 deletions(-) (limited to 'parsing') diff --git a/parsing/ast_iterator.ml b/parsing/ast_iterator.ml index 10d575123b..1cdb95310a 100644 --- a/parsing/ast_iterator.ml +++ b/parsing/ast_iterator.ml @@ -263,10 +263,14 @@ module MT = struct iter_loc sub lid; sub.type_declaration sub d | Pwith_module (lid, lid2) -> iter_loc sub lid; iter_loc sub lid2 + | Pwith_module_type (lid, mty) -> + iter_loc sub lid; iter_loc sub mty | Pwith_typesubst (lid, d) -> iter_loc sub lid; sub.type_declaration sub d | Pwith_modsubst (s, lid) -> iter_loc sub s; iter_loc sub lid + | Pwith_module_typesubst (lid, mty) -> + iter_loc sub lid; iter_loc sub mty let iter_signature_item sub {psig_desc = desc; psig_loc = loc} = sub.location sub loc; diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml index d9a77c952f..720c16af34 100644 --- a/parsing/ast_mapper.ml +++ b/parsing/ast_mapper.ml @@ -293,10 +293,14 @@ module MT = struct Pwith_type (map_loc sub lid, sub.type_declaration sub d) | Pwith_module (lid, lid2) -> Pwith_module (map_loc sub lid, map_loc sub lid2) + | Pwith_module_type (lid, mty) -> + Pwith_module_type (map_loc sub lid, map_loc sub mty) | Pwith_typesubst (lid, d) -> Pwith_typesubst (map_loc sub lid, sub.type_declaration sub d) | Pwith_modsubst (s, lid) -> Pwith_modsubst (map_loc sub s, map_loc sub lid) + | Pwith_module_typesubst (lid, mty) -> + Pwith_module_typesubst (map_loc sub lid, map_loc sub mty) let map_signature_item sub {psig_desc = desc; psig_loc = loc} = let open Sig in diff --git a/parsing/depend.ml b/parsing/depend.ml index d72bf63b35..f1a155c1ba 100644 --- a/parsing/depend.ml +++ b/parsing/depend.ml @@ -311,8 +311,10 @@ and add_modtype bv mty = (function | Pwith_type (_, td) -> add_type_declaration bv td | Pwith_module (_, lid) -> add_module_path bv lid + | Pwith_module_type (_, l) -> add bv l | Pwith_typesubst (_, td) -> add_type_declaration bv td | Pwith_modsubst (_, lid) -> add_module_path bv lid + | Pwith_module_typesubst (_, l) -> add bv l ) cstrl | Pmty_typeof m -> add_module_expr bv m diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli index 952920287a..8337c289b3 100644 --- a/parsing/parsetree.mli +++ b/parsing/parsetree.mli @@ -852,6 +852,10 @@ and with_constraint = the name of the type_declaration. *) | Pwith_module of Longident.t loc * Longident.t loc (* with module X.Y = Z *) + | Pwith_module_type of Longident.t loc * Longident.t loc + (* with module type X.Y = Z *) + | Pwith_module_typesubst of Longident.t loc * Longident.t loc + (* with module type X.Y := Z *) | Pwith_typesubst of Longident.t loc * type_declaration (* with type X.t := ..., same format as [Pwith_type] *) | Pwith_modsubst of Longident.t loc * Longident.t loc diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml index aefd74c32c..29351cc02a 100644 --- a/parsing/pprintast.ml +++ b/parsing/pprintast.ml @@ -1059,26 +1059,33 @@ and module_type ctxt f x = end | Pmty_with (mt, []) -> module_type ctxt f mt | Pmty_with (mt, l) -> - let with_constraint f = function - | Pwith_type (li, ({ptype_params= ls ;_} as td)) -> - let ls = List.map fst ls in - pp f "type@ %a %a =@ %a" - (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")") - ls longident_loc li (type_declaration ctxt) td - | Pwith_module (li, li2) -> - pp f "module %a =@ %a" longident_loc li longident_loc li2; - | Pwith_typesubst (li, ({ptype_params=ls;_} as td)) -> - let ls = List.map fst ls in - pp f "type@ %a %a :=@ %a" - (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")") - ls longident_loc li - (type_declaration ctxt) td - | Pwith_modsubst (li, li2) -> - pp f "module %a :=@ %a" longident_loc li longident_loc li2 in pp f "@[%a@ with@ %a@]" - (module_type1 ctxt) mt (list with_constraint ~sep:"@ and@ ") l + (module_type1 ctxt) mt + (list (with_constraint ctxt) ~sep:"@ and@ ") l | _ -> module_type1 ctxt f x +and with_constraint ctxt f = function + | Pwith_type (li, ({ptype_params= ls ;_} as td)) -> + let ls = List.map fst ls in + pp f "type@ %a %a =@ %a" + (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")") + ls longident_loc li (type_declaration ctxt) td + | Pwith_module (li, li2) -> + pp f "module %a =@ %a" longident_loc li longident_loc li2; + | Pwith_module_type (li, li2) -> + pp f "module type %a =@ %a" longident_loc li longident_loc li2 + | Pwith_typesubst (li, ({ptype_params=ls;_} as td)) -> + let ls = List.map fst ls in + pp f "type@ %a %a :=@ %a" + (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")") + ls longident_loc li + (type_declaration ctxt) td + | Pwith_modsubst (li, li2) -> + pp f "module %a :=@ %a" longident_loc li longident_loc li2 + | Pwith_module_typesubst (li, li2) -> + pp f "module type %a :=@ %a" longident_loc li longident_loc li2 + + and module_type1 ctxt f x = if x.pmty_attributes <> [] then module_type ctxt f x else match x.pmty_desc with diff --git a/parsing/printast.ml b/parsing/printast.ml index 031cd7b57c..c196256ecd 100644 --- a/parsing/printast.ml +++ b/parsing/printast.ml @@ -771,6 +771,14 @@ and with_constraint i ppf x = line i ppf "Pwith_modsubst %a = %a\n" fmt_longident_loc lid1 fmt_longident_loc lid2; + | Pwith_module_type (lid1, lid2) -> + line i ppf "Pwith_module_type %a = %a\n" + fmt_longident_loc lid1 + fmt_longident_loc lid2 + | Pwith_module_typesubst (lid1, lid2) -> + line i ppf "Pwith_module_typesubst %a = %a\n" + fmt_longident_loc lid1 + fmt_longident_loc lid2 and module_expr i ppf x = line i ppf "module_expr %a\n" fmt_location x.pmod_loc; -- cgit v1.2.1