diff options
| author | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2001-11-16 07:26:56 +0000 |
|---|---|---|
| committer | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2001-11-16 07:26:56 +0000 |
| commit | 50fc257b4c73bbc1559bd520d00a762eaca5cf5c (patch) | |
| tree | dc452e1231e9bdca8aa658a5fefeff068683e4d4 | |
| parent | ac57e382d27cd74b96cc05d534692b79d001bf54 (diff) | |
| download | ocaml-50fc257b4c73bbc1559bd520d00a762eaca5cf5c.tar.gz | |
fix PR#632 (incorrect generalization of variants in classes)
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4015 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
| -rw-r--r-- | typing/ctype.ml | 30 | ||||
| -rw-r--r-- | typing/typetexp.ml | 2 | ||||
| -rw-r--r-- | utils/config.mlp | 2 |
3 files changed, 19 insertions, 15 deletions
diff --git a/typing/ctype.ml b/typing/ctype.ml index b67120cf83..78139055d1 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -595,7 +595,12 @@ let limited_generalize ty0 ty = if (ty.level = generic_level) || (ty == ty0) then roots := ty :: !roots; ty.level <- !idx; - iter_type_expr (inverse [ty]) ty + let pty' = + match ty.desc with + Tvariant row -> [ty; row_more row] + | _ -> [ty] + in + iter_type_expr (inverse pty') ty end else if ty.level < lowest_level then begin let (_, parents) = Hashtbl.find graph ty.level in parents := pty @ !parents @@ -706,10 +711,14 @@ let rec copy ty = (* This variant type has been already copied *) ty.desc <- Tsubst ty2; (* avoid Tlink in the new type *) Tlink ty2 + | _ when more.level <> generic_level -> + (* If the row variable is not generic, do nothing *) + Tvariant row0 | _ -> - (* We shall really check the level on the row variable *) - if more.level <> generic_level then Tvariant row0 else - (* We create a new copy *) + (* Register new type first for recursion *) + save_desc more more.desc; + more.desc <- ty.desc; + (* Create a new copy *) let fields = List.map (fun (l,fi) -> l, @@ -720,16 +729,11 @@ let rec copy ty = | fi -> fi) row.row_fields and name = - may_map (fun (p,l) -> p, List.map copy l) row.row_name in - let var = - Tvariant { row_fields = fields; row_more = newvar(); - row_bound = List.map copy row.row_bound; - row_closed = row.row_closed; row_name = name } + may_map (fun (p,l) -> p, List.map copy l) row.row_name in - (* Remember it for other occurences *) - save_desc more more.desc; - more.desc <- ty.desc; - var + Tvariant { row_fields = fields; row_more = newvar(); + row_bound = List.map copy row.row_bound; + row_closed = row.row_closed; row_name = name } end | Tfield (label, kind, t1, t2) -> begin match field_kind_repr kind with diff --git a/typing/typetexp.ml b/typing/typetexp.ml index 64ec216878..42ce1b89a0 100644 --- a/typing/typetexp.ml +++ b/typing/typetexp.ml @@ -375,7 +375,7 @@ let report_error ppf = function but is here applied to %i argument(s)@]" longident lid expected provided | Bound_type_variable name -> - fprintf ppf "Already bound type parameter %s" name + fprintf ppf "Already bound type parameter '%s" name | Recursive_type -> fprintf ppf "This type is recursive" | Unbound_class lid -> diff --git a/utils/config.mlp b/utils/config.mlp index c8411052a5..7a1fc3a4c1 100644 --- a/utils/config.mlp +++ b/utils/config.mlp @@ -12,7 +12,7 @@ (* $Id$ *) -let version = "3.03 ALPHA+3 (2001-11-05)" +let version = "3.03 ALPHA+4 (2001-11-16)" let standard_library = try |