diff options
| author |  herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2003-11-21 22:38:42 +0000 |
|---|---|---|
| committer | herbelin <herbelin@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2003-11-21 22:38:42 +0000 |
| commit | a2b0870c490b851a26dfa6c52c05d5e97bd4cd5a (patch) | |
| tree | 08540ee6305bb7f4f25ebd222fc8b6b8b1b357ca | |
| parent | 1694308b32f091015d3095f84d57312153beb63a (diff) | |
Ajout 'Simpl f'
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@4966 85f007b7-540e-0410-9357-904b9bb8a0f7
| -rw-r--r-- | pretyping/tacred.ml | 11 |
1 files changed, 10 insertions, 1 deletions
diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml index 09f552ba1..c26e9ce05 100644 --- a/pretyping/tacred.ml +++ b/pretyping/tacred.ml @@ -597,6 +597,15 @@ let whd_nf env sigma c = let nf env sigma c = strong whd_nf env sigma c +let is_reference c = + try let r = reference_of_constr c in true with _ -> false + +let is_head c t = + (is_reference c) & + match kind_of_term t with + | App (f,_) -> f = c + | _ -> false + let contextually (locs,c) f env sigma t = let maxocc = List.fold_right max locs 0 in let pos = ref 1 in @@ -608,7 +617,7 @@ let contextually (locs,c) f env sigma t = let rec traverse (env,c as envc) t = if locs <> [] & (not except) & (!pos > maxocc) then t else - if eq_constr c t then + if eq_constr c t or is_head c t then let r = if except then if List.mem (- !pos) locs then t else f env sigma t |