Skip to content

Commit 5aac1de

Browse files
committed
tclCASE use result instead of adhoc type
1 parent a4fc4d1 commit 5aac1de

6 files changed

Lines changed: 11 additions & 19 deletions

File tree

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
overlay tactician https://github.com/SkySkimmer/coq-tactician logic_simpl 22013

engine/profile_tactic.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -379,8 +379,8 @@ let rec tclWRAPFINALLY before tac finally =
379379
let open Proofview in
380380
let open Proofview.Notations in
381381
before >>= fun v -> tclCASE tac >>= function
382-
| Fail (e, info) -> finally v >>= fun () -> tclZERO ~info e
383-
| Next (ret, tac') -> tclOR
382+
| Error (e, info) -> finally v >>= fun () -> tclZERO ~info e
383+
| Ok (ret, tac') -> tclOR
384384
(finally v >>= fun () -> tclUNIT ret)
385385
(fun e -> tclWRAPFINALLY before (tac' e) finally)
386386

engine/proofview.ml

Lines changed: 2 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -341,15 +341,8 @@ let tclEXACTLY_ONCE e t =
341341

342342

343343
(** [tclCASE t] wraps the {!Proofview_monad.Logical.split} primitive. *)
344-
type 'a case =
345-
| Fail of Exninfo.iexn
346-
| Next of 'a * (Exninfo.iexn -> 'a tactic)
347-
let tclCASE t =
348-
let map = function
349-
| Error e -> Fail e
350-
| Ok (x, t) -> Next (x, t)
351-
in
352-
Proof.map map (Proof.split t)
344+
type 'a case = ('a * (Exninfo.iexn -> 'a tactic), Exninfo.iexn) result
345+
let tclCASE = Proof.split
353346

354347
let tclBREAK = Proof.break
355348

engine/proofview.mli

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -229,9 +229,7 @@ val tclEXACTLY_ONCE : exn -> 'a tactic -> 'a tactic
229229
(** [tclCASE t] splits [t] into its first success and a
230230
continuation. It is the most general primitive to control
231231
backtracking. *)
232-
type 'a case =
233-
| Fail of Exninfo.iexn
234-
| Next of 'a * (Exninfo.iexn -> 'a tactic)
232+
type 'a case = ('a * (Exninfo.iexn -> 'a tactic), Exninfo.iexn) result
235233
val tclCASE : 'a tactic -> 'a case tactic
236234

237235
(** [tclBREAK p t] is a generalization of [tclONCE t]. Instead of

plugins/ltac2/tac2core.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1022,10 +1022,10 @@ let () =
10221022
let () =
10231023
define "case" (thunk valexpr @-> tac (result (pair valexpr (fun1 exn valexpr)))) @@ fun f ->
10241024
Proofview.tclCASE (thaw f) >>= begin function
1025-
| Proofview.Next (x, k) ->
1025+
| Ok (x, k) ->
10261026
let k (e,info) = set_bt info >>= fun info -> k (e,info) in
10271027
return (Ok (x, k))
1028-
| Proofview.Fail e -> return (Error e)
1028+
| Error _ as e -> return e
10291029
end
10301030

10311031
let () =

tactics/class_tactics.ml

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -606,7 +606,7 @@ module Search = struct
606606
str " of status " ++ pr_goal_status status)
607607
in
608608
let rec kont = function
609-
| Fail ((NonStuckFailure | StuckGoal as exn), info) when allow_out_of_order ->
609+
| Error ((NonStuckFailure | StuckGoal as exn), info) when allow_out_of_order ->
610610
let () = ppdebug 1 (fun () ->
611611
str "Goal " ++ int glid ++
612612
str" is stuck or failed without being stuck, trying other tactics.")
@@ -619,13 +619,13 @@ module Search = struct
619619
in
620620
cycle 1 (* Puts the first goal last *) <*>
621621
fixpoint progress tacs ((glid, ev, status, tac) :: stuck) fk (* Launches the search on the rest of the goals *)
622-
| Fail ie ->
622+
| Error ie ->
623623
let () = ppdebug 1 (fun () ->
624624
str "Goal " ++ int glid ++ str" has no more solutions, returning exception: "
625625
++ pr_internal_exception ie)
626626
in
627627
fk ie
628-
| Next (res, fk') ->
628+
| Ok (res, fk') ->
629629
let () = ppdebug 1 (fun () ->
630630
str "Goal " ++ int glid ++ str" has a success, continuing resolution")
631631
in

0 commit comments

Comments
 (0)