diff options
author | msozeau <msozeau@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2009-06-29 16:11:26 +0000 |
---|---|---|
committer | msozeau <msozeau@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2009-06-29 16:11:26 +0000 |
commit | 54723df2707b84d90ff6ca3c4285122405a39f6b (patch) | |
tree | ca03bb3eb06377a761cb32bd1c9bd326b4ff0e36 /plugins/subtac | |
parent | 03ad47cbbf7b2456c937ffd3ebf6e0193e3868b2 (diff) |
Fix bug introduced by last revision, subtac_cases was returning the
wrong tycon.
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@12216 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'plugins/subtac')
-rw-r--r-- | plugins/subtac/subtac_cases.ml | 9 |
1 files changed, 5 insertions, 4 deletions
diff --git a/plugins/subtac/subtac_cases.ml b/plugins/subtac/subtac_cases.ml index 2aa2b841c..5f2cb601b 100644 --- a/plugins/subtac/subtac_cases.ml +++ b/plugins/subtac/subtac_cases.ml @@ -1788,7 +1788,7 @@ let abstract_tomatch env tomatchs tycon = (mkRel 1, lift_tomatch_type (succ lenctx) t) :: lift_ctx 1 prev, (Name name, Some (lift lenctx c), lift lenctx $ type_of_tomatch t) :: ctx, name :: names, tycon) - ([], [], [], valcon_of_tycon tycon) tomatchs + ([], [], [], tycon) tomatchs in List.rev prev, ctx, tycon let is_dependent_ind = function @@ -1932,7 +1932,8 @@ let compile_cases loc style (typing_fun, isevars) (tycon : Evarutil.type_constra let tomatchs = coerce_to_indtype typing_fun isevars env matx tomatchl in let _isdep = List.exists (fun (x, y) -> is_dependent_ind y) tomatchs in if predopt = None then - let tomatchs, tomatchs_lets, tycon = abstract_tomatch env tomatchs tycon in + let tycon = valcon_of_tycon tycon in + let tomatchs, tomatchs_lets, tycon' = abstract_tomatch env tomatchs tycon in let env = push_rel_context tomatchs_lets env in let len = List.length eqns in let sign, allnames, signlen, eqs, neqs, args = @@ -1945,10 +1946,10 @@ let compile_cases loc style (typing_fun, isevars) (tycon : Evarutil.type_constra in let tycon, arity = - match tycon with + match tycon' with | None -> let ev = mkExistential env isevars in ev, ev | Some t -> - t, prepare_predicate_from_arsign_tycon loc env ( !isevars) + Option.get tycon, prepare_predicate_from_arsign_tycon loc env ( !isevars) tomatchs sign t in let neqs, arity = |