diff options
Diffstat (limited to 'typing/includecore.ml')
| -rw-r--r-- | typing/includecore.ml | 38 |
1 files changed, 19 insertions, 19 deletions
diff --git a/typing/includecore.ml b/typing/includecore.ml index 558cfe7de..68f848576 100644 --- a/typing/includecore.ml +++ b/typing/includecore.ml @@ -117,11 +117,11 @@ type type_mismatch = | Constraint | Manifest | Variance - | Field_type of string - | Field_mutable of string - | Field_arity of string - | Field_names of int * string * string - | Field_missing of bool * string + | Field_type of Ident.t + | Field_mutable of Ident.t + | Field_arity of Ident.t + | Field_names of int * Ident.t * Ident.t + | Field_missing of bool * Ident.t | Record_representation of bool let nth n = @@ -140,17 +140,17 @@ let report_type_mismatch0 first second decl ppf err = | Manifest -> () | Variance -> pr "Their variances do not agree" | Field_type s -> - pr "The types for field %s are not equal" s + pr "The types for field %s are not equal" (Ident.name s) | Field_mutable s -> - pr "The mutability of field %s is different" s + pr "The mutability of field %s is different" (Ident.name s) | Field_arity s -> - pr "The arities for field %s differ" s + pr "The arities for field %s differ" (Ident.name s) | Field_names (n, name1, name2) -> pr "Their %s fields have different names, %s and %s" - (nth n) name1 name2 + (nth n) (Ident.name name1) (Ident.name name2) | Field_missing (b, s) -> pr "The field %s is only present in %s %s" - s (if b then second else first) decl + (Ident.name s) (if b then second else first) decl | Record_representation b -> pr "Their internal representations differ:@ %s %s %s" (if b then second else first) decl @@ -168,31 +168,31 @@ let rec compare_variants env decl1 decl2 n cstrs1 cstrs2 = | [], (cstr2,_,_)::_ -> [Field_missing (true, cstr2)] | (cstr1,_,_)::_, [] -> [Field_missing (false, cstr1)] | (cstr1, arg1, ret1)::rem1, (cstr2, arg2,ret2)::rem2 -> - if cstr1 <> cstr2 then [Field_names (n, cstr1, cstr2)] else + if Ident.name cstr1 <> Ident.name cstr2 then [Field_names (n, cstr1, cstr2)] else if List.length arg1 <> List.length arg2 then [Field_arity cstr1] else match ret1, ret2 with - | Some r1, Some r2 when not (Ctype.equal env true [r1] [r2]) -> + | Some r1, Some r2 when not (Ctype.equal env true [r1] [r2]) -> [Field_type cstr1] | Some _, None | None, Some _ -> [Field_type cstr1] - | _ -> + | _ -> if Misc.for_all2 (fun ty1 ty2 -> Ctype.equal env true (ty1::decl1.type_params) (ty2::decl2.type_params)) - (arg1) (arg2) - then + (arg1) (arg2) + then compare_variants env decl1 decl2 (n+1) rem1 rem2 else [Field_type cstr1] - - + + let rec compare_records env decl1 decl2 n labels1 labels2 = match labels1, labels2 with [], [] -> [] | [], (lab2,_,_)::_ -> [Field_missing (true, lab2)] | (lab1,_,_)::_, [] -> [Field_missing (false, lab1)] | (lab1, mut1, arg1)::rem1, (lab2, mut2, arg2)::rem2 -> - if lab1 <> lab2 then [Field_names (n, lab1, lab2)] else + if Ident.name lab1 <> Ident.name lab2 then [Field_names (n, lab1, lab2)] else if mut1 <> mut2 then [Field_mutable lab1] else if Ctype.equal env true (arg1::decl1.type_params) (arg2::decl2.type_params) @@ -207,7 +207,7 @@ let type_declarations ?(equality = false) env name decl1 id decl2 = | (Type_variant cstrs1, Type_variant cstrs2) -> let mark cstrs usage name decl = List.iter - (fun (c, _, _) -> Env.mark_constructor_used usage name decl c) + (fun (c, _, _) -> Env.mark_constructor_used usage name decl (Ident.name c)) cstrs in let usage = |