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
master
Alain Frisch 2013-03-06 10:49:44 +00:00
parent a79811afe9
commit 59bdf321d3
13 changed files with 38 additions and 18 deletions

View File

@ -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]

View File

@ -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

View File

@ -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

View File

@ -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 ->

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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 =

View File

@ -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,_);

View File

@ -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

View File

@ -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 ->

View File

@ -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, _, _) ->

View File

@ -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) =