diff options
| author | barras | 2001-06-29 08:16:09 +0000 |
|---|---|---|
| committer | barras | 2001-06-29 08:16:09 +0000 |
| commit | 1b20fdfdf7f9ab6a92494c413c919635101e7f34 (patch) | |
| tree | af7414e8df67d28ab52f914627d12f91f8af5707 | |
| parent | 9816d0201e8c72fb469706dd8739bec424a8ba5c (diff) | |
traitement du let dans red_product (tactique Red)
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@1815 85f007b7-540e-0410-9357-904b9bb8a0f7
| -rw-r--r-- | pretyping/tacred.ml | 8 | ||||
| -rw-r--r-- | tactics/tactics.ml | 2 |
2 files changed, 6 insertions, 4 deletions
diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml index f3f010e5e7..8523752d29 100644 --- a/pretyping/tacred.ml +++ b/pretyping/tacred.ml @@ -403,17 +403,19 @@ and construct_const env sigma = (* Red reduction tactic: reduction to a product *) let internal_red_product env sigma c = + let simpfun = clos_norm_flags (UNIFORM,betaiotazeta_red) env sigma in let rec redrec env x = match kind_of_term x with - | IsApp (f,l) -> appvect (redrec env f, l) + | IsApp (f,l) -> simpfun (appvect (redrec env f, l)) | IsCast (c,_) -> redrec env c | IsProd (x,a,b) -> mkProd (x, a, redrec (push_rel_assum (x,a) env) b) + | IsLetIn (x,a,b,t) -> redrec env (subst1 a t) | _ when isEvalRef x -> (match reference_opt_value sigma env (destEvalRef x) with | None -> raise Redelimination - | Some c -> c) + | Some c -> simpfun c) | _ -> raise Redelimination - in nf_betaiota (redrec env c) + in redrec env c let red_product env sigma c = try internal_red_product env sigma c diff --git a/tactics/tactics.ml b/tactics/tactics.ml index 7b441e1f49..bb34e96dec 100644 --- a/tactics/tactics.ml +++ b/tactics/tactics.ml @@ -493,7 +493,7 @@ let apply_with_bindings (c,lbind) gl = try let clause = make_clenv_binding_apply wc (c,thm_ty) lbind in apply kONT clause gl - with (Logic.RefinerError _|UserError _) as exn -> + with (RefinerError _|UserError _|Failure _) as exn -> let ored = try Some (Tacred.red_product (w_env wc) (w_Underlying wc) thm_ty) with Tacred.Redelimination -> None |