diff options
author | herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2009-12-24 11:05:43 +0000 |
---|---|---|
committer | herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2009-12-24 11:05:43 +0000 |
commit | fdad03c5c247ab6cfdde8fd58658d9e40a3fd8aa (patch) | |
tree | b5a8aad89c9ea0a19d05be81d94e4a8d53c4ffe2 /proofs/redexpr.ml | |
parent | 3c3bbccb00cb1c13c28a052488fc2c5311d47298 (diff) |
In "simpl c" and "change c with d", c can be a pattern.
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@12608 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'proofs/redexpr.ml')
-rw-r--r-- | proofs/redexpr.ml | 11 |
1 files changed, 6 insertions, 5 deletions
diff --git a/proofs/redexpr.ml b/proofs/redexpr.ml index 287794bff..fa6a6f3ec 100644 --- a/proofs/redexpr.ml +++ b/proofs/redexpr.ml @@ -15,6 +15,7 @@ open Term open Declarations open Libnames open Rawterm +open Pattern open Reductionops open Tacred open Closure @@ -106,8 +107,8 @@ let _ = (* Generic reduction: reduction functions used in reduction tactics *) -type red_expr = (constr, evaluable_global_reference) red_expr_gen - +type red_expr = + (constr, evaluable_global_reference, constr_pattern) red_expr_gen let make_flag_constant = function | EvalVarRef id -> fVAR id @@ -132,8 +133,7 @@ let make_flag f = f.rConst red in red -let is_reference c = - try let _ref = global_of_constr c in true with _ -> false +let is_reference = function PRef _ | PVar _ -> true | _ -> false let red_expr_tab = ref Stringmap.empty @@ -157,7 +157,8 @@ let reduction_of_red_expr = function else (red_product,DEFAULTcast) | Hnf -> (hnf_constr,DEFAULTcast) | Simpl (Some (_,c as lp)) -> - (contextually (is_reference c) (out_with_occurrences lp) simpl,DEFAULTcast) + (contextually (is_reference c) (out_with_occurrences lp) + (fun _ -> simpl),DEFAULTcast) | Simpl None -> (simpl,DEFAULTcast) | Cbv f -> (cbv_norm_flags (make_flag f),DEFAULTcast) | Lazy f -> (clos_norm_flags (make_flag f),DEFAULTcast) |