diff options
author | ppedrot <ppedrot@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2013-02-24 20:29:34 +0000 |
---|---|---|
committer | ppedrot <ppedrot@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2013-02-24 20:29:34 +0000 |
commit | 6a82049c393f851b76d53f163cf20e6e872de30d (patch) | |
tree | 3fe99bae3a0987c210e3b8c82efd4704f2d47596 /kernel | |
parent | 7321065b6dc1a2bba4dbb39d0570da3c62b30cfb (diff) |
Fixing bug #2466
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@16241 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'kernel')
-rw-r--r-- | kernel/modops.ml | 2 | ||||
-rw-r--r-- | kernel/modops.mli | 3 | ||||
-rw-r--r-- | kernel/subtyping.ml | 12 |
3 files changed, 11 insertions, 6 deletions
diff --git a/kernel/modops.ml b/kernel/modops.ml index 48ce47bd4..d07bacdf0 100644 --- a/kernel/modops.ml +++ b/kernel/modops.ml @@ -32,7 +32,7 @@ type signature_mismatch_error = | NotConvertibleInductiveField of Id.t | NotConvertibleConstructorField of Id.t | NotConvertibleBodyField - | NotConvertibleTypeField + | NotConvertibleTypeField of types * types | NotSameConstructorNamesField | NotSameInductiveNameInBlockField | FiniteInductiveFieldExpected of bool diff --git a/kernel/modops.mli b/kernel/modops.mli index cfd839456..600e631a7 100644 --- a/kernel/modops.mli +++ b/kernel/modops.mli @@ -8,6 +8,7 @@ open Names open Univ +open Term open Environ open Declarations open Entries @@ -59,7 +60,7 @@ type signature_mismatch_error = | NotConvertibleInductiveField of Id.t | NotConvertibleConstructorField of Id.t | NotConvertibleBodyField - | NotConvertibleTypeField + | NotConvertibleTypeField of types * types | NotSameConstructorNamesField | NotSameInductiveNameInBlockField | FiniteInductiveFieldExpected of bool diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml index 9e9d5b580..138463d6b 100644 --- a/kernel/subtyping.ml +++ b/kernel/subtyping.ml @@ -217,6 +217,8 @@ let check_constant cst env mp1 l info1 cb2 spec2 subst1 subst2 = let check_conv cst f = check_conv_error error cst f in let check_type cst env t1 t2 = + let err = NotConvertibleTypeField (t1, t2) in + (* If the type of a constant is generated, it may mention non-variable algebraic universes that the general conversion algorithm is not ready to handle. Anyway, generated types of @@ -255,12 +257,12 @@ let check_constant cst env mp1 l info1 cb2 spec2 subst1 subst2 = (the user has to use an explicit type in the interface *) error NoTypeConstraintExpected with NotArity -> - error NotConvertibleTypeField end + error err end | _ -> t1,t2 else (t1,t2) in - check_conv NotConvertibleTypeField cst conv_leq env t1 t2 + check_conv err cst conv_leq env t1 t2 in match info1 with @@ -299,7 +301,8 @@ let check_constant cst env mp1 l info1 cb2 spec2 subst1 subst2 = if constant_has_body cb2 then error DefinitionFieldExpected; let arity1 = type_of_inductive env (mind1,mind1.mind_packets.(i)) in let typ2 = Typeops.type_of_constant_type env cb2.const_type in - check_conv NotConvertibleTypeField cst conv_leq env arity1 typ2 + let error = NotConvertibleTypeField (arity1, typ2) in + check_conv error cst conv_leq env arity1 typ2 | IndConstr (((kn,i),j) as cstr,mind1) -> ignore (Errors.error ( "The kernel does not recognize yet that a parameter can be " ^ @@ -310,7 +313,8 @@ let check_constant cst env mp1 l info1 cb2 spec2 subst1 subst2 = if constant_has_body cb2 then error DefinitionFieldExpected; let ty1 = type_of_constructor cstr (mind1,mind1.mind_packets.(i)) in let ty2 = Typeops.type_of_constant_type env cb2.const_type in - check_conv NotConvertibleTypeField cst conv env ty1 ty2 + let error = NotConvertibleTypeField (ty1, ty2) in + check_conv error cst conv env ty1 ty2 let rec check_modules cst env msb1 msb2 subst1 subst2 = let mty1 = module_type_of_module None msb1 in |