diff options
| author | Arnaud Spiwack | 2016-10-10 10:53:51 +0200 |
|---|---|---|
| committer | Maxime Dénès | 2016-10-10 11:05:22 +0200 |
| commit | c70fe0c63238128a6bb98b9fa75445c4b71c7af5 (patch) | |
| tree | e8a0897676d8dc4cefc6e9d4d8f0166fe6a1366b /tactics | |
| parent | eb87cdaeb252d758b6a76b36867254823169576b (diff) | |
Fix #4416: - Incorrect "Error: Incorrect number of goals"
In `Ftactic` the number of results could desynchronise with the number
of goals when some goals were solved by side effect in a different
branch of a `DISPATCH`.
See [coq-bugs#4416](https://coq.inria.fr/bugs/show_bug.cgi?id=4416).
Diffstat (limited to 'tactics')
| -rw-r--r-- | tactics/ftactic.ml | 23 |
1 files changed, 19 insertions, 4 deletions
diff --git a/tactics/ftactic.ml b/tactics/ftactic.ml index 8e42dcba74..418dacb48b 100644 --- a/tactics/ftactic.ml +++ b/tactics/ftactic.ml @@ -29,13 +29,28 @@ let bind (type a) (type b) (m : a t) (f : a -> b t) : b t = m >>= function | Uniform x -> (** We dispatch the uniform result on each goal under focus, as we know that the [m] argument was actually dependent. *) - Proofview.Goal.goals >>= fun l -> - let ans = List.map (fun _ -> x) l in + Proofview.Goal.goals >>= fun goals -> + let ans = List.map (fun g -> (g,x)) goals in Proofview.tclUNIT ans - | Depends l -> Proofview.tclUNIT l + | Depends l -> + Proofview.Goal.goals >>= fun goals -> + Proofview.tclUNIT (List.combine goals l) + in + (* After the tactic has run, some goals which were previously + produced may have been solved by side effects. The values + attached to such goals must be discarded, otherwise the list of + result would not have the same length as the list of focused + goals, which is an invariant of the [Ftactic] module. It is the + reason why a goal is attached to each result above. *) + let filter (g,x) = + g >>= fun g -> + Proofview.Goal.unsolved g >>= function + | true -> Proofview.tclUNIT (Some x) + | false -> Proofview.tclUNIT None in Proofview.tclDISPATCHL (List.map f l) >>= fun l -> - Proofview.tclUNIT (Depends (List.concat l)) + Proofview.Monad.List.map_filter filter (List.concat l) >>= fun filtered -> + Proofview.tclUNIT (Depends filtered) let nf_enter f = bind (Proofview.Goal.goals >>= fun l -> Proofview.tclUNIT (Depends l)) |
