aboutsummaryrefslogtreecommitdiffhomepage
path: root/kernel/subtyping.ml
diff options
context:
space:
mode:
authorGravatar Matthieu Sozeau <mattam@mattam.org>2013-10-28 14:08:46 +0100
committerGravatar Matthieu Sozeau <mattam@mattam.org>2014-05-06 09:58:54 +0200
commit001ff72b2c17fb7b2fcaefa2555c115f0d909a03 (patch)
tree9e83ae395173699a7c5b6f00648c4336bedb7afd /kernel/subtyping.ml
parent84cbc09bd1400f732a6c70e8a840e4c13d018478 (diff)
Initial work on reintroducing old-style polymorphism for compatibility (the stdlib does not compile entirely).
Diffstat (limited to 'kernel/subtyping.ml')
-rw-r--r--kernel/subtyping.ml8
1 files changed, 4 insertions, 4 deletions
diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml
index 2c093939a..56e94ba0d 100644
--- a/kernel/subtyping.ml
+++ b/kernel/subtyping.ml
@@ -277,8 +277,8 @@ let check_constant cst env mp1 l info1 cb2 spec2 subst1 subst2 =
let cb1 = Declareops.subst_const_body subst1 cb1 in
let cb2 = Declareops.subst_const_body subst2 cb2 in
(* Start by checking types*)
- let typ1 = cb1.const_type in
- let typ2 = cb2.const_type in
+ let typ1 = Typeops.type_of_constant_type env cb1.const_type in
+ let typ2 = Typeops.type_of_constant_type env cb2.const_type in
let cst = check_type cst env typ1 typ2 in
(* Now we check the bodies:
- A transparent constant can only be implemented by a compatible
@@ -309,7 +309,7 @@ let check_constant cst env mp1 l info1 cb2 spec2 subst1 subst2 =
let arity1,cst1 = constrained_type_of_inductive env
((mind1,mind1.mind_packets.(i)),u1) in
let cst2 = UContext.constraints (Future.force cb2.const_universes) in
- let typ2 = cb2.const_type in
+ let typ2 = Typeops.type_of_constant_type env cb2.const_type in
let cst = Constraint.union cst (Constraint.union cst1 cst2) in
let error = NotConvertibleTypeField (env, arity1, typ2) in
check_conv error cst infer_conv_leq env arity1 typ2
@@ -324,7 +324,7 @@ let check_constant cst env mp1 l info1 cb2 spec2 subst1 subst2 =
let u1 = inductive_instance mind1 in
let ty1,cst1 = constrained_type_of_constructor (cstr,u1) (mind1,mind1.mind_packets.(i)) in
let cst2 = UContext.constraints (Future.force cb2.const_universes) in
- let ty2 = cb2.const_type in
+ let ty2 = Typeops.type_of_constant_type env cb2.const_type in
let cst = Constraint.union cst (Constraint.union cst1 cst2) in
let error = NotConvertibleTypeField (env, ty1, ty2) in
check_conv error cst infer_conv env ty1 ty2