Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Record for module type declarations. 

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/extension_points@13358 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Alain Frisch 2013-03-06 12:14:02 +00:00
parent 24a0c6eb0e
commit 2cf65c8c85
14 changed files with 55 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
camlp4/Camlp4/Struct/Camlp4Ast2OCamlAst.ml
View File

@ -1008,10 +1008,10 @@ value varify_constructors var_names =
| SgMty loc n mt ->
let si =
match mt with
[ MtQuo _ _ -> Pmodtype_abstract
| _ -> Pmodtype_manifest (module_type mt) ]
[ MtQuo _ _ -> None
| _ -> Some (module_type mt) ]
in
[mksig loc (Psig_modtype (with_loc n loc) si []) :: l]
[mksig loc (Psig_modtype {pmtd_name=with_loc n loc; pmtd_type=si; pmtd_attributes=[]}) :: l]
| SgOpn loc id ->
[mksig loc (Psig_open (long_uident id) []) :: l]
| SgTyp loc tdl -> [mksig loc (Psig_type (mktype_decl tdl [])) :: l]

6
camlp4/boot/Camlp4.ml
View File

@ -15345,9 +15345,9 @@ module Struct =
| SgMty (loc, n, mt) ->
let si =
(match mt with
| MtQuo (_, _) -> Pmodtype_abstract
| _ -> Pmodtype_manifest (module_type mt))
in (mksig loc (Psig_modtype ((with_loc n loc), si, []))) :: l
| MtQuo (_, _) -> None
| _ -> Some (module_type mt))
in (mksig loc (Psig_modtype {pmtd_name=with_loc n loc; pmtd_type=si; pmtd_attributes=[]})) :: l
| SgOpn (loc, id) ->
(mksig loc (Psig_open (long_uident id, []))) :: l
| SgTyp (loc, tdl) ->

8
ocamldoc/odoc_sig.ml
View File

@ -280,7 +280,7 @@ module Analyser =
| [] -> acc
| types -> take_item (Parsetree.Psig_type types))
| Parsetree.Psig_module {Parsetree.pmd_name=name}
| Parsetree.Psig_modtype (name, _, _) as m ->
| Parsetree.Psig_modtype {Parsetree.pmtd_name=name} as m ->
if Name.Set.mem name.txt erased then acc else take_item m
| Parsetree.Psig_recmodule mods ->
(match List.filter (fun pmd -> not (Name.Set.mem pmd.Parsetree.pmd_name.txt erased)) mods with
@ -830,7 +830,7 @@ module Analyser =
let (maybe_more, mods) = f ~first: true 0 pos_start_ele decls in
(maybe_more, new_env, mods)
| Parsetree.Psig_modtype (name, pmodtype_decl, _) ->
| Parsetree.Psig_modtype {Parsetree.pmtd_name=name; pmtd_type=pmodtype_decl} ->
let complete_name = Name.concat current_module_name name.txt in
let sig_mtype =
try Signature_search.search_module_type table name.txt
@ -839,8 +839,8 @@ module Analyser =
in
let module_type_kind =
match pmodtype_decl with
Parsetree.Pmodtype_abstract -> None
| Parsetree.Pmodtype_manifest module_type ->
None -> None
| Some module_type ->
match sig_mtype with
| Some sig_mtype -> Some (analyse_module_type_kind env complete_name module_type sig_mtype)
| None -> None

2
otherlibs/labltk/browser/searchid.ml
View File

@ -522,7 +522,7 @@ let search_signature sign ~name ~kind ~prefix =
false
| Psig_exception ped when kind = Pconstructor -> name = ped.ped_name.txt
| Psig_module pmd when kind = Pmodule -> name = pmd.pmd_name.txt
| Psig_modtype (s, _, _) when kind = Pmodtype -> name = s.txt
| Psig_modtype pmtd when kind = Pmodtype -> name = pmtd.pmtd_name.txt
| Psig_class l when kind = Pclass || kind = Ptype || kind = Pcltype ->
List.iter l ~f:
begin fun c ->

2
otherlibs/labltk/browser/searchpos.ml
View File

@ -212,7 +212,7 @@ let rec search_pos_signature l ~pos ~env =
search_pos_module pmd.pmd_type ~pos ~env
| Psig_recmodule decls ->
List.iter decls ~f:(fun pmd -> search_pos_module pmd.pmd_type ~pos ~env)
| Psig_modtype (_, Pmodtype_manifest t, _attrs) ->
| Psig_modtype {pmtd_type=Some t} ->
search_pos_module t ~pos ~env
| Psig_modtype _ -> ()
| Psig_class l ->

11
parsing/ast_mapper.ml
View File

@ -209,7 +209,7 @@ module MT = struct
let exception_ ?loc a = mk_item ?loc (Psig_exception a)
let module_ ?loc a = mk_item ?loc (Psig_module a)
let rec_module ?loc a = mk_item ?loc (Psig_recmodule a)
let modtype ?loc ?(attributes = []) a b = mk_item ?loc (Psig_modtype (a, b, attributes))
let modtype ?loc a = mk_item ?loc (Psig_modtype a)
let open_ ?loc ?(attributes = []) a = mk_item ?loc (Psig_open (a, attributes))
let include_ ?loc ?(attributes = []) a = mk_item ?loc (Psig_include (a, attributes))
let class_ ?loc a = mk_item ?loc (Psig_class a)
@ -224,8 +224,7 @@ module MT = struct
| Psig_exception ed -> exception_ ~loc (sub # exception_declaration ed)
| Psig_module x -> module_ ~loc (sub # module_declaration x)
| Psig_recmodule l -> rec_module ~loc (List.map (sub # module_declaration) l)
| Psig_modtype (s, Pmodtype_manifest mt, attrs) -> modtype ~loc (map_loc sub s) (Pmodtype_manifest (sub # module_type mt)) ~attributes:(map_attributes sub attrs)
| Psig_modtype (s, Pmodtype_abstract, attrs) -> modtype ~loc (map_loc sub s) Pmodtype_abstract ~attributes:(map_attributes sub attrs)
| Psig_modtype x -> modtype ~loc (sub # module_type_declaration x)
| Psig_open (lid, attrs) -> open_ ~loc ~attributes:(map_attributes sub attrs) (map_loc sub lid)
| Psig_include (mt, attrs) -> include_ ~loc (sub # module_type mt) ~attributes:(map_attributes sub attrs)
| Psig_class l -> class_ ~loc (List.map (sub # class_description) l)
@ -550,6 +549,12 @@ class mapper =
pmd_type = this # module_type pmd.pmd_type;
pmd_attributes = map_attributes this pmd.pmd_attributes;
}
method module_type_declaration {pmtd_name; pmtd_type; pmtd_attributes} =
{
pmtd_name = map_loc this pmtd_name;
pmtd_type = map_opt (this # module_type) pmtd_type;
pmtd_attributes = map_attributes this pmtd_attributes;
}
method module_binding x =
{
pmb_name = map_loc this x.pmb_name;

3
parsing/ast_mapper.mli
View File

@ -38,6 +38,7 @@ class mapper:
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 module_type_declaration: module_type_declaration -> module_type_declaration
method pat: pattern -> pattern
method signature: signature -> signature
method signature_item: signature_item -> signature_item
@ -151,7 +152,7 @@ module MT:
val exception_: ?loc:Location.t -> exception_declaration -> signature_item
val module_: ?loc:Location.t -> module_declaration -> signature_item
val rec_module: ?loc:Location.t -> module_declaration list -> signature_item
val modtype: ?loc:Location.t -> ?attributes:Parsetree.attribute list -> string loc -> modtype_declaration -> signature_item
val modtype: ?loc:Location.t -> module_type_declaration -> signature_item
val open_: ?loc:Location.t -> ?attributes:Parsetree.attribute list -> Longident.t loc -> signature_item
val include_: ?loc:Location.t -> ?attributes:Parsetree.attribute list -> module_type -> signature_item
val class_: ?loc:Location.t -> class_description list -> signature_item

4
parsing/parser.mly
View File

@ -721,9 +721,9 @@ signature_item:
mksig(Psig_recmodule l)
}
| pre_item_attributes MODULE TYPE ident post_item_attributes
{ mksig(Psig_modtype(mkrhs $4 4, Pmodtype_abstract, $1 @ $5)) }
{ mksig(Psig_modtype {pmtd_name=mkrhs $4 4; pmtd_type=None; pmtd_attributes=$1 @ $5}) }
| pre_item_attributes MODULE TYPE ident EQUAL module_type post_item_attributes
{ mksig(Psig_modtype(mkrhs $4 4, Pmodtype_manifest $6, $1 @ $7)) }
{ mksig(Psig_modtype {pmtd_name=mkrhs $4 4; pmtd_type=Some $6; pmtd_attributes=$1 @ $7}) }
| pre_item_attributes OPEN mod_longident post_item_attributes
{ mksig(Psig_open (mkrhs $3 3, $1 @ $4)) }
| pre_item_attributes INCLUDE module_type post_item_attributes %prec below_WITH

11
parsing/parsetree.mli
View File

@ -274,7 +274,7 @@ and signature_item_desc =
| Psig_exception of exception_declaration
| Psig_module of module_declaration
| Psig_recmodule of module_declaration list
| Psig_modtype of string loc * modtype_declaration * attribute list
| Psig_modtype of module_type_declaration
| Psig_open of Longident.t loc * attribute list
| Psig_include of module_type * attribute list
| Psig_class of class_description list
@ -288,9 +288,12 @@ and module_declaration =
pmd_attributes: attribute list;
}
and modtype_declaration =
Pmodtype_abstract
| Pmodtype_manifest of module_type
and module_type_declaration =
{
pmtd_name: string loc;
pmtd_type: module_type option;
pmtd_attributes: attribute list;
}
and with_constraint =
Pwith_type of type_declaration

6
parsing/pprintast.ml
View File

@ -896,12 +896,12 @@ class printer ()= object(self:'self)
| Psig_include (mt, _attrs) ->
pp f "@[<hov2>include@ %a@]"
self#module_type mt
| Psig_modtype (s, md, _attrs) ->
| Psig_modtype {pmtd_name=s; pmtd_type=md} ->
pp f "@[<hov2>module@ type@ %s%a@]"
s.txt
(fun f md -> match md with
| Pmodtype_abstract -> ()
| Pmodtype_manifest (mt) ->
| None -> ()
| Some mt ->
pp_print_space f () ;
pp f "@ =@ %a" self#module_type mt
) md

14
parsing/printast.ml
View File

@ -598,10 +598,10 @@ and signature_item i ppf x =
| Psig_recmodule decls ->
line i ppf "Psig_recmodule\n";
list i module_declaration ppf decls;
| Psig_modtype (s, md, attrs) ->
line i ppf "Psig_modtype %a\n" fmt_string_loc s;
modtype_declaration i ppf md;
attributes i ppf attrs
| Psig_modtype x ->
line i ppf "Psig_modtype %a\n" fmt_string_loc x.pmtd_name;
modtype_declaration i ppf x.pmtd_type;
attributes i ppf x.pmtd_attributes
| Psig_open (li, attrs) ->
line i ppf "Psig_open %a\n" fmt_longident_loc li;
attributes i ppf attrs
@ -622,10 +622,8 @@ and signature_item i ppf x =
and modtype_declaration i ppf x =
match x with
| Pmodtype_abstract -> line i ppf "Pmodtype_abstract\n";
| Pmodtype_manifest (mt) ->
line i ppf "Pmodtype_manifest\n";
module_type (i+1) ppf mt;
| None -> line i ppf "#abstract\n";
| Some mt -> module_type (i+1) ppf mt;
and with_constraint i ppf x =
match x with

8
tools/depend.ml
View File

@ -229,10 +229,10 @@ and add_sig_item bv item =
let bv' = List.fold_right StringSet.add (List.map (fun pmd -> pmd.pmd_name.txt) decls) bv in
List.iter (fun pmd -> add_modtype bv' pmd.pmd_type) decls;
bv'
| Psig_modtype(id,mtyd, _attrs) ->
begin match mtyd with
Pmodtype_abstract -> ()
| Pmodtype_manifest mty -> add_modtype bv mty
| Psig_modtype x ->
begin match x.pmtd_type with
None -> ()
| Some mty -> add_modtype bv mty
end;
bv
| Psig_open (lid, _) ->

6
tools/untypeast.ml
View File

@ -335,7 +335,7 @@ and untype_signature_item item =
{pmd_name = name; pmd_type = untype_module_type mtype;
pmd_attributes = []}) list)
| Tsig_modtype (_id, name, mdecl) ->
Psig_modtype (name, untype_modtype_declaration mdecl, [])
Psig_modtype {pmtd_name=name; pmtd_type=untype_modtype_declaration mdecl; pmtd_attributes=[]}
| Tsig_open (_path, lid) -> Psig_open (lid, [])
| Tsig_include (mty, _lid) -> Psig_include (untype_module_type mty, [])
| Tsig_class list ->
@ -349,8 +349,8 @@ and untype_signature_item item =
and untype_modtype_declaration mdecl =
match mdecl with
Tmodtype_abstract -> Pmodtype_abstract
| Tmodtype_manifest mtype -> Pmodtype_manifest (untype_module_type mtype)
Tmodtype_abstract -> None
| Tmodtype_manifest mtype -> Some (untype_module_type mtype)
and untype_class_description cd =
{

16
typing/typemod.ml
View File

@ -312,9 +312,9 @@ and approx_sig env ssg =
env decls in
map_rec (fun rs (id, mty) -> Sig_module(id, mty, rs)) decls
(approx_sig newenv srem)
| Psig_modtype(name, sinfo, _attrs) ->
let info = approx_modtype_info env sinfo in
let (id, newenv) = Env.enter_modtype name.txt info env in
| Psig_modtype d ->
let info = approx_modtype_info env d.pmtd_type in
let (id, newenv) = Env.enter_modtype d.pmtd_name.txt info env in
Sig_modtype(id, info) :: approx_sig newenv srem
| Psig_open (lid, _attrs) ->
let (path, mty) = type_open env item.psig_loc lid in
@ -340,9 +340,9 @@ and approx_sig env ssg =
and approx_modtype_info env sinfo =
match sinfo with
Pmodtype_abstract ->
None ->
Modtype_abstract
| Pmodtype_manifest smty ->
| Some smty ->
Modtype_manifest(approx_modtype env smty)
(* Additional validity checks on type definitions arising from
@ -510,7 +510,7 @@ and transl_signature env sg =
map_rec (fun rs (id, _, tmty) -> Sig_module(id, tmty.mty_type, rs))
decls rem,
final_env
| Psig_modtype(name, sinfo, _attrs) ->
| Psig_modtype {pmtd_name=name; pmtd_type=sinfo} ->
check "module type" item.psig_loc modtype_names name.txt;
let (tinfo, info) = transl_modtype_info env sinfo in
let (id, newenv) = Env.enter_modtype name.txt info env in
@ -589,9 +589,9 @@ and transl_signature env sg =
and transl_modtype_info env sinfo =
match sinfo with
Pmodtype_abstract ->
None ->
Tmodtype_abstract, Modtype_abstract
| Pmodtype_manifest smty ->
| Some smty ->
let tmty = transl_modtype env smty in
Tmodtype_manifest tmty, Modtype_manifest tmty.mty_type