aboutsummaryrefslogtreecommitdiff
path: root/interp
diff options
context:
space:
mode:
authorHugo Herbelin2016-04-19 19:13:23 +0200
committerHugo Herbelin2016-04-19 19:40:13 +0200
commit75a48bfc6b91f1e5095d9cdfbcc0ae2bf8cf16ec (patch)
tree3954479b911b7681255764be0bcb13d72f52e8bd /interp
parentb038ff00e3d1873bed580c13df1b18ce0510abb2 (diff)
Fixing #4677 (collision of a global variable and of a local variable
while eta-expanding a notation) + a more serious variant of it (alpha-conversion incorrect wrt eta-expansion).
Diffstat (limited to 'interp')
-rw-r--r--interp/notation_ops.ml14
1 files changed, 10 insertions, 4 deletions
diff --git a/interp/notation_ops.ml b/interp/notation_ops.ml
index 51dfadac02..5abc7794bd 100644
--- a/interp/notation_ops.ml
+++ b/interp/notation_ops.ml
@@ -794,15 +794,21 @@ let rec match_ inner u alp (tmetas,blmetas as metas) sigma a1 a2 =
otherwise how to ensure it corresponds to a well-typed eta-expansion;
we make an exception for types which are metavariables: this is useful e.g.
to print "{x:_ & P x}" knowing that notation "{x & P x}" is not defined. *)
- | b1, NLambda (Name id,(NHole _ | NVar _ as t2),b2) when inner ->
- let id' = Namegen.next_ident_away id (free_glob_vars b1) in
+ | b1, NLambda (Name id as na,(NHole _ | NVar _ as t2),b2) when inner ->
+ let avoid =
+ free_glob_vars b1 @ (* as in Namegen: *) glob_visible_short_qualid b1 in
+ let id' = Namegen.next_ident_away id avoid in
let t1 = GHole(Loc.ghost,Evar_kinds.BinderType (Name id'),Misctypes.IntroAnonymous,None) in
let sigma = match t2 with
| NHole _ -> sigma
| NVar id2 -> bind_env alp sigma id2 t1
| _ -> assert false in
- match_in u alp metas (bind_binder sigma id [(Name id',Explicit,None,t1)])
- (mkGApp Loc.ghost b1 (GVar (Loc.ghost,id'))) b2
+ let (alp,sigma) =
+ if Id.List.mem id blmetas then
+ alp, bind_binder sigma id [(Name id',Explicit,None,t1)]
+ else
+ match_names metas (alp,sigma) (Name id') na in
+ match_in u alp metas sigma (mkGApp Loc.ghost b1 (GVar (Loc.ghost,id'))) b2
| (GRec _ | GEvar _), _
| _,_ -> raise No_match