Permalink
Browse files

Fix PR#6371

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14608 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
  • Loading branch information...
1 parent 774e30e commit 5db6318900ed72dbab92c45cf09a6c53656f3697 Jacques Garrigue committed Apr 16, 2014
@@ -0,0 +1,7 @@
+module M = struct
+ type t = int * (< m : 'a > as 'a)
+end;;
+
+module type S =
+ sig module M : sig type t end end with module M = M
+;;
@@ -0,0 +1,4 @@
+
+# module M : sig type t = int * (< m : 'a > as 'a) end
+# module type S = sig module M : sig type t = int * (< m : 'a > as 'a) end end
+#
View
@@ -249,6 +249,7 @@ type type_iterators =
it_module_type: type_iterators -> module_type -> unit;
it_class_type: type_iterators -> class_type -> unit;
it_type_kind: type_iterators -> type_kind -> unit;
+ it_do_type_expr: type_iterators -> type_expr -> unit;
it_type_expr: type_iterators -> type_expr -> unit;
it_path: Path.t -> unit; }
@@ -314,7 +315,7 @@ let type_iterators =
List.iter (it.it_type_expr it) cd.cd_args;
may (it.it_type_expr it) cd.cd_res)
cl
- and it_type_expr it ty =
+ and it_do_type_expr it ty =
iter_type_expr (it.it_type_expr it) ty;
match ty.desc with
Tconstr (p, _, _)
@@ -326,7 +327,8 @@ let type_iterators =
| _ -> ()
and it_path p = ()
in
- { it_path; it_type_expr; it_type_kind; it_class_type; it_module_type;
+ { it_path; it_type_expr = it_do_type_expr; it_do_type_expr;
+ it_type_kind; it_class_type; it_module_type;
it_signature; it_class_type_declaration; it_class_declaration;
it_modtype_declaration; it_module_declaration; it_exception_declaration;
it_type_declaration; it_value_description; it_signature_item; }
@@ -430,6 +432,17 @@ let mark_type_node ty =
let mark_type_params ty =
iter_type_expr mark_type ty
+let type_iterators =
+ let it_type_expr it ty =
+ let ty = repr ty in
+ if ty.level >= lowest_level then begin
+ mark_type_node ty;
+ it.it_do_type_expr it ty;
+ end
+ in
+ {type_iterators with it_type_expr}
+
+
(* Remove marks from a type. *)
let rec unmark_type ty =
let ty = repr ty in
@@ -438,36 +451,19 @@ let rec unmark_type ty =
iter_type_expr unmark_type ty
end
+let unmark_iterators =
+ let it_type_expr it ty = unmark_type ty in
+ {type_iterators with it_type_expr}
+
let unmark_type_decl decl =
- List.iter unmark_type decl.type_params;
- begin match decl.type_kind with
- Type_abstract -> ()
- | Type_variant cstrs ->
- List.iter
- (fun d ->
- List.iter unmark_type d.cd_args;
- Misc.may unmark_type d.cd_res)
- cstrs
- | Type_record(lbls, rep) ->
- List.iter (fun d -> unmark_type d.ld_type) lbls
- end;
- begin match decl.type_manifest with
- None -> ()
- | Some ty -> unmark_type ty
- end
+ unmark_iterators.it_type_declaration unmark_iterators decl
let unmark_class_signature sign =
unmark_type sign.csig_self;
Vars.iter (fun l (m, v, t) -> unmark_type t) sign.csig_vars
-let rec unmark_class_type =
- function
- Cty_constr (p, tyl, cty) ->
- List.iter unmark_type tyl; unmark_class_type cty
- | Cty_signature sign ->
- unmark_class_signature sign
- | Cty_arrow (_, ty, cty) ->
- unmark_type ty; unmark_class_type cty
+let unmark_class_type cty =
+ unmark_iterators.it_class_type unmark_iterators cty
(*******************************************)
View
@@ -103,10 +103,14 @@ type type_iterators =
it_module_type: type_iterators -> module_type -> unit;
it_class_type: type_iterators -> class_type -> unit;
it_type_kind: type_iterators -> type_kind -> unit;
+ it_do_type_expr: type_iterators -> type_expr -> unit;
it_type_expr: type_iterators -> type_expr -> unit;
it_path: Path.t -> unit; }
-val type_iterators : type_iterators
- (* Iteration on arbitrary type information *)
+val type_iterators: type_iterators
+ (* Iteration on arbitrary type information.
+ [it_type_expr] calls [mark_type_node] to avoid loops. *)
+val unmark_iterators: type_iterators
+ (* Unmark any structure containing types. See [unmark_type] below. *)
val copy_type_desc:
?keep_names:bool -> (type_expr -> type_expr) -> type_desc -> type_desc
View
@@ -342,6 +342,7 @@ let collect_arg_paths mty =
in
let it = {type_iterators with it_path; it_signature_item} in
it.it_module_type it mty;
+ it.it_module_type unmark_iterators mty;
PathSet.fold (fun p -> IdentSet.union (collect_ids !subst !bindings p))
!paths IdentSet.empty

0 comments on commit 5db6318

Please sign in to comment.