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

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
master
Jacques Garrigue 2001-11-16 07:26:56 +00:00
parent ac57e382d2
commit 50fc257b4c
3 changed files with 19 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
typing/ctype.ml
View File

@ -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

2
typing/typetexp.ml
View File

@ -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 ->

2
utils/config.mlp
View File

@ -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