diff options
| author | herbelin | 2010-09-20 21:59:57 +0000 |
|---|---|---|
| committer | herbelin | 2010-09-20 21:59:57 +0000 |
| commit | 86002ce6e6fb3cbf1f5c9bf3657c13b4e79be192 (patch) | |
| tree | 2f0bd93dcc2a7c8a96b3a03208a1b0a4558ea2f1 /pretyping/unification.ml | |
| parent | e22907304afd393f527b70c2a11d00c6abd2efb0 (diff) | |
Added eta-expansion in kernel, type inference and tactic unification,
governed in the latter case by a flag since (useful e.g. for setoid
rewriting which otherwise loops as it is implemented).
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@13443 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'pretyping/unification.ml')
| -rw-r--r-- | pretyping/unification.ml | 13 |
1 files changed, 12 insertions, 1 deletions
diff --git a/pretyping/unification.ml b/pretyping/unification.ml index 5b8fc591ee..b45d23098a 100644 --- a/pretyping/unification.ml +++ b/pretyping/unification.ml @@ -169,7 +169,8 @@ type unify_flags = { use_metas_eagerly : bool; modulo_delta : Names.transparent_state; resolve_evars : bool; - use_evars_pattern_unification : bool + use_evars_pattern_unification : bool; + modulo_eta : bool } let default_unify_flags = { @@ -178,6 +179,7 @@ let default_unify_flags = { modulo_delta = full_transparent_state; resolve_evars = false; use_evars_pattern_unification = true; + modulo_eta = true } let default_no_delta_unify_flags = { @@ -186,6 +188,7 @@ let default_no_delta_unify_flags = { modulo_delta = empty_transparent_state; resolve_evars = false; use_evars_pattern_unification = false; + modulo_eta = true } let use_evars_pattern_unification flags = @@ -259,6 +262,14 @@ let unify_0_with_initial_metas (sigma,ms,es as subst) conv_at_top env cv_pb flag | LetIn (_,a,_,c), _ -> unirec_rec curenvnb pb b substn (subst1 a c) cN | _, LetIn (_,a,_,c) -> unirec_rec curenvnb pb b substn cM (subst1 a c) + (* eta-expansion *) + | Lambda (na,t1,c1), _ when flags.modulo_eta -> + unirec_rec (push (na,t1) curenvnb) topconv true substn + c1 (mkApp (lift 1 cN,[|mkRel 1|])) + | _, Lambda (na,t2,c2) when flags.modulo_eta -> + unirec_rec (push (na,t2) curenvnb) topconv true substn + (mkApp (lift 1 cM,[|mkRel 1|])) c2 + | Case (_,p1,c1,cl1), Case (_,p2,c2,cl2) -> array_fold_left2 (unirec_rec curenvnb topconv true) (unirec_rec curenvnb topconv true |