diff options
| author | Pierre-Marie Pédrot | 2016-09-23 18:56:18 +0200 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2016-09-23 18:56:18 +0200 |
| commit | a52d06ea16cff00faa7d2f63ad5c1ca0b58e64b4 (patch) | |
| tree | 40440d7daed82bd24180b36ef224f245ddca42f5 /engine | |
| parent | 30a908becf31d91592a1f7934cfa3df2d67d1834 (diff) | |
| parent | a321074cdd2f9375662c7c9f17be5c045328bd82 (diff) | |
Merge branch 'v8.6'
Diffstat (limited to 'engine')
| -rw-r--r-- | engine/proofview.ml | 20 | ||||
| -rw-r--r-- | engine/proofview.mli | 4 |
2 files changed, 24 insertions, 0 deletions
diff --git a/engine/proofview.ml b/engine/proofview.ml index 51b3a7260a..1ebc857d85 100644 --- a/engine/proofview.ml +++ b/engine/proofview.ml @@ -1058,6 +1058,26 @@ module Goal = struct end end + exception NotExactlyOneSubgoal + let _ = CErrors.register_handler begin function + | NotExactlyOneSubgoal -> + CErrors.user_err (Pp.str"Not exactly one subgoal.") + | _ -> raise CErrors.Unhandled + end + + let enter_one f = + let open Proof in + Comb.get >>= function + | [goal] -> begin + Env.get >>= fun env -> + tclEVARMAP >>= fun sigma -> + try f.enter (gmake env sigma goal) + with e when catchable_exception e -> + let (e, info) = CErrors.push e in + tclZERO ~info e + end + | _ -> tclZERO NotExactlyOneSubgoal + type ('a, 'b) s_enter = { s_enter : 'r. ('a, 'r) t -> ('b, 'r) Sigma.sigma } diff --git a/engine/proofview.mli b/engine/proofview.mli index 901cf26e0e..bc68f11ff0 100644 --- a/engine/proofview.mli +++ b/engine/proofview.mli @@ -499,6 +499,10 @@ module Goal : sig (** Like {!nf_enter}, but does not normalize the goal beforehand. *) val enter : ([ `LZ ], unit tactic) enter -> unit tactic + (** Like {!enter}, but assumes exactly one goal under focus, raising *) + (** an error otherwise. *) + val enter_one : ([ `LZ ], 'a tactic) enter -> 'a tactic + type ('a, 'b) s_enter = { s_enter : 'r. ('a, 'r) t -> ('b, 'r) Sigma.sigma } |
