diff options
| author |  Amin Timany <amintimany@gmail.com> | 2017-04-08 16:10:19 +0200 |
|---|---|---|
| committer |  Emilio Jesus Gallego Arias <e+git@x80.org> | 2017-06-16 04:51:16 +0200 |
| commit | 0d884e0852ae388becc5b74c6a8cb30088f7b79b (patch) | |
| tree | 18c4acb789a0a995417d9162a872de6fd9c3ef66 /kernel/reduction.ml | |
| parent | ab86b9b3999f3860bdb69824f585b9cf461ff295 (diff) | |
Fix cum/conv for inductive types
Fall back to the equating levels in case inductive is not fully applied
instead of failing.
Diffstat (limited to 'kernel/reduction.ml')
| -rw-r--r-- | kernel/reduction.ml | 24 |
1 files changed, 14 insertions, 10 deletions
diff --git a/kernel/reduction.ml b/kernel/reduction.ml index 0d2399e02..c8fad60eb 100644 --- a/kernel/reduction.ml +++ b/kernel/reduction.ml @@ -492,24 +492,28 @@ and eqappr env cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv = if eq_ind ind1 ind2 then begin + let fall_back () = + let cuniv = convert_instances ~flex:false u1 u2 cuniv in + convert_stacks env l2r infos lft1 lft2 v1 v2 cuniv + in let mind = Environ.lookup_mind (fst ind1) env in if mind.Declarations.mind_polymorphic then begin let num_param_arity = Context.Rel.length (mind.Declarations.mind_packets.(snd ind1).Declarations.mind_arity_ctxt) in - (if not (num_param_arity = CClosure.stack_args_size v1 && num_param_arity = CClosure.stack_args_size v2) then - raise NotConvertible else ()); - let uinfind = mind.Declarations.mind_universes in - let cuniv = compare_leq_inductives ~flex:false uinfind u1 u2 cuniv in - let cuniv = if cv_pb = CONV then compare_leq_inductives ~flex:false uinfind u2 u1 cuniv else cuniv in - convert_stacks env l2r infos lft1 lft2 v1 v2 cuniv + if not (num_param_arity = CClosure.stack_args_size v1 && num_param_arity = CClosure.stack_args_size v2) then + fall_back () + else + begin + let uinfind = mind.Declarations.mind_universes in + let cuniv = compare_leq_inductives ~flex:false uinfind u1 u2 cuniv in + let cuniv = if cv_pb = CONV then compare_leq_inductives ~flex:false uinfind u2 u1 cuniv else cuniv in + convert_stacks env l2r infos lft1 lft2 v1 v2 cuniv + end end else - begin - let cuniv = convert_instances ~flex:false u1 u2 cuniv in - convert_stacks env l2r infos lft1 lft2 v1 v2 cuniv - end + fall_back () end else raise NotConvertible |