Skip to content

Commit

Permalink
[coq] Enable backtraces on anomaly
Browse files Browse the repository at this point in the history
This means we will re-execute the anomaly sentence, which may not be
very safe.

Fixes #153
  • Loading branch information
ejgallego committed Jan 20, 2023
1 parent 6fafb3d commit da4399c
Show file tree
Hide file tree
Showing 2 changed files with 22 additions and 6 deletions.
3 changes: 3 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,9 @@
- Support for OCaml 4.11 (@ejgallego, #184)
- The keybinding alt+enter in VSCode is now correctly scoped
(@artagnon, #188)
- If a command produces an anomaly, coq-lsp will re-execute it with
backtracks enabled, as to produce a report (@ejgallego, #161, fixes
#153)

# coq-lsp 0.1.3: Event
----------------------
Expand Down
25 changes: 19 additions & 6 deletions coq/protect.ml
Original file line number Diff line number Diff line change
Expand Up @@ -30,18 +30,31 @@ module R = struct
end

(* Eval and reify exceptions *)
let eval_exn ~f x =
let rec eval_exn ~f ~loop x =
try
let res = f x in
R.Completed (Ok res)
with
| Sys.Break -> R.Interrupted
| exn ->
let e, info = Exninfo.capture exn in
let exn, info = Exninfo.capture exn in
let loc = Loc.(get_loc info) in
let msg = CErrors.iprint (e, info) in
if CErrors.is_anomaly e then R.Completed (Error (Anomaly (loc, msg)))
else R.Completed (Error (User (loc, msg)))
let msg = CErrors.iprint (exn, info) in
let anomaly = CErrors.is_anomaly exn in
let bt = Printexc.backtrace_status () in
match anomaly, bt, loop with
| true, true, _
| true, false, false ->
R.Completed (Error (Anomaly (loc, msg)))
| true, false, true ->
(* This doesn't work because the state unfreeze will restore the
"no-backtrace" status *)
CDebug.set_flags "backtrace";
let res = eval_exn ~f ~loop:false x in
CDebug.set_flags "-backtrace";
res
| false, _, _ ->
R.Completed (Error (User (loc, msg)))

module E = struct
type 'a t =
Expand All @@ -60,7 +73,7 @@ let fb_queue : Message.t list ref = ref []

(* Eval with reified exceptions and feedback *)
let eval ~f x =
let r = eval_exn ~f x in
let r = eval_exn ~loop:true ~f x in
let feedback = List.rev !fb_queue in
let () = fb_queue := [] in
{ E.r; feedback }

0 comments on commit da4399c

Please sign in to comment.