|
@@ -514,29 +514,32 @@ let valid_redefinition ctx f1 t1 f2 t2 =
|
|
|
let t1, t2 = (match f1.cf_params, f2.cf_params with
|
|
|
| [], [] -> t1, t2
|
|
|
| l1, l2 when List.length l1 = List.length l2 ->
|
|
|
- let monos = List.map2 (fun (_,p1) (_,p2) ->
|
|
|
- match follow p1, follow p2 with
|
|
|
+ let to_check = ref [] in
|
|
|
+ let monos = List.map2 (fun (name,p1) (_,p2) ->
|
|
|
+ (match follow p1, follow p2 with
|
|
|
| TInst ({ cl_kind = KTypeParameter ct1 } as c1,pl1), TInst ({ cl_kind = KTypeParameter ct2 } as c2,pl2) ->
|
|
|
(match ct1, ct2 with
|
|
|
- | [], [] ->
|
|
|
- let m = mk_mono() in
|
|
|
- m,m
|
|
|
+ | [], [] -> ()
|
|
|
| _, _ when List.length ct1 = List.length ct2 ->
|
|
|
(* if same constraints, they are the same type *)
|
|
|
- List.iter2 (fun t1 t2 ->
|
|
|
- try
|
|
|
- type_eq EqStrict (apply_params c1.cl_types pl1 t1) (apply_params c2.cl_types pl2 t2)
|
|
|
- with Unify_error l ->
|
|
|
- raise (Unify_error (Unify_custom "Constraints differ" :: l))
|
|
|
- ) ct1 ct2;
|
|
|
- let m = mk_mono() in
|
|
|
- m,m
|
|
|
+ let check monos =
|
|
|
+ List.iter2 (fun t1 t2 ->
|
|
|
+ try
|
|
|
+ let t1 = apply_params l1 monos (apply_params c1.cl_types pl1 t1) in
|
|
|
+ let t2 = apply_params l2 monos (apply_params c2.cl_types pl2 t2) in
|
|
|
+ type_eq EqStrict t1 t2
|
|
|
+ with Unify_error l ->
|
|
|
+ raise (Unify_error (Unify_custom "Constraints differ" :: l))
|
|
|
+ ) ct1 ct2
|
|
|
+ in
|
|
|
+ to_check := check :: !to_check;
|
|
|
| _ ->
|
|
|
raise (Unify_error [Unify_custom "Different number of constraints"]))
|
|
|
- | _ ->
|
|
|
- p1, p2
|
|
|
+ | _ -> ());
|
|
|
+ TInst (mk_class null_module ([],name) Ast.null_pos,[])
|
|
|
) l1 l2 in
|
|
|
- apply_params l1 (List.map fst monos) t1, apply_params l2 (List.map snd monos) t2
|
|
|
+ List.iter (fun f -> f monos) !to_check;
|
|
|
+ apply_params l1 monos t1, apply_params l2 monos t2
|
|
|
| _ ->
|
|
|
(* ignore type params, will create other errors later *)
|
|
|
t1, t2
|