diff -Naur ocaml-3.09.2/ocamldoc/odoc_analyse.ml ocaml-3.09.2-sigops/ocamldoc/odoc_analyse.ml --- ocaml-3.09.2/ocamldoc/odoc_analyse.ml 2006-02-09 16:14:05.000000000 +0200 +++ ocaml-3.09.2-sigops/ocamldoc/odoc_analyse.ml 2006-07-06 21:41:33.000000000 +0300 @@ -413,6 +413,10 @@ remove_module_elements_between_stop_in_module_kind k2) | Odoc_module.Module_with (mtkind, s) -> Odoc_module.Module_with (remove_module_elements_between_stop_in_module_type_kind mtkind, s) + | Odoc_module.Module_without (mtkind, s) -> + Odoc_module.Module_without (remove_module_elements_between_stop_in_module_type_kind mtkind, s) + | Odoc_module.Module_using (mtkind, s) -> + Odoc_module.Module_using (remove_module_elements_between_stop_in_module_type_kind mtkind, s) | Odoc_module.Module_constraint (k2, mtkind) -> Odoc_module.Module_constraint (remove_module_elements_between_stop_in_module_kind k2, remove_module_elements_between_stop_in_module_type_kind mtkind) @@ -426,6 +430,10 @@ | Odoc_module.Module_type_alias _ -> tk | Odoc_module.Module_type_with (tk2, s) -> Odoc_module.Module_type_with (remove_module_elements_between_stop_in_module_type_kind tk2, s) + | Odoc_module.Module_type_without (tk2, s) -> + Odoc_module.Module_type_without (remove_module_elements_between_stop_in_module_type_kind tk2, s) + | Odoc_module.Module_type_using (tk2, s) -> + Odoc_module.Module_type_using (remove_module_elements_between_stop_in_module_type_kind tk2, s) (** Remove elements between the stop special comment. *) diff -Naur ocaml-3.09.2/ocamldoc/odoc_cross.ml ocaml-3.09.2-sigops/ocamldoc/odoc_cross.ml --- ocaml-3.09.2/ocamldoc/odoc_cross.ml 2005-11-07 17:59:04.000000000 +0200 +++ ocaml-3.09.2-sigops/ocamldoc/odoc_cross.ml 2006-06-29 22:40:13.000000000 +0300 @@ -327,7 +327,9 @@ | Module_functor (_, k) -> iter_kind (acc_b, acc_inc, acc_names) k - | Module_with (tk, _) -> + | Module_with (tk, _) + | Module_without (tk, _) + | Module_using (tk, _) -> associate_in_module_type module_list (acc_b, acc_inc, acc_names) { mt_name = "" ; mt_info = None ; mt_type = None ; mt_is_interface = false ; mt_file = ""; mt_kind = Some tk ; @@ -358,7 +360,9 @@ | Module_type_functor (_, k) -> iter_kind (acc_b, acc_inc, acc_names) k - | Module_type_with (k, _) -> + | Module_type_with (k, _) + | Module_type_without (k, _) + | Module_type_using (k, _) -> iter_kind (acc_b, acc_inc, acc_names) k | Module_type_alias mta -> @@ -730,6 +734,10 @@ assoc_comments_module_kind module_list mk2) | Module_with (mtk, s) -> Module_with (assoc_comments_module_type_kind module_list mtk, s) + | Module_without (mtk, s) -> + Module_without (assoc_comments_module_type_kind module_list mtk, s) + | Module_using (mtk, s) -> + Module_using (assoc_comments_module_type_kind module_list mtk, s) | Module_constraint (mk1, mtk) -> Module_constraint (assoc_comments_module_kind module_list mk1, assoc_comments_module_type_kind module_list mtk) @@ -744,6 +752,10 @@ mtk | Module_type_with (mtk1, s) -> Module_type_with (assoc_comments_module_type_kind module_list mtk1, s) + | Module_type_without (mtk1, s) -> + Module_type_without (assoc_comments_module_type_kind module_list mtk1, s) + | Module_type_using (mtk1, s) -> + Module_type_using (assoc_comments_module_type_kind module_list mtk1, s) and assoc_comments_class_kind module_list ck = match ck with diff -Naur ocaml-3.09.2/ocamldoc/odoc_html.ml ocaml-3.09.2-sigops/ocamldoc/odoc_html.ml --- ocaml-3.09.2/ocamldoc/odoc_html.ml 2005-11-10 16:44:36.000000000 +0200 +++ ocaml-3.09.2-sigops/ocamldoc/odoc_html.ml 2006-06-29 22:47:27.000000000 +0300 @@ -1179,7 +1179,9 @@ self#html_of_text b [Code "("]; self#html_of_module_kind b father k2; self#html_of_text b [Code ")"] - | Module_with (k, s) -> + | Module_with (k, s) + | Module_without (k, s) + | Module_using (k, s) -> (* TODO: à modifier quand Module_with sera plus détaillé *) self#html_of_module_type_kind b father ?modu k; bs b " "; @@ -1250,7 +1252,9 @@ bs b ""; bs b (self#create_fully_qualified_module_idents_links father a.mta_name); bs b "" - | Module_type_with (k, s) -> + | Module_type_with (k, s) + | Module_type_without (k, s) + | Module_type_using (k, s) -> self#html_of_module_type_kind b father ?modu ?mt k; bs b " "; bs b (self#create_fully_qualified_module_idents_links father s); diff -Naur ocaml-3.09.2/ocamldoc/odoc_info.mli ocaml-3.09.2-sigops/ocamldoc/odoc_info.mli --- ocaml-3.09.2/ocamldoc/odoc_info.mli 2005-11-10 16:44:36.000000000 +0200 +++ ocaml-3.09.2-sigops/ocamldoc/odoc_info.mli 2006-07-06 21:42:45.000000000 +0300 @@ -437,6 +437,10 @@ | Module_with of module_type_kind * string (** A module whose type is a with ... constraint. Should appear in interface files only. *) + | Module_without of module_type_kind * string + (** A module whose type is filtere with without.... constrains. *) + | Module_using of module_type_kind * string + (** A module whose type is filtere with using.... constrains. *) | Module_constraint of module_kind * module_type_kind (** A module constraint by a module type. *) @@ -471,6 +475,10 @@ (** Complete alias name and corresponding module type if we found it. *) | Module_type_with of module_type_kind * string (** The module type kind and the code of the with constraint. *) + | Module_type_without of module_type_kind * string + (** The module type kind and the code of the without constraint. *) + | Module_type_using of module_type_kind * string + (** The module type kind and the code of the using constraint. *) (** Representation of a module type. *) and t_module_type = Odoc_module.t_module_type = diff -Naur ocaml-3.09.2/ocamldoc/odoc_latex.ml ocaml-3.09.2-sigops/ocamldoc/odoc_latex.ml --- ocaml-3.09.2/ocamldoc/odoc_latex.ml 2005-11-10 16:44:36.000000000 +0200 +++ ocaml-3.09.2-sigops/ocamldoc/odoc_latex.ml 2006-06-29 22:48:35.000000000 +0300 @@ -603,7 +603,9 @@ | Module_type_alias a -> self#latex_of_text fmt [Code (self#relative_module_idents father a.mta_name)] - | Module_type_with (k, s) -> + | Module_type_with (k, s) + | Module_type_without (k, s) + | Module_type_using (k, s) -> self#latex_of_module_type_kind fmt father k; self#latex_of_text fmt [ Code " "; @@ -629,7 +631,9 @@ self#latex_of_text fmt [Code "("]; self#latex_of_module_kind fmt father k2; self#latex_of_text fmt [Code ")"] - | Module_with (k, s) -> + | Module_with (k, s) + | Module_without (k, s) + | Module_using (k, s) -> (* TODO: à modifier quand Module_with sera plus détaillé *) self#latex_of_module_type_kind fmt father k; self#latex_of_text fmt diff -Naur ocaml-3.09.2/ocamldoc/odoc_module.ml ocaml-3.09.2-sigops/ocamldoc/odoc_module.ml --- ocaml-3.09.2/ocamldoc/odoc_module.ml 2005-11-10 16:44:36.000000000 +0200 +++ ocaml-3.09.2-sigops/ocamldoc/odoc_module.ml 2006-07-06 21:43:16.000000000 +0300 @@ -59,6 +59,8 @@ | Module_functor of module_parameter * module_kind | Module_apply of module_kind * module_kind | Module_with of module_type_kind * string + | Module_without of module_type_kind * string + | Module_using of module_type_kind * string | Module_constraint of module_kind * module_type_kind (** Representation of a module. *) @@ -87,6 +89,9 @@ | Module_type_functor of module_parameter * module_type_kind | Module_type_alias of module_type_alias (** complete name and corresponding module type if we found it *) | Module_type_with of module_type_kind * string (** the module type kind and the code of the with constraint *) + | Module_type_without of module_type_kind * string (** the module type kind and the code of the without constraint *) + | Module_type_using of module_type_kind * string (** the module type kind and the code of the using constraint *) + (** Representation of a module type. *) and t_module_type = { @@ -229,6 +234,20 @@ mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ; mt_loc = Odoc_types.dummy_loc ; } + | Module_without (tk,_) -> + print_DEBUG "Odoc_module.module_element: Module_without"; + module_type_elements ~trans: trans + { mt_name = "" ; mt_info = None ; mt_type = None ; + mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ; + mt_loc = Odoc_types.dummy_loc ; + } + | Module_using (tk,_) -> + print_DEBUG "Odoc_module.module_element: Module_using"; + module_type_elements ~trans: trans + { mt_name = "" ; mt_info = None ; mt_type = None ; + mt_is_interface = false ; mt_file = "" ; mt_kind = Some tk ; + mt_loc = Odoc_types.dummy_loc ; + } | Module_constraint (k, tk) -> print_DEBUG "Odoc_module.module_element: Module_constraint"; (* A VOIR : utiliser k ou tk ? *) @@ -259,7 +278,9 @@ | None -> [] | Some (Module_type_struct l) -> l | Some (Module_type_functor (_, k)) -> iter_kind (Some k) - | Some (Module_type_with (k, _)) -> + | Some (Module_type_with (k, _)) + | Some (Module_type_without (k, _)) + | Some (Module_type_using (k, _)) -> if trans then iter_kind (Some k) else @@ -351,7 +372,9 @@ | Some mt2 -> module_type_parameters ~trans mt2 else [] - | Some (Module_type_with (k, _)) -> + | Some (Module_type_with (k, _)) + | Some (Module_type_without (k, _)) + | Some (Module_type_using (k, _))-> if trans then iter (Some k) else @@ -398,7 +421,9 @@ mt_loc = Odoc_types.dummy_loc } | Module_struct _ | Module_apply _ - | Module_with _ -> + | Module_with _ + | Module_without _ + | Module_using _ -> [] in iter m.m_kind @@ -423,7 +448,9 @@ None -> false | Some mtyp -> module_type_is_functor mtyp ) - | Some (Module_type_with (k, _)) -> + | Some (Module_type_with (k, _)) + | Some (Module_type_without (k, _)) + | Some (Module_type_using (k, _)) -> iter (Some k) | Some (Module_type_struct _) | None -> false diff -Naur ocaml-3.09.2/ocamldoc/odoc_sig.ml ocaml-3.09.2-sigops/ocamldoc/odoc_sig.ml --- ocaml-3.09.2/ocamldoc/odoc_sig.ml 2005-11-10 16:44:36.000000000 +0200 +++ ocaml-3.09.2-sigops/ocamldoc/odoc_sig.ml 2006-07-19 23:14:39.000000000 +0300 @@ -868,6 +868,9 @@ "??" | Parsetree.Pmty_with (mt, _) -> f mt.Parsetree.pmty_desc + | Parsetree.Pmty_without (mt, _) + | Parsetree.Pmty_using (mt, _) -> + f mt.Parsetree.pmty_desc in let name = (f module_type.Parsetree.pmty_desc) in let full_name = Odoc_env.full_module_or_module_type_name env name in @@ -1095,6 +1098,24 @@ let k = analyse_module_type_kind env current_module_name module_type2 sig_module_type in Module_type_with (k, s) ) + | Parsetree.Pmty_without (module_type2, _) -> + (* of module_type * without_constraint list *) + ( + let loc_start = module_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in + let loc_end = module_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in + let s = get_string_of_file loc_start loc_end in + let k = analyse_module_type_kind env current_module_name module_type2 sig_module_type in + Module_type_without (k, s) + ) + | Parsetree.Pmty_using (module_type2, _) -> + (* of module_type * using_constraint list *) + ( + let loc_start = module_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in + let loc_end = module_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in + let s = get_string_of_file loc_start loc_end in + let k = analyse_module_type_kind env current_module_name module_type2 sig_module_type in + Module_type_using (k, s) + ) (** Analyse of a Parsetree.module_type and a Types.module_type.*) and analyse_module_kind env current_module_name module_type sig_module_type = @@ -1159,6 +1180,24 @@ let k = analyse_module_type_kind env current_module_name module_type2 sig_module_type in Module_with (k, s) ) + | Parsetree.Pmty_without (module_type2, _) -> (* skopiowane z powyzej - zrobic co nalezy *) + (*of module_type * (Longident.t * with_constraint) list*) + ( + let loc_start = module_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in + let loc_end = module_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in + let s = get_string_of_file loc_start loc_end in + let k = analyse_module_type_kind env current_module_name module_type2 sig_module_type in + Module_without (k, s) + ) + | Parsetree.Pmty_using (module_type2, _) -> (* skopiowane z powyzej - zrobic co nalezy *) + (*of module_type * (Longident.t * with_constraint) list*) + ( + let loc_start = module_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in + let loc_end = module_type.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in + let s = get_string_of_file loc_start loc_end in + let k = analyse_module_type_kind env current_module_name module_type2 sig_module_type in + Module_using (k, s) + ) (** Analyse of a Parsetree.class_type and a Types.class_type to return a couple (class parameters, class_kind).*) diff -Naur ocaml-3.09.2/ocamldoc/odoc_to_text.ml ocaml-3.09.2-sigops/ocamldoc/odoc_to_text.ml --- ocaml-3.09.2/ocamldoc/odoc_to_text.ml 2004-08-20 20:04:35.000000000 +0300 +++ ocaml-3.09.2-sigops/ocamldoc/odoc_to_text.ml 2006-06-29 22:46:11.000000000 +0300 @@ -519,7 +519,9 @@ (self#text_of_module_kind ~with_def_syntax: false k2) @ [Code " ) "] - | Module_with (tk, code) -> + | Module_with (tk, code) + | Module_without (tk, code) + | Module_using (tk, code) -> (if with_def_syntax then [Code " : "] else []) @ (self#text_of_module_type_kind ~with_def_syntax: false tk) @ [Code code] @@ -557,7 +559,9 @@ let t2 = self#text_of_module_type_kind ~with_def_syntax: false k in (if with_def_syntax then [Code " = "] else []) @ t1 @ t2 - | Module_type_with (tk2, code) -> + | Module_type_with (tk2, code) + | Module_type_without (tk2, code) + | Module_type_using (tk2, code) -> let t = self#text_of_module_type_kind ~with_def_syntax: false tk2 in (if with_def_syntax then [Code " = "] else []) @ t @ [Code code] diff -Naur ocaml-3.09.2/otherlibs/labltk/browser/searchpos.ml ocaml-3.09.2-sigops/otherlibs/labltk/browser/searchpos.ml --- ocaml-3.09.2/otherlibs/labltk/browser/searchpos.ml 2005-03-23 05:08:37.000000000 +0200 +++ ocaml-3.09.2-sigops/otherlibs/labltk/browser/searchpos.ml 2006-07-19 23:15:42.000000000 +0300 @@ -239,6 +239,9 @@ _, Pwith_type t -> search_pos_type_decl t ~pos ~env | _ -> () end + | Pmty_without (m, l) + | Pmty_using (m, l) -> + search_pos_module m ~pos ~env end end diff -Naur ocaml-3.09.2/parsing/parser.mly ocaml-3.09.2-sigops/parsing/parser.mly --- ocaml-3.09.2/parsing/parser.mly 2006-01-24 15:47:51.000000000 +0200 +++ ocaml-3.09.2-sigops/parsing/parser.mly 2006-07-20 01:19:36.000000000 +0300 @@ -496,6 +496,13 @@ { mkmty(Pmty_functor($3, $5, $8)) } | module_type WITH with_constraints { mkmty(Pmty_with($1, List.rev $3)) } + | module_type LIDENT LPAREN modtype_fields RPAREN + { if $2 = "using" then + mkmty(Pmty_using($1, List.rev $4)) + else if $2 = "without" then + mkmty(Pmty_without($1, List.rev $4)) + else + raise(Syntaxerr.Error(Syntaxerr.Other (rhs_loc 2))) } | LPAREN module_type RPAREN { $2 } | LPAREN module_type error @@ -506,6 +513,19 @@ | signature signature_item { $2 :: $1 } | signature signature_item SEMISEMI { $2 :: $1 } ; +modtype_fields: + modtype_field { [$1] } + | modtype_fields AND modtype_field { $3 :: $1 } +; +modtype_field: + VAL val_ident { Pfield_val $2 } + | TYPE LIDENT { Pfield_type $2 } + | EXCEPTION UIDENT { Pfield_exception $2} + | MODULE UIDENT { Pfield_module $2 } + | MODULE TYPE ident { Pfield_module_type $3 } + | CLASS LIDENT { Pfield_class $2 } + | CLASS TYPE LIDENT { Pfield_class_type $3 } +; signature_item: VAL val_ident_colon core_type { mksig(Psig_value($2, {pval_type = $3; pval_prim = []})) } diff -Naur ocaml-3.09.2/parsing/parsetree.mli ocaml-3.09.2-sigops/parsing/parsetree.mli --- ocaml-3.09.2/parsing/parsetree.mli 2005-03-23 05:08:37.000000000 +0200 +++ ocaml-3.09.2-sigops/parsing/parsetree.mli 2006-07-06 23:05:47.000000000 +0300 @@ -199,6 +199,8 @@ | Pmty_signature of signature | Pmty_functor of string * module_type * module_type | Pmty_with of module_type * (Longident.t * with_constraint) list + | Pmty_without of module_type * modtype_field list + | Pmty_using of module_type * modtype_field list and signature = signature_item list @@ -222,6 +224,15 @@ Pmodtype_abstract | Pmodtype_manifest of module_type +and modtype_field = + Pfield_val of string + | Pfield_type of string + | Pfield_exception of string + | Pfield_module of string + | Pfield_module_type of string + | Pfield_class of string + | Pfield_class_type of string + and with_constraint = Pwith_type of type_declaration | Pwith_module of Longident.t diff -Naur ocaml-3.09.2/parsing/printast.ml ocaml-3.09.2-sigops/parsing/printast.ml --- ocaml-3.09.2/parsing/printast.ml 2005-11-16 18:01:12.000000000 +0200 +++ ocaml-3.09.2-sigops/parsing/printast.ml 2006-07-12 20:09:58.000000000 +0300 @@ -477,6 +477,14 @@ line i ppf "Pmty_with\n"; module_type i ppf mt; list i longident_x_with_constraint ppf l; + | Pmty_without (mt, l) -> + line i ppf "Pmty_without\n"; + module_type i ppf mt; + list i modtype_field ppf l; + | Pmty_using (mt, l) -> + line i ppf "Pmty_using\n"; + module_type i ppf mt; + list i modtype_field ppf l; and signature i ppf x = list i signature_item ppf x @@ -527,6 +535,23 @@ type_declaration (i+1) ppf td; | Pwith_module (li) -> line i ppf "Pwith_module %a\n" fmt_longident li; +and modtype_field i ppf x = + match x with + | Pfield_val (id) -> + line i ppf "Pfield_val \"%s\"\n" id; + | Pfield_type (id) -> + line i ppf "Pfield_type \"%s\"\n" id; + | Pfield_exception (id) -> + line i ppf "Pfield_exceptioon \"%s\"\n" id; + | Pfield_module (id) -> + line i ppf "Pfield_module \"%s\"\n" id; + | Pfield_module_type (id) -> + line i ppf "Pfield_module_type \"%s\"\n" id; + | Pfield_class (id) -> + line i ppf "Pfield_class \"%s\"\n" id; + | Pfield_class_type (id) -> + line i ppf "Pfield_class_type \"%s\"\n" id; + and module_expr i ppf x = line i ppf "module_expr %a\n" fmt_location x.pmod_loc; let i = i+1 in diff -Naur ocaml-3.09.2/stdlib/sys.ml ocaml-3.09.2-sigops/stdlib/sys.ml --- ocaml-3.09.2/stdlib/sys.ml 2006-04-14 12:53:48.000000000 +0300 +++ ocaml-3.09.2-sigops/stdlib/sys.ml 2006-07-19 22:23:59.000000000 +0300 @@ -78,4 +78,4 @@ (* OCaml version string, must be in the format described in sys.mli. *) -let ocaml_version = "3.09.2";; +let ocaml_version = "3.09.2+sigops";; diff -Naur ocaml-3.09.2/tools/depend.ml ocaml-3.09.2-sigops/tools/depend.ml --- ocaml-3.09.2/tools/depend.ml 2005-03-23 05:08:37.000000000 +0200 +++ ocaml-3.09.2-sigops/tools/depend.ml 2006-07-19 23:45:44.000000000 +0300 @@ -171,6 +171,9 @@ (function (_, Pwith_type td) -> add_type_declaration bv td | (_, Pwith_module lid) -> addmodule bv lid) cstrl + | Pmty_without(mty, _) + | Pmty_using(mty, _) -> + add_modtype bv mty and add_signature bv = function [] -> () diff -Naur ocaml-3.09.2/typing/typemod.ml ocaml-3.09.2-sigops/typing/typemod.ml --- ocaml-3.09.2/typing/typemod.ml 2005-08-08 12:41:51.000000000 +0300 +++ ocaml-3.09.2-sigops/typing/typemod.ml 2006-07-19 23:58:29.000000000 +0300 @@ -31,6 +31,8 @@ | Signature_expected | Structure_expected of module_type | With_no_component of Longident.t + | Field_not_found of string * string * string + | Inconsistent_modtype of string | With_mismatch of Longident.t * Includemod.error list | Repeated_name of string * string | Non_generalizable of type_expr @@ -167,8 +169,10 @@ let (id, newenv) = Env.enter_module param arg env in let res = approx_mty newenv sres in Tmty_functor(id, arg, res) - | Pmty_with(sbody, constraints) -> - approx_mty env sbody + | Pmty_with(sbody, _) + | Pmty_without(sbody, _) + | Pmty_using(sbody, _) -> + approx_mty env sbody and approx_sig env ssg = match ssg with @@ -263,6 +267,68 @@ check "module type" loc modtype_names (Ident.name id) | _ -> () +let error_constr kind constr loc = + let (ftype, id) = + match constr with + Pfield_val str -> ("value", str) + | Pfield_type str -> ("type", str) + | Pfield_exception str -> ("exception", str) + | Pfield_module str -> ("module", str) + | Pfield_module_type str -> ("module type", str) + | Pfield_class str -> ("class", str) + | Pfield_class_type str -> ("class type", str) + in raise(Error(loc, Field_not_found(kind, ftype, id))) + +let filter_sig_field constr sig_field = + match (sig_field, constr) with + (Tsig_value(id, _), Pfield_val str) + | (Tsig_type(id, _, _), Pfield_type str) + | (Tsig_exception(id, _), Pfield_exception str) + | (Tsig_module(id, _, _), Pfield_module str) + | (Tsig_modtype(id, _), Pfield_module_type str) + | (Tsig_class (id, _, _), Pfield_class str) + | (Tsig_cltype (id, _, _), Pfield_class_type str) -> + not (Ident.name id = str) + | _ -> true + +let do_without loc (sg, rem) constr = + let (res, removed) = List.partition (filter_sig_field constr) sg in + if removed = [] then error_constr "without" constr loc + else (res, removed @ rem) + +let do_using loc (used, sg) constr = + let (left, use) = List.partition (filter_sig_field constr) sg in + if use = [] then error_constr "using" constr loc + else (use @ used, left) + +let sig_item_id = function + Tsig_value (id, _) + | Tsig_type (id, _, _) + | Tsig_exception (id, _) + | Tsig_module (id, _, _) + | Tsig_modtype (id, _) + | Tsig_class (id, _, _) + | Tsig_cltype (id, _, _) -> id + +let do_nondep env loc mod_type sig_item = + let id = sig_item_id sig_item in + try + Mtype.nondep_supertype env id mod_type + with Not_found -> + raise(Error(loc, Inconsistent_modtype (Ident.name id))) + +let filter_sig_using sg usings env loc = + let (result, removed) = List.fold_left (do_using loc) ([], sg) usings in + let result = List.fold_left (do_nondep env loc) (Tmty_signature result) removed + in + result + +let filter_sig_without sg withouts env loc = + let (result, removed) = List.fold_left (do_without loc) (sg, []) withouts in + let result = List.fold_left (do_nondep env loc) (Tmty_signature result) removed + in + result + (* Check and translate a module type expression *) let rec transl_modtype env smty = @@ -290,6 +356,17 @@ merge_constraint env smty.pmty_loc sg lid sdecl) init_sg constraints in Mtype.freshen (Tmty_signature final_sg) + | Pmty_without(sbody, withouts) -> + let body = transl_modtype env sbody in + let init_sg = extract_sig env sbody.pmty_loc body in + let final_sg = filter_sig_without init_sg withouts env smty.pmty_loc in + Mtype.freshen final_sg + | Pmty_using(sbody, usings) -> + let body = transl_modtype env sbody in + let init_sg = extract_sig env sbody.pmty_loc body in + let final_sg = filter_sig_using init_sg usings env smty.pmty_loc in + Mtype.freshen final_sg + and transl_signature env sg = let type_names = ref StringSet.empty @@ -893,6 +970,13 @@ in the constrained signature:@]@ \ %a@]" longident lid Includemod.report_error explanation + | Field_not_found(kind, field, id) -> + fprintf ppf + "@[The signature constrained with `%s' has no %s named %s@]" kind field id + | Inconsistent_modtype str -> + fprintf ppf + "@[The constrained signature is inconsistent: `%s' \ + referenced but not defined @]" str | Repeated_name(kind, name) -> fprintf ppf "@[Multiple definition of the %s name %s.@ \ diff -Naur ocaml-3.09.2/typing/typemod.mli ocaml-3.09.2-sigops/typing/typemod.mli --- ocaml-3.09.2/typing/typemod.mli 2005-08-08 12:41:52.000000000 +0300 +++ ocaml-3.09.2-sigops/typing/typemod.mli 2006-07-19 23:54:57.000000000 +0300 @@ -43,6 +43,8 @@ | Signature_expected | Structure_expected of module_type | With_no_component of Longident.t + | Field_not_found of string * string * string + | Inconsistent_modtype of string | With_mismatch of Longident.t * Includemod.error list | Repeated_name of string * string | Non_generalizable of type_expr