diff options
| author |  Hugo Herbelin <Hugo.Herbelin@inria.fr> | 2017-08-21 23:01:04 +0200 |
|---|---|---|
| committer | Hugo Herbelin <Hugo.Herbelin@inria.fr> | 2018-02-20 10:03:06 +0100 |
| commit | 50970e4043d73d9a4fbd17ffe765745f6d726317 (patch) | |
| tree | 30af940838c330d2b50a2da6c669667c23dfc7fc /interp | |
| parent | 15abe33f55b317410223bd48576fa35c81943ff9 (diff) | |
Using an "as" clause when needed for printing irrefutable patterns.
Example which is now reprinted as parsed:
fun '((x,y) as z) => (y,x)=z
Diffstat (limited to 'interp')
| -rw-r--r-- | interp/constrextern.ml | 6 | ||||
| -rw-r--r-- | interp/notation_ops.ml | 6 |
2 files changed, 8 insertions, 4 deletions
diff --git a/interp/constrextern.ml b/interp/constrextern.ml index 013f5713e..67e19d125 100644 --- a/interp/constrextern.ml +++ b/interp/constrextern.ml @@ -924,7 +924,8 @@ and sub_extern inctx (_,scopes) = extern inctx (None,scopes) and factorize_prod scopes vars na bk aty c = match na, DAst.get c with | Name id, GCases (LetPatternStyle, None, [(e,(Anonymous,None))],[(_,(_,[p],b))]) - when is_gvar id e && not (occur_glob_constr id b) -> + when is_gvar id e -> + let p = if occur_glob_constr id b then set_pat_alias id p else p in let b = extern_typ scopes vars b in let p = extern_cases_pattern_in_scope scopes vars p in let binder = CLocalPattern (c.loc,(p,None)) in @@ -946,7 +947,8 @@ and factorize_prod scopes vars na bk aty c = and factorize_lambda inctx scopes vars na bk aty c = match na, DAst.get c with | Name id, GCases (LetPatternStyle, None, [(e,(Anonymous,None))],[(_,(_,[p],b))]) - when is_gvar id e && not (occur_glob_constr id b) -> + when is_gvar id e -> + let p = if occur_glob_constr id b then set_pat_alias id p else p in let b = sub_extern inctx scopes vars b in let p = extern_cases_pattern_in_scope scopes vars p in let binder = CLocalPattern (c.loc,(p,None)) in diff --git a/interp/notation_ops.ml b/interp/notation_ops.ml index 5fe12e570..c44863791 100644 --- a/interp/notation_ops.ml +++ b/interp/notation_ops.ml @@ -1208,11 +1208,13 @@ and match_extended_binders ?loc isprod u alp metas na1 na2 bk t sigma b1 b2 = match na1, DAst.get b1, na2 with (* Matching individual binders as part of a recursive pattern *) | Name p, GCases (LetPatternStyle,None,[(e,_)],[(_,(ids,[cp],b1))]), Name id - when is_gvar p e && is_bindinglist_meta id metas && not (occur_glob_constr p b1) -> + when is_gvar p e && is_bindinglist_meta id metas -> + let cp = if occur_glob_constr p b1 then set_pat_alias p cp else cp in let alp,sigma = bind_bindinglist_env alp sigma id [DAst.make ?loc @@ GLocalPattern ((cp,ids),p,bk,t)] in match_in u alp metas sigma b1 b2 | Name p, GCases (LetPatternStyle,None,[(e,_)],[(_,(_,[cp],b1))]), Name id - when is_gvar p e && is_onlybinding_pattern_like_meta id metas && not (occur_glob_constr p b1) -> + when is_gvar p e && is_onlybinding_pattern_like_meta id metas -> + let cp = if occur_glob_constr p b1 then set_pat_alias p cp else cp in let alp,sigma = bind_binding_env alp sigma id cp in match_in u alp metas sigma b1 b2 | _, _, Name id when is_bindinglist_meta id metas && (not isprod || na1 != Anonymous)-> |