Commit 42dda81a authored by Kim Nguyễn's avatar Kim Nguyễn
Browse files

Fix a bug in toplevel definition of types:

when a type such as

type t('a) = (Int,'a)

is introduced, the variables occuring in the definitions are replaced by fresh occurences.
The variables in the left-hand-side were note renamed accordingly, yielding a type definition:

type t('a_0) = (Int, 'a_1)

when performing type substitutions, none of the occurences of 'a_1 were replaced.
parent 01e9ada9
...@@ -459,23 +459,34 @@ module IType = struct ...@@ -459,23 +459,34 @@ module IType = struct
in in
let b = let b =
List.map2 (fun ((loc,v),pl,p) (v',_,d) -> List.map2 (fun ((loc,v),pl,p) (v',_,d) ->
let t = Types.Positive.substitutefree Var.Set.empty (aux loc d) in
let vars = Var.Set.fold (fun acc v -> ( v,v)::acc) [] (Types.all_vars t) in let t_rhs = aux loc d in
if (loc <> noloc) && (Types.is_empty t) then if (loc <> noloc) && (Types.is_empty t_rhs) then
warning loc warning loc
("This definition yields an empty type for " ^ (U.to_string v)); ("This definition yields an empty type for " ^ (U.to_string v));
if (List.length vars) <> (List.length pl) then
let vars_rhs = Types.all_vars t_rhs in
let vars_mapping = (* create a sequence 'a -> 'a_0 for all variables *) (fun v -> let vv = (Ident.U.to_string v) in vv, Var.fresh vv) pl
let vars_lhs =
List.fold_left (fun acc (v, _) -> Var.Set.add v acc) Var.Set.empty vars_mapping
if not (Var.Set.subset vars_rhs vars_lhs) then
error loc error loc
(Printf.sprintf "Definition of type %s contains unused/undeclared type variables" (Printf.sprintf "Definition of type %s contains unbound type variables"
(U.to_string v) (U.to_string v));
let t_rhs =
Types.Positive.substitute_list t_rhs
( (fun (v,vt) -> v, Types.var vt) vars_mapping)
let al = let al =
let a = Array.make (List.length pl) ( "dummy") in let a = Array.make (List.length pl) ( "dummy") in
(* List.iteri (fun i v -> a.(i) <- (List.assoc (U.to_string v) vars)) pl; *) List.iteri (fun i (_,v) -> a.(i) <- v) vars_mapping;
List.iteri (fun i v -> a.(i) <- (Ident.U.to_string v)) pl;
a a
in in
(v',t,al) (v',t_rhs,al)
) (List.rev b) (List.rev b') ) (List.rev b) (List.rev b')
in in
List.iter (fun (v,t,al) -> List.iter (fun (v,t,al) ->
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment