diff options
| author | Matthieu Sozeau | 2014-10-24 17:38:59 +0200 |
|---|---|---|
| committer | Matthieu Sozeau | 2014-10-24 17:42:14 +0200 |
| commit | 884b6cc6c12bd557085cdaa4972d593684c9cc1a (patch) | |
| tree | f3ba143e41d8d053d4369ffcba7ae294b001beb5 /pretyping | |
| parent | 1556c6b8f77d16814ff1c53fb14fc9b06574ec4b (diff) | |
Change reduction_of_red_expr to return an e_reduction_function returning
an updated evar_map, as pattern is working up to universe equalities
that must be kept. Straightforward adaptation of the code depending on
this.
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/tacred.ml | 10 | ||||
| -rw-r--r-- | pretyping/tacred.mli | 2 |
2 files changed, 6 insertions, 6 deletions
diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml index 150ff93ceb..b2938cb99f 100644 --- a/pretyping/tacred.ml +++ b/pretyping/tacred.ml @@ -1124,21 +1124,21 @@ let compute = cbv_betadeltaiota (* gives [na:ta]c' such that c converts to ([na:ta]c' a), abstracting only * the specified occurrences. *) -let abstract_scheme env sigma (locc,a) c = +let abstract_scheme env (locc,a) (c, sigma) = let ta = Retyping.get_type_of env sigma a in let na = named_hd env ta Anonymous in if occur_meta ta then error "Cannot find a type for the generalisation."; if occur_meta a then - mkLambda (na,ta,c) + mkLambda (na,ta,c), sigma else let c', sigma' = subst_closed_term_occ env sigma locc a c in - mkLambda (na,ta,c') + mkLambda (na,ta,c'), sigma' let pattern_occs loccs_trm env sigma c = - let abstr_trm = List.fold_right (abstract_scheme env sigma) loccs_trm c in + let abstr_trm, sigma = List.fold_right (abstract_scheme env) loccs_trm (c,sigma) in try let _ = Typing.type_of env sigma abstr_trm in - applist(abstr_trm, List.map snd loccs_trm) + sigma, applist(abstr_trm, List.map snd loccs_trm) with Type_errors.TypeError (env',t) -> raise (ReductionTacticError (InvalidAbstraction (env,sigma,abstr_trm,(env',t)))) diff --git a/pretyping/tacred.mli b/pretyping/tacred.mli index db59787a11..6e0479fb14 100644 --- a/pretyping/tacred.mli +++ b/pretyping/tacred.mli @@ -62,7 +62,7 @@ val fold_commands : constr list -> reduction_function (** Pattern *) val pattern_occs : (occurrences * constr) list -> env -> evar_map -> constr -> - constr + evar_map * constr (** Rem: Lazy strategies are defined in Reduction *) |