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-0dff7051ff02master
parent
a79811afe9
commit
59bdf321d3
|
@ -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]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ->
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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,_);
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ->
|
||||
|
|
|
@ -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, _, _) ->
|
||||
|
|
|
@ -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) =
|
||||
|
|
Loading…
Reference in New Issue