diff options
| author |  Maxime Dénès <mail@maximedenes.fr> | 2018-04-16 15:46:19 +0200 |
|---|---|---|
| committer | Maxime Dénès <mail@maximedenes.fr> | 2018-04-16 15:46:19 +0200 |
| commit | 78c0fa183b906aec84bd2e393de0233008b308c4 (patch) | |
| tree | 23cf070d0d199d0a474c6b36262dcc22d0b30548 /plugins/ssr | |
| parent | d4d33ecae807deb850c4da187359f46892e90b64 (diff) | |
| parent | f6b297b4c068adadf86e77da533782852cfae373 (diff) | |
Merge PR #7237: [ssr] fix delayed clears (fix #7045)
Diffstat (limited to 'plugins/ssr')
| -rw-r--r-- | plugins/ssr/ssrcommon.ml | 7 | ||||
| -rw-r--r-- | plugins/ssr/ssripats.ml | 19 |
2 files changed, 15 insertions, 11 deletions
diff --git a/plugins/ssr/ssrcommon.ml b/plugins/ssr/ssrcommon.ml index 06c26edbe..d012fd0df 100644 --- a/plugins/ssr/ssrcommon.ml +++ b/plugins/ssr/ssrcommon.ml @@ -802,8 +802,11 @@ let rec is_name_in_ipats name = function List.exists (function SsrHyp(_,id) -> id = name) clr || is_name_in_ipats name tl | IPatId id :: tl -> id = name || is_name_in_ipats name tl - | (IPatCase l | IPatDispatch l) :: tl -> List.exists (is_name_in_ipats name) l || is_name_in_ipats name tl - | _ :: tl -> is_name_in_ipats name tl + | IPatAbstractVars ids :: tl -> + CList.mem_f Id.equal name ids || is_name_in_ipats name tl + | (IPatCase l | IPatDispatch l | IPatInj l) :: tl -> + List.exists (is_name_in_ipats name) l || is_name_in_ipats name tl + | (IPatView _ | IPatAnon _ | IPatSimpl _ | IPatRewrite _ | IPatTac _ | IPatNoop) :: tl -> is_name_in_ipats name tl | [] -> false let view_error s gv = diff --git a/plugins/ssr/ssripats.ml b/plugins/ssr/ssripats.ml index 6b7a96deb..b397c5531 100644 --- a/plugins/ssr/ssripats.ml +++ b/plugins/ssr/ssripats.ml @@ -218,15 +218,16 @@ let rec ipat_tac1 future_ipats ipat : unit tactic = Ssrview.tclIPAT_VIEWS ~views:l ~conclusion:(fun ~to_clear:clr -> intro_clear clr future_ipats) | IPatDispatch ipatss -> - tclEXTEND (List.map ipat_tac ipatss) (tclUNIT ()) [] + tclEXTEND (List.map (ipat_tac future_ipats) ipatss) (tclUNIT ()) [] | IPatId id -> Ssrcommon.tclINTRO_ID id | IPatCase ipatss -> - tclIORPAT (Ssrcommon.tclWITHTOP tac_case) ipatss + tclIORPAT (Ssrcommon.tclWITHTOP tac_case) future_ipats ipatss | IPatInj ipatss -> tclIORPAT (Ssrcommon.tclWITHTOP - (fun t -> V82.tactic ~nf_evars:false (Ssrelim.perform_injection t))) ipatss + (fun t -> V82.tactic ~nf_evars:false (Ssrelim.perform_injection t))) + future_ipats ipatss | IPatAnon Drop -> intro_drop | IPatAnon One -> Ssrcommon.tclINTRO_ANON @@ -254,17 +255,17 @@ let rec ipat_tac1 future_ipats ipat : unit tactic = | IPatTac t -> t -and ipat_tac pl : unit tactic = +and ipat_tac future_ipats pl : unit tactic = match pl with | [] -> tclUNIT () | pat :: pl -> - Ssrcommon.tcl0G (tclLOG pat (ipat_tac1 pl)) <*> + Ssrcommon.tcl0G (tclLOG pat (ipat_tac1 (pl @ future_ipats))) <*> isTICK pat <*> - ipat_tac pl + ipat_tac future_ipats pl -and tclIORPAT tac = function +and tclIORPAT tac future_ipats = function | [[]] -> tac - | p -> Tacticals.New.tclTHENS tac (List.map ipat_tac p) + | p -> Tacticals.New.tclTHENS tac (List.map (ipat_tac future_ipats) p) let split_at_first_case ipats = let rec loop acc = function @@ -285,7 +286,7 @@ let main ?eqtac ~first_case_is_dispatch ipats = let case = ssr_exception first_case_is_dispatch case in let case = option_to_list case in let eqtac = option_to_list (Option.map (fun x -> IPatTac x) eqtac) in - Ssrcommon.tcl0G (ipat_tac (ip_before @ case @ eqtac @ ip_after) <*> intro_end) + Ssrcommon.tcl0G (ipat_tac [] (ip_before @ case @ eqtac @ ip_after) <*> intro_end) end (* }}} *) |