Index: typing/typemod.ml =================================================================== --- typing/typemod.ml (revision 13947) +++ typing/typemod.ml (working copy) @@ -80,6 +80,9 @@ Typedtree.module_expr * Types.module_type) ref = ref (fun env m -> assert false) +let transl_modtype_fwd = + ref (fun env m -> (assert false : Typedtree.module_type)) + (* Merge one "with" constraint in a signature *) let rec add_rec_types env = function @@ -191,6 +194,21 @@ merge env (extract_sig env loc mty) namelist None in (path_concat id path, lid, tcstr), Sig_module(id, Mty_signature newsg, rs) :: rem + | (Sig_modtype(id, mtd) :: rem, [s], Pwith_modtype pmty) + when Ident.name id = s -> + let mty = !transl_modtype_fwd initial_env pmty in + let mtd' = Modtype_manifest mty.mty_type in + Includemod.modtype_declarations env id mtd' mtd; + (Pident id, lid, Twith_modtype (Tmodtype_manifest mty)), + Sig_modtype(id, mtd') :: rem + | (Sig_modtype(id, mtd) :: rem, [s], Pwith_modtypesubst pmty) + when Ident.name id = s -> + let mty = !transl_modtype_fwd initial_env pmty in + let mtd' = Modtype_manifest mty.mty_type in + Includemod.modtype_declarations env id mtd' mtd; + real_id := Some id; + (Pident id, lid, Twith_modtypesubst (Tmodtype_manifest mty)), + rem | (item :: rem, _, _) -> let (cstr, items) = merge (Env.add_item item env) rem namelist row_id in @@ -233,6 +251,12 @@ let (path, _) = Typetexp.find_module initial_env loc lid.txt in let sub = Subst.add_module id path Subst.identity in Subst.signature sub sg + | [s], Pwith_modtypesubst pmty -> + let id = + match !real_id with None -> assert false | Some id -> id in + let mty = !transl_modtype_fwd initial_env pmty in + let sub = Subst.add_modtype id mty.mty_type Subst.identity in + Subst.signature sub sg | _ -> sg in @@ -649,6 +673,8 @@ check_recmod_typedecls env2 sdecls dcl2; (dcl2, env2) +let () = transl_modtype_fwd := transl_modtype + (* Try to convert a module expression to a module path. *) exception Not_a_path Index: typing/typedtreeMap.ml =================================================================== --- typing/typedtreeMap.ml (revision 13947) +++ typing/typedtreeMap.ml (working copy) @@ -457,6 +457,9 @@ | Twith_typesubst decl -> Twith_typesubst (map_type_declaration decl) | Twith_module (path, lid) -> cstr | Twith_modsubst (path, lid) -> cstr + | Twith_modtype decl -> Twith_modtype (map_modtype_declaration decl) + | Twith_modtypesubst decl -> + Twith_modtypesubst (map_modtype_declaration decl) in Map.leave_with_constraint cstr Index: typing/typedtree.ml =================================================================== --- typing/typedtree.ml (revision 13947) +++ typing/typedtree.ml (working copy) @@ -255,6 +255,8 @@ | Twith_module of Path.t * Longident.t loc | Twith_typesubst of type_declaration | Twith_modsubst of Path.t * Longident.t loc + | Twith_modtype of modtype_declaration + | Twith_modtypesubst of modtype_declaration and core_type = (* mutable because of [Typeclass.declare_method] *) Index: typing/typedtree.mli =================================================================== --- typing/typedtree.mli (revision 13947) +++ typing/typedtree.mli (working copy) @@ -254,6 +254,8 @@ | Twith_module of Path.t * Longident.t loc | Twith_typesubst of type_declaration | Twith_modsubst of Path.t * Longident.t loc + | Twith_modtype of modtype_declaration + | Twith_modtypesubst of modtype_declaration and core_type = (* mutable because of [Typeclass.declare_method] *) Index: typing/includemod.ml =================================================================== --- typing/includemod.ml (revision 13947) +++ typing/includemod.ml (working copy) @@ -346,10 +346,10 @@ (* Hide the context and substitution parameters to the outside world *) -let modtypes env mty1 mty2 = modtypes env [] Subst.identity mty1 mty2 -let signatures env sig1 sig2 = signatures env [] Subst.identity sig1 sig2 -let type_declarations env id decl1 decl2 = - type_declarations env [] Subst.identity id decl1 decl2 +let modtypes env = modtypes env [] Subst.identity +let signatures env = signatures env [] Subst.identity +let type_declarations env = type_declarations env [] Subst.identity +let modtype_declarations env = modtype_infos env [] Subst.identity (* Error report *) Index: typing/typedtreeIter.ml =================================================================== --- typing/typedtreeIter.ml (revision 13947) +++ typing/typedtreeIter.ml (working copy) @@ -408,6 +408,8 @@ | Twith_module _ -> () | Twith_typesubst decl -> iter_type_declaration decl | Twith_modsubst _ -> () + | Twith_modtype decl -> iter_modtype_declaration decl + | Twith_modtypesubst decl -> iter_modtype_declaration decl end; Iter.leave_with_constraint cstr; Index: typing/includemod.mli =================================================================== --- typing/includemod.mli (revision 13947) +++ typing/includemod.mli (working copy) @@ -21,6 +21,8 @@ val compunit: string -> signature -> string -> signature -> module_coercion val type_declarations: Env.t -> Ident.t -> type_declaration -> type_declaration -> unit +val modtype_declarations: + Env.t -> Ident.t -> modtype_declaration -> modtype_declaration -> unit type symptom = Missing_field of Ident.t Index: typing/printtyped.ml =================================================================== --- typing/printtyped.ml (revision 13947) +++ typing/printtyped.ml (working copy) @@ -608,6 +608,12 @@ type_declaration (i+1) ppf td; | Twith_module (li,_) -> line i ppf "Pwith_module %a\n" fmt_path li; | Twith_modsubst (li,_) -> line i ppf "Pwith_modsubst %a\n" fmt_path li; + | Twith_modtype (td) -> + line i ppf "Pwith_modtype\n"; + modtype_declaration (i+1) ppf td; + | Twith_modtypesubst (td) -> + line i ppf "Pwith_modtypesubst\n"; + modtype_declaration (i+1) ppf td; and module_expr i ppf x = line i ppf "module_expr %a\n" fmt_location x.mod_loc; Index: experimental/garrigue/with-module-type.diffs =================================================================== --- experimental/garrigue/with-module-type.diffs (revision 13947) +++ experimental/garrigue/with-module-type.diffs (working copy) @@ -1,95 +1,53 @@ -Index: parsing/parser.mly -=================================================================== ---- parsing/parser.mly (revision 12005) -+++ parsing/parser.mly (working copy) -@@ -1504,6 +1504,10 @@ - { ($2, Pwith_module $4) } - | MODULE mod_longident COLONEQUAL mod_ext_longident - { ($2, Pwith_modsubst $4) } -+ | MODULE TYPE mod_longident EQUAL module_type -+ { ($3, Pwith_modtype $5) } -+ | MODULE TYPE mod_longident COLONEQUAL module_type -+ { ($3, Pwith_modtypesubst $5) } - ; - with_type_binder: - EQUAL { Public } -Index: parsing/parsetree.mli -=================================================================== ---- parsing/parsetree.mli (revision 12005) -+++ parsing/parsetree.mli (working copy) -@@ -239,6 +239,8 @@ - | Pwith_module of Longident.t - | Pwith_typesubst of type_declaration - | Pwith_modsubst of Longident.t -+ | Pwith_modtype of module_type -+ | Pwith_modtypesubst of module_type - - (* Value expressions for the module language *) - -Index: parsing/printast.ml -=================================================================== ---- parsing/printast.ml (revision 12005) -+++ parsing/printast.ml (working copy) -@@ -575,6 +575,12 @@ - type_declaration (i+1) ppf td; - | Pwith_module (li) -> line i ppf "Pwith_module %a\n" fmt_longident li; - | Pwith_modsubst (li) -> line i ppf "Pwith_modsubst %a\n" fmt_longident li; -+ | Pwith_modtype (mty) -> -+ line i ppf "Pwith_modtype\n"; -+ module_type (i+1) ppf mty; -+ | Pwith_modtypesubst (mty) -> -+ line i ppf "Pwith_modtype\n"; -+ module_type (i+1) ppf mty; - - and module_expr i ppf x = - line i ppf "module_expr %a\n" fmt_location x.pmod_loc; Index: typing/typemod.ml =================================================================== ---- typing/typemod.ml (revision 12005) +--- typing/typemod.ml (revision 13947) +++ typing/typemod.ml (working copy) -@@ -74,6 +74,8 @@ - : (Env.t -> Parsetree.module_expr -> module_type) ref +@@ -80,6 +80,9 @@ + Typedtree.module_expr * Types.module_type) ref = ref (fun env m -> assert false) -+let transl_modtype_fwd = ref (fun env m -> assert false) ++let transl_modtype_fwd = ++ ref (fun env m -> (assert false : Typedtree.module_type)) + (* Merge one "with" constraint in a signature *) let rec add_rec_types env = function -@@ -163,6 +165,19 @@ - ignore(Includemod.modtypes env newmty mty); - real_id := Some id; - make_next_first rs rem -+ | (Tsig_modtype(id, mtd) :: rem, [s], Pwith_modtype pmty) +@@ -191,6 +194,21 @@ + merge env (extract_sig env loc mty) namelist None in + (path_concat id path, lid, tcstr), + Sig_module(id, Mty_signature newsg, rs) :: rem ++ | (Sig_modtype(id, mtd) :: rem, [s], Pwith_modtype pmty) + when Ident.name id = s -> + let mty = !transl_modtype_fwd initial_env pmty in -+ let mtd' = Tmodtype_manifest mty in ++ let mtd' = Modtype_manifest mty.mty_type in + Includemod.modtype_declarations env id mtd' mtd; -+ Tsig_modtype(id, mtd') :: rem -+ | (Tsig_modtype(id, mtd) :: rem, [s], Pwith_modtypesubst pmty) ++ (Pident id, lid, Twith_modtype (Tmodtype_manifest mty)), ++ Sig_modtype(id, mtd') :: rem ++ | (Sig_modtype(id, mtd) :: rem, [s], Pwith_modtypesubst pmty) + when Ident.name id = s -> + let mty = !transl_modtype_fwd initial_env pmty in -+ let mtd' = Tmodtype_manifest mty in ++ let mtd' = Modtype_manifest mty.mty_type in + Includemod.modtype_declarations env id mtd' mtd; + real_id := Some id; ++ (Pident id, lid, Twith_modtypesubst (Tmodtype_manifest mty)), + rem - | (Tsig_module(id, mty, rs) :: rem, s :: namelist, _) - when Ident.name id = s -> - let newsg = merge env (extract_sig env loc mty) namelist None in -@@ -200,6 +215,12 @@ - let (path, _) = Typetexp.find_module initial_env loc lid in + | (item :: rem, _, _) -> + let (cstr, items) = merge (Env.add_item item env) rem namelist row_id + in +@@ -233,6 +251,12 @@ + let (path, _) = Typetexp.find_module initial_env loc lid.txt in let sub = Subst.add_module id path Subst.identity in Subst.signature sub sg + | [s], Pwith_modtypesubst pmty -> + let id = + match !real_id with None -> assert false | Some id -> id in + let mty = !transl_modtype_fwd initial_env pmty in -+ let sub = Subst.add_modtype id mty Subst.identity in ++ let sub = Subst.add_modtype id mty.mty_type Subst.identity in + Subst.signature sub sg | _ -> - sg - with Includemod.Error explanation -> -@@ -499,6 +520,8 @@ + sg + in +@@ -649,6 +673,8 @@ check_recmod_typedecls env2 sdecls dcl2; (dcl2, env2) @@ -98,11 +56,51 @@ (* Try to convert a module expression to a module path. *) exception Not_a_path +Index: typing/typedtreeMap.ml +=================================================================== +--- typing/typedtreeMap.ml (revision 13947) ++++ typing/typedtreeMap.ml (working copy) +@@ -457,6 +457,9 @@ + | Twith_typesubst decl -> Twith_typesubst (map_type_declaration decl) + | Twith_module (path, lid) -> cstr + | Twith_modsubst (path, lid) -> cstr ++ | Twith_modtype decl -> Twith_modtype (map_modtype_declaration decl) ++ | Twith_modtypesubst decl -> ++ Twith_modtypesubst (map_modtype_declaration decl) + in + Map.leave_with_constraint cstr + +Index: typing/typedtree.ml +=================================================================== +--- typing/typedtree.ml (revision 13947) ++++ typing/typedtree.ml (working copy) +@@ -255,6 +255,8 @@ + | Twith_module of Path.t * Longident.t loc + | Twith_typesubst of type_declaration + | Twith_modsubst of Path.t * Longident.t loc ++ | Twith_modtype of modtype_declaration ++ | Twith_modtypesubst of modtype_declaration + + and core_type = + (* mutable because of [Typeclass.declare_method] *) +Index: typing/typedtree.mli +=================================================================== +--- typing/typedtree.mli (revision 13947) ++++ typing/typedtree.mli (working copy) +@@ -254,6 +254,8 @@ + | Twith_module of Path.t * Longident.t loc + | Twith_typesubst of type_declaration + | Twith_modsubst of Path.t * Longident.t loc ++ | Twith_modtype of modtype_declaration ++ | Twith_modtypesubst of modtype_declaration + + and core_type = + (* mutable because of [Typeclass.declare_method] *) Index: typing/includemod.ml =================================================================== ---- typing/includemod.ml (revision 12005) +--- typing/includemod.ml (revision 13947) +++ typing/includemod.ml (working copy) -@@ -326,10 +326,10 @@ +@@ -346,10 +346,10 @@ (* Hide the context and substitution parameters to the outside world *) @@ -117,11 +115,24 @@ (* Error report *) +Index: typing/typedtreeIter.ml +=================================================================== +--- typing/typedtreeIter.ml (revision 13947) ++++ typing/typedtreeIter.ml (working copy) +@@ -408,6 +408,8 @@ + | Twith_module _ -> () + | Twith_typesubst decl -> iter_type_declaration decl + | Twith_modsubst _ -> () ++ | Twith_modtype decl -> iter_modtype_declaration decl ++ | Twith_modtypesubst decl -> iter_modtype_declaration decl + end; + Iter.leave_with_constraint cstr; + Index: typing/includemod.mli =================================================================== ---- typing/includemod.mli (revision 12005) +--- typing/includemod.mli (revision 13947) +++ typing/includemod.mli (working copy) -@@ -23,6 +23,8 @@ +@@ -21,6 +21,8 @@ val compunit: string -> signature -> string -> signature -> module_coercion val type_declarations: Env.t -> Ident.t -> type_declaration -> type_declaration -> unit @@ -130,53 +141,20 @@ type symptom = Missing_field of Ident.t -Index: testsuite/tests/typing-modules/Test.ml.reference +Index: typing/printtyped.ml =================================================================== ---- testsuite/tests/typing-modules/Test.ml.reference (revision 12005) -+++ testsuite/tests/typing-modules/Test.ml.reference (working copy) -@@ -6,4 +6,12 @@ - # type -'a t - class type c = object method m : [ `A ] t end - # module M : sig val v : (#c as 'a) -> 'a end -+# module type S = sig module type T module F : functor (X : T) -> T end -+# module type T0 = sig type t end -+# module type S1 = sig module type T = T0 module F : functor (X : T) -> T end -+# module type S2 = sig module F : functor (X : T0) -> T0 end -+# module type S3 = -+ sig -+ module F : functor (X : sig type t = int end) -> sig type t = int end -+ end - # -Index: testsuite/tests/typing-modules/Test.ml.principal.reference -=================================================================== ---- testsuite/tests/typing-modules/Test.ml.principal.reference (revision 12005) -+++ testsuite/tests/typing-modules/Test.ml.principal.reference (working copy) -@@ -6,4 +6,12 @@ - # type -'a t - class type c = object method m : [ `A ] t end - # module M : sig val v : (#c as 'a) -> 'a end -+# module type S = sig module type T module F : functor (X : T) -> T end -+# module type T0 = sig type t end -+# module type S1 = sig module type T = T0 module F : functor (X : T) -> T end -+# module type S2 = sig module F : functor (X : T0) -> T0 end -+# module type S3 = -+ sig -+ module F : functor (X : sig type t = int end) -> sig type t = int end -+ end - # -Index: testsuite/tests/typing-modules/Test.ml -=================================================================== ---- testsuite/tests/typing-modules/Test.ml (revision 12005) -+++ testsuite/tests/typing-modules/Test.ml (working copy) -@@ -9,3 +9,11 @@ - class type c = object method m : [ `A ] t end;; - module M : sig val v : (#c as 'a) -> 'a end = - struct let v x = ignore (x :> c); x end;; -+ -+(* with module type *) -+ -+module type S = sig module type T module F(X:T) : T end;; -+module type T0 = sig type t end;; -+module type S1 = S with module type T = T0;; -+module type S2 = S with module type T := T0;; -+module type S3 = S with module type T := sig type t = int end;; +--- typing/printtyped.ml (revision 13947) ++++ typing/printtyped.ml (working copy) +@@ -608,6 +608,12 @@ + type_declaration (i+1) ppf td; + | Twith_module (li,_) -> line i ppf "Pwith_module %a\n" fmt_path li; + | Twith_modsubst (li,_) -> line i ppf "Pwith_modsubst %a\n" fmt_path li; ++ | Twith_modtype (td) -> ++ line i ppf "Pwith_modtype\n"; ++ modtype_declaration (i+1) ppf td; ++ | Twith_modtypesubst (td) -> ++ line i ppf "Pwith_modtypesubst\n"; ++ modtype_declaration (i+1) ppf td; + + and module_expr i ppf x = + line i ppf "module_expr %a\n" fmt_location x.mod_loc; Index: parsing/pprintast.ml =================================================================== --- parsing/pprintast.ml (revision 13947) +++ parsing/pprintast.ml (working copy) @@ -847,18 +847,28 @@ (self#list self#type_var_option ~sep:"," ~first:"(" ~last:")") ls self#longident_loc li self#type_declaration td | Pwith_module (li2) -> - pp f "module %a =@ %a" self#longident_loc li self#longident_loc li2; + pp f "module %a =@ %a" + self#longident_loc li self#longident_loc li2 | Pwith_typesubst ({ptype_params=ls;_} as td) -> pp f "type@ %a %a :=@ %a" (self#list self#type_var_option ~sep:"," ~first:"(" ~last:")") ls self#longident_loc li self#type_declaration td | Pwith_modsubst (li2) -> - pp f "module %a :=@ %a" self#longident_loc li self#longident_loc li2 in + pp f "module %a :=@ %a" + self#longident_loc li self#longident_loc li2 + | Pwith_modtype mty -> + pp f "module type %a =@ %a" + self#longident_loc li self#module_type mty + | Pwith_modtypesubst mty -> + pp f "module type %a :=@ %a" + self#longident_loc li self#module_type mty + in (match l with | [] -> pp f "@[%a@]" self#module_type mt | _ -> pp f "@[(%a@ with@ %a)@]" - self#module_type mt (self#list longident_x_with_constraint ~sep:"@ and@ ") l ) + self#module_type mt + (self#list longident_x_with_constraint ~sep:"@ and@ ") l ) | Pmty_typeof me -> pp f "@[module@ type@ of@ %a@]" self#module_expr me Index: parsing/parser.mly =================================================================== --- parsing/parser.mly (revision 13947) +++ parsing/parser.mly (working copy) @@ -1506,6 +1506,10 @@ { (mkrhs $2 2, Pwith_module (mkrhs $4 4)) } | MODULE UIDENT COLONEQUAL mod_ext_longident { (mkrhs (Lident $2) 2, Pwith_modsubst (mkrhs $4 4)) } + | MODULE TYPE mty_longident EQUAL module_type + { (mkrhs $3 3, Pwith_modtype $5) } + | MODULE TYPE ident COLONEQUAL module_type + { (mkrhs (Lident $3) 3, Pwith_modtypesubst $5) } ; with_type_binder: EQUAL { Public } Index: parsing/ast_mapper.ml =================================================================== --- parsing/ast_mapper.ml (revision 13947) +++ parsing/ast_mapper.ml (working copy) @@ -164,6 +164,8 @@ | Pwith_module s -> Pwith_module (map_loc sub s) | Pwith_typesubst d -> Pwith_typesubst (sub # type_declaration d) | Pwith_modsubst s -> Pwith_modsubst (map_loc sub s) + | Pwith_modtype m -> Pwith_modtype (sub # module_type m) + | Pwith_modtypesubst m -> Pwith_modtypesubst (sub # module_type m) let mk_item ?(loc = Location.none) x = {psig_desc = x; psig_loc = loc} Index: parsing/parsetree.mli =================================================================== --- parsing/parsetree.mli (revision 13947) +++ parsing/parsetree.mli (working copy) @@ -256,6 +256,8 @@ | Pwith_module of Longident.t loc | Pwith_typesubst of type_declaration | Pwith_modsubst of Longident.t loc + | Pwith_modtype of module_type + | Pwith_modtypesubst of module_type (* Value expressions for the module language *) Index: parsing/printast.ml =================================================================== --- parsing/printast.ml (revision 13947) +++ parsing/printast.ml (working copy) @@ -590,6 +590,12 @@ type_declaration (i+1) ppf td; | Pwith_module li -> line i ppf "Pwith_module %a\n" fmt_longident_loc li; | Pwith_modsubst li -> line i ppf "Pwith_modsubst %a\n" fmt_longident_loc li; + | Pwith_modtype (mty) -> + line i ppf "Pwith_modtype\n"; + module_type (i+1) ppf mty; + | Pwith_modtypesubst (mty) -> + line i ppf "Pwith_modtype\n"; + module_type (i+1) ppf mty; and module_expr i ppf x = line i ppf "module_expr %a\n" fmt_location x.pmod_loc;