From 59bdf321d32e839f73da09462f120785a0595bfe Mon Sep 17 00:00:00 2001 From: Alain Frisch Date: Wed, 6 Mar 2013 10:49:44 +0000 Subject: [PATCH] Switch Pstr_modtype argument to a record type. git-svn-id: http://caml.inria.fr/svn/ocaml/branches/extension_points@13355 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02 --- camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml | 4 +++- camlp4/boot/Camlp4.ml | 4 +++- ocamldoc/odoc_ast.ml | 2 +- otherlibs/labltk/browser/searchid.ml | 2 +- parsing/ast_mapper.ml | 10 ++++++++-- parsing/ast_mapper.mli | 3 ++- parsing/parser.mly | 2 +- parsing/parsetree.mli | 9 ++++++++- parsing/pprintast.ml | 4 ++-- parsing/printast.ml | 7 ++++--- tools/depend.ml | 4 ++-- tools/untypeast.ml | 3 ++- typing/typemod.ml | 2 +- 13 files changed, 38 insertions(+), 18 deletions(-) diff --git a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml index b7d8befe7..533dcf0fa 100644 --- a/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml +++ b/camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml @@ -1080,7 +1080,9 @@ value varify_constructors var_names = | StMod loc n me -> [mkstr loc (Pstr_module {pmb_name=with_loc n loc;pmb_expr=module_expr me;pmb_attributes=[]}) :: l] | StRecMod loc mb -> [mkstr loc (Pstr_recmodule (module_str_binding mb [])) :: l] - | StMty loc n mt -> [mkstr loc (Pstr_modtype (with_loc n loc) (module_type mt)) :: l] + | StMty loc n mt -> [mkstr loc (Pstr_modtype {pmtb_name=with_loc n loc; + pmtb_type=module_type mt; + pmtb_attributes=[]}) :: l] | StOpn loc id -> [mkstr loc (Pstr_open (long_uident id, [])) :: l] | StTyp loc tdl -> [mkstr loc (Pstr_type (mktype_decl tdl [])) :: l] diff --git a/camlp4/boot/Camlp4.ml b/camlp4/boot/Camlp4.ml index 87e802fb5..82b5c8891 100644 --- a/camlp4/boot/Camlp4.ml +++ b/camlp4/boot/Camlp4.ml @@ -15461,7 +15461,9 @@ module Struct = l | StMty (loc, n, mt) -> (mkstr loc - (Pstr_modtype ((with_loc n loc), (module_type mt)))) :: + (Pstr_modtype {pmtb_name=with_loc n loc; + pmtb_type=module_type mt; + pmtb_attributes=[]})) :: l | StOpn (loc, id) -> (mkstr loc (Pstr_open (long_uident id, []))) :: l diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml index b929460fe..6a4e4a4f4 100644 --- a/ocamldoc/odoc_ast.ml +++ b/ocamldoc/odoc_ast.ml @@ -1390,7 +1390,7 @@ module Analyser = let eles = f ~first: true loc.Location.loc_start.Lexing.pos_cnum mods in (0, new_env, eles) - | Parsetree.Pstr_modtype (name, modtype) -> + | Parsetree.Pstr_modtype {Parsetree.pmtb_name=name; pmtb_type=modtype} -> let complete_name = Name.concat current_module_name name.txt in let tt_module_type = try Typedtree_search.search_module_type table name.txt diff --git a/otherlibs/labltk/browser/searchid.ml b/otherlibs/labltk/browser/searchid.ml index f17ede690..e35f736aa 100644 --- a/otherlibs/labltk/browser/searchid.ml +++ b/otherlibs/labltk/browser/searchid.ml @@ -469,7 +469,7 @@ let search_structure str ~name ~kind ~prefix = false | Pstr_exception ped when kind = Pconstructor -> name = ped.ped_name.txt | Pstr_module x when kind = Pmodule -> name = x.pmb_name.txt - | Pstr_modtype (s, _) when kind = Pmodtype -> name = s.txt + | Pstr_modtype x when kind = Pmodtype -> name = x.pmtb_name.txt | Pstr_class l when kind = Pclass || kind = Ptype || kind = Pcltype -> List.iter l ~f: begin fun c -> diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml index 97044345f..f23501dd0 100644 --- a/parsing/ast_mapper.ml +++ b/parsing/ast_mapper.ml @@ -258,7 +258,7 @@ module M = struct let exn_rebind ?loc ?(attributes = []) a b = mk_item ?loc (Pstr_exn_rebind (a, b, attributes)) let module_ ?loc a = mk_item ?loc (Pstr_module a) let rec_module ?loc a = mk_item ?loc (Pstr_recmodule a) - let modtype ?loc a b = mk_item ?loc (Pstr_modtype (a, b)) + let modtype ?loc a = mk_item ?loc (Pstr_modtype a) let open_ ?loc ?(attributes = []) a = mk_item ?loc (Pstr_open (a, attributes)) let class_ ?loc a = mk_item ?loc (Pstr_class a) let class_type ?loc a = mk_item ?loc (Pstr_class_type a) @@ -276,7 +276,7 @@ module M = struct | Pstr_exn_rebind (s, lid, attrs) -> exn_rebind ~loc (map_loc sub s) (map_loc sub lid) ~attributes:(map_attributes sub attrs) | Pstr_module x -> module_ ~loc (sub # module_binding x) | Pstr_recmodule l -> rec_module ~loc (List.map (sub # module_binding) l) - | Pstr_modtype (s, mty) -> modtype ~loc (map_loc sub s) (sub # module_type mty) + | Pstr_modtype x -> modtype ~loc (sub # module_type_binding x) | Pstr_open (lid, attrs) -> open_ ~loc ~attributes:(map_attributes sub attrs) (map_loc sub lid) | Pstr_class l -> class_ ~loc (List.map (sub # class_declaration) l) | Pstr_class_type l -> class_type ~loc (List.map (sub # class_type_declaration) l) @@ -545,6 +545,12 @@ class mapper = pmb_expr = this # module_expr x.pmb_expr; pmb_attributes = map_attributes this x.pmb_attributes; } + method module_type_binding x = + { + pmtb_name = map_loc this x.pmtb_name; + pmtb_type = this # module_type x.pmtb_type; + pmtb_attributes = map_attributes this x.pmtb_attributes; + } method location l = l diff --git a/parsing/ast_mapper.mli b/parsing/ast_mapper.mli index 7bed0e362..d7f519281 100644 --- a/parsing/ast_mapper.mli +++ b/parsing/ast_mapper.mli @@ -37,6 +37,7 @@ class mapper: method module_declaration: module_declaration -> module_declaration method module_expr: module_expr -> module_expr method module_type: module_type -> module_type + method module_type_binding: module_type_binding -> module_type_binding method pat: pattern -> pattern method signature: signature -> signature method signature_item: signature_item -> signature_item @@ -177,7 +178,7 @@ module M: val exn_rebind: ?loc:Location.t -> ?attributes:attribute list -> string loc -> Longident.t loc -> structure_item val module_: ?loc:Location.t -> module_binding -> structure_item val rec_module: ?loc:Location.t -> module_binding list -> structure_item - val modtype: ?loc:Location.t -> string loc -> module_type -> structure_item + val modtype: ?loc:Location.t -> module_type_binding -> structure_item val open_: ?loc:Location.t -> ?attributes:attribute list -> Longident.t loc -> structure_item val class_: ?loc:Location.t -> class_declaration list -> structure_item val class_type: ?loc:Location.t -> class_type_declaration list -> structure_item diff --git a/parsing/parser.mly b/parsing/parser.mly index 34fd65355..6d3fc7f02 100644 --- a/parsing/parser.mly +++ b/parsing/parser.mly @@ -628,7 +628,7 @@ structure_item: | pre_item_attributes MODULE REC module_rec_bindings { mkstr(Pstr_recmodule(List.rev $4)) (* keep attrs *) } | pre_item_attributes MODULE TYPE ident EQUAL module_type post_item_attributes - { mkstr(Pstr_modtype(mkrhs $4 4, $6)) (* keep attrs *) } + { mkstr(Pstr_modtype{pmtb_name=mkrhs $4 4; pmtb_type=$6; pmtb_attributes=$1 @ $7}) } | pre_item_attributes OPEN mod_longident post_item_attributes { mkstr(Pstr_open (mkrhs $3 3, $1 @ $4)) } | pre_item_attributes CLASS class_declarations diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli index 1eb14fa47..0c915bcb7 100644 --- a/parsing/parsetree.mli +++ b/parsing/parsetree.mli @@ -327,7 +327,7 @@ and structure_item_desc = | Pstr_exn_rebind of string loc * Longident.t loc * attribute list | Pstr_module of module_binding | Pstr_recmodule of module_binding list - | Pstr_modtype of string loc * module_type + | Pstr_modtype of module_type_binding | Pstr_open of Longident.t loc * attribute list | Pstr_class of class_declaration list | Pstr_class_type of class_type_declaration list @@ -341,6 +341,13 @@ and module_binding = pmb_attributes: attribute list; } +and module_type_binding = + { + pmtb_name: string loc; + pmtb_type: module_type; + pmtb_attributes: attribute list; + } + (* Toplevel phrases *) type toplevel_phrase = diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml index e7aa4ac1c..77f317157 100644 --- a/parsing/pprintast.ml +++ b/parsing/pprintast.ml @@ -1031,8 +1031,8 @@ class printer ()= object(self:'self) )) x.pmb_expr | Pstr_open (li, _attrs) -> pp f "@[<2>open@;%a@]" self#longident_loc li; - | Pstr_modtype (s, mt) -> - pp f "@[<2>module type %s =@;%a@]" s.txt self#module_type mt + | Pstr_modtype x -> + pp f "@[<2>module type %s =@;%a@]" x.pmtb_name.txt self#module_type x.pmtb_type | Pstr_class l -> let class_declaration f (* for the second will be changed to and FIXME*) ({pci_params=(ls,_); diff --git a/parsing/printast.ml b/parsing/printast.ml index 4b907b973..062f28b59 100644 --- a/parsing/printast.ml +++ b/parsing/printast.ml @@ -700,9 +700,10 @@ and structure_item i ppf x = | Pstr_recmodule bindings -> line i ppf "Pstr_recmodule\n"; list i module_binding ppf bindings; - | Pstr_modtype (s, mt) -> - line i ppf "Pstr_modtype %a\n" fmt_string_loc s; - module_type i ppf mt; + | Pstr_modtype x -> + line i ppf "Pstr_modtype %a\n" fmt_string_loc x.pmtb_name; + module_type i ppf x.pmtb_type; + attributes i ppf x.pmtb_attributes | Pstr_open (li, attrs) -> line i ppf "Pstr_open %a\n" fmt_longident_loc li; attributes i ppf attrs diff --git a/tools/depend.ml b/tools/depend.ml index 7f09066d9..6355e34e5 100644 --- a/tools/depend.ml +++ b/tools/depend.ml @@ -291,8 +291,8 @@ and add_struct_item bv item = (fun x -> add_module bv' x.pmb_expr) bindings; bv' - | Pstr_modtype(id, mty) -> - add_modtype bv mty; bv + | Pstr_modtype x -> + add_modtype bv x.pmtb_type; bv | Pstr_open (l, _attrs) -> addmodule bv l; bv | Pstr_class cdl -> diff --git a/tools/untypeast.ml b/tools/untypeast.ml index 799edf85d..1fef79b9c 100644 --- a/tools/untypeast.ml +++ b/tools/untypeast.ml @@ -70,7 +70,8 @@ and untype_structure_item item = pmb_attributes = []}) list) | Tstr_modtype (_id, name, mtype) -> - Pstr_modtype (name, untype_module_type mtype) + Pstr_modtype {pmtb_name=name; pmtb_type=untype_module_type mtype; + pmtb_attributes=[]} | Tstr_open (_path, lid) -> Pstr_open (lid, []) | Tstr_class list -> Pstr_class (List.map (fun (ci, _, _) -> diff --git a/typing/typemod.ml b/typing/typemod.ml index 1bc86f76c..34b19f329 100644 --- a/typing/typemod.ml +++ b/typing/typemod.ml @@ -1059,7 +1059,7 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope = map_rec (fun rs (id, _, _, modl) -> Sig_module(id, modl.mod_type, rs)) bindings2 sig_rem, final_env) - | Pstr_modtype(name, smty) -> + | Pstr_modtype{pmtb_name=name; pmtb_type=smty} -> check "module type" loc modtype_names name.txt; let mty = transl_modtype env smty in let (id, newenv) =