aboutsummaryrefslogtreecommitdiff
path: root/engine
diff options
context:
space:
mode:
authorPierre-Marie Pédrot2016-09-23 18:56:18 +0200
committerPierre-Marie Pédrot2016-09-23 18:56:18 +0200
commita52d06ea16cff00faa7d2f63ad5c1ca0b58e64b4 (patch)
tree40440d7daed82bd24180b36ef224f245ddca42f5 /engine
parent30a908becf31d91592a1f7934cfa3df2d67d1834 (diff)
parenta321074cdd2f9375662c7c9f17be5c045328bd82 (diff)
Merge branch 'v8.6'
Diffstat (limited to 'engine')
-rw-r--r--engine/proofview.ml20
-rw-r--r--engine/proofview.mli4
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 }