aboutsummaryrefslogtreecommitdiffhomepage
path: root/checker/subtyping.ml
diff options
context:
space:
mode:
Diffstat (limited to 'checker/subtyping.ml')
-rw-r--r--checker/subtyping.ml19
1 files changed, 11 insertions, 8 deletions
diff --git a/checker/subtyping.ml b/checker/subtyping.ml
index 9e9e94deb..6d0d6f6c6 100644
--- a/checker/subtyping.ml
+++ b/checker/subtyping.ml
@@ -125,7 +125,7 @@ let check_inductive env mp1 l info1 mib2 spec2 subst1 subst2=
in
let eq_projection_body p1 p2 =
let check eq f = if not (eq (f p1) (f p2)) then error () in
- check MutInd.equal (fun x -> x.proj_ind);
+ check eq_ind (fun x -> x.proj_ind);
check (==) (fun x -> x.proj_npars);
check (==) (fun x -> x.proj_arg);
check (eq_constr) (fun x -> x.proj_type);
@@ -184,16 +184,19 @@ let check_inductive env mp1 l info1 mib2 spec2 subst1 subst2=
(* we check that records and their field names are preserved. *)
let record_equal x y =
match x, y with
- | None, None -> true
- | Some None, Some None -> true
- | Some (Some (id1,p1,pb1)), Some (Some (id2,p2,pb2)) ->
- Id.equal id1 id2 &&
- Array.for_all2 Constant.UserOrd.equal p1 p2 &&
- Array.for_all2 eq_projection_body pb1 pb2
+ | NotRecord, NotRecord -> true
+ | FakeRecord, FakeRecord -> true
+ | PrimRecord info1, PrimRecord info2 ->
+ let check (id1, p1, pb1) (id2, p2, pb2) =
+ Id.equal id1 id2 &&
+ Array.for_all2 Constant.UserOrd.equal p1 p2 &&
+ Array.for_all2 eq_projection_body pb1 pb2
+ in
+ Array.equal check info1 info2
| _, _ -> false
in
check record_equal (fun mib -> mib.mind_record);
- if mib1.mind_record != None then begin
+ if mib1.mind_record != NotRecord then begin
let rec names_prod_letin t = match t with
| Prod(n,_,t) -> n::(names_prod_letin t)
| LetIn(n,_,_,t) -> n::(names_prod_letin t)