summaryrefslogtreecommitdiff
path: root/kernel/subtyping.ml
diff options
context:
space:
mode:
Diffstat (limited to 'kernel/subtyping.ml')
-rw-r--r--kernel/subtyping.ml9
1 files changed, 5 insertions, 4 deletions
diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml
index 2e9a33a9..74042f9e 100644
--- a/kernel/subtyping.ml
+++ b/kernel/subtyping.ml
@@ -194,8 +194,9 @@ let check_inductive cst env mp1 l info1 mp2 mib2 spec2 subst1 subst2 reso1 reso2
else error NotEqualInductiveAliases
end;
(* we check that records and their field names are preserved. *)
- check (fun mib -> mib.mind_record <> None) (==) (fun x -> RecordFieldExpected x);
- if mib1.mind_record <> None then begin
+ (** FIXME: this check looks nonsense *)
+ check (fun mib -> mib.mind_record <> NotRecord) (==) (fun x -> RecordFieldExpected x);
+ if mib1.mind_record <> NotRecord then begin
let rec names_prod_letin t = match kind t with
| Prod(n,_,t) -> n::(names_prod_letin t)
| LetIn(n,_,_,t) -> n::(names_prod_letin t)
@@ -223,7 +224,7 @@ let check_inductive cst env mp1 l info1 mp2 mib2 spec2 subst1 subst2 reso1 reso2
cst
-let check_constant cst env mp1 l info1 cb2 spec2 subst1 subst2 =
+let check_constant cst env l info1 cb2 spec2 subst1 subst2 =
let error why = error_signature_mismatch l spec2 why in
let check_conv cst poly f = check_conv_error error cst poly f in
let check_type poly cst env t1 t2 =
@@ -291,7 +292,7 @@ and check_signatures cst env mp1 sig1 mp2 sig2 subst1 subst2 reso1 reso2=
let check_one_body cst (l,spec2) =
match spec2 with
| SFBconst cb2 ->
- check_constant cst env mp1 l (get_obj mp1 map1 l)
+ check_constant cst env l (get_obj mp1 map1 l)
cb2 spec2 subst1 subst2
| SFBmind mib2 ->
check_inductive cst env mp1 l (get_obj mp1 map1 l)