Module type substitutions: core

6 files changed, 46 insertions, 17 deletions

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 "@[<hov2>%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;