aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Herbelin2020-10-29 16:49:41 +0100
committerHugo Herbelin2020-10-31 16:24:42 +0100
commit391898b6bd83a80ec7f7bd4ac2b9d20874f76773 (patch)
tree871ba08a4f3194ded70d038bc1f6cdf91daf0dc4
parent473160ebe4a835dde50d6c209ab17c7e1b84979c (diff)
Useless evar type for typing impossible case.
-rw-r--r--pretyping/cases.ml21
1 files changed, 10 insertions, 11 deletions
diff --git a/pretyping/cases.ml b/pretyping/cases.ml
index 4a29db0dcf..d9a67d2b12 100644
--- a/pretyping/cases.ml
+++ b/pretyping/cases.ml
@@ -1784,25 +1784,24 @@ let abstract_tycon ?loc env sigma subst tycon extenv t =
!evdref, ans
let build_tycon ?loc env tycon_env s subst tycon extenv sigma t =
- let sigma, t, tt = match t with
+ let s = mkSort s in
+ match t with
| None ->
(* This is the situation we are building a return predicate and
we are in an impossible branch *)
let n = Context.Rel.length (rel_context !!env) in
let n' = Context.Rel.length (rel_context !!tycon_env) in
- let sigma, (impossible_case_type, u) =
- Evarutil.new_type_evar (reset_context !!env) ~src:(Loc.tag ?loc Evar_kinds.ImpossibleCase)
- sigma univ_flexible_alg
- in
- (sigma, lift (n'-n) impossible_case_type, mkSort u)
+ let src = Loc.tag ?loc Evar_kinds.ImpossibleCase in
+ let sigma, impossible_case_type =
+ Evarutil.new_evar (reset_context !!env) sigma ~src ~typeclass_candidate:false s in
+ (sigma, { uj_val = lift (n'-n) impossible_case_type; uj_type = s })
| Some t ->
let sigma, t = abstract_tycon ?loc tycon_env sigma subst tycon extenv t in
let sigma, tt = Typing.type_of !!extenv sigma t in
- (sigma, t, tt) in
- match unify_leq_delay !!env sigma tt (mkSort s) with
- | exception Evarconv.UnableToUnify _ -> anomaly (Pp.str "Build_tycon: should be a type.");
- | sigma ->
- sigma, { uj_val = t; uj_type = tt }
+ match unify_leq_delay !!env sigma tt s with
+ | exception Evarconv.UnableToUnify _ -> anomaly (Pp.str "Build_tycon: should be a type.");
+ | sigma -> (sigma, { uj_val = t; uj_type = tt })
+
(* For a multiple pattern-matching problem Xi on t1..tn with return
* type T, [build_inversion_problem Gamma Sigma (t1..tn) T] builds a return