From 2857b1a7390527e59975eb51e5d5f2d16037d704 Mon Sep 17 00:00:00 2001 From: Steven de Oliveira Date: Thu, 28 Sep 2023 17:02:32 +0200 Subject: [PATCH 1/4] Fix error handling of dolmen --- src/bin/common/solving_loop.ml | 3 +++ src/lib/frontend/d_loop.ml | 26 +++++++++++++++++++++++++- 2 files changed, 28 insertions(+), 1 deletion(-) diff --git a/src/bin/common/solving_loop.ml b/src/bin/common/solving_loop.ml index 22afb5053..7f369a378 100644 --- a/src/bin/common/solving_loop.ml +++ b/src/bin/common/solving_loop.ml @@ -257,6 +257,9 @@ let main () = | Errors.Error e -> Printer.print_err "%a" Errors.report e; exit 1 + | D_loop.DolmenError (i, descr) -> + Printer.print_err "Dolmen failed %s (code %i)" descr i; + exit 1 | _ as exn -> Printexc.raise_with_backtrace exn bt in let finally ~handle_exn st e = diff --git a/src/lib/frontend/d_loop.ml b/src/lib/frontend/d_loop.ml index bd6cd892c..7733eb7c7 100644 --- a/src/lib/frontend/d_loop.ml +++ b/src/lib/frontend/d_loop.ml @@ -28,10 +28,34 @@ (* *) (**************************************************************************) +exception DolmenError of int * string + module DStd = Dolmen.Std module Dl = Dolmen_loop -module State = Dl.State +module State = struct + include Dl.State + + (* Overriding error function so that error does not savagely exit. *) + let error ?file ?loc st error payload = + let st = flush st () in + let loc = Dolmen.Std.Misc.opt_map loc Dolmen.Std.Loc.full_loc in + let aux _ = + let code, descr = Dl.(Code.descr Dl.Report.Error.(code error)) in + raise (DolmenError (code, descr)) + in + match get report_style st with + | Minimal -> + Format.kfprintf aux Format.err_formatter + "E:%s@." (Dl.Report.Error.mnemonic error) + | Regular | Contextual -> + Format.kfprintf aux Format.err_formatter + ("@[%a%a @[%a@]%a@]@.") + (pp_loc ?file st) loc + Fmt.(styled `Bold @@ styled (`Fg (`Hi `Red)) string) "Error" + Dl.Report.Error.print (error, payload) + Dl.Report.Error.print_hints (error, payload) +end module Pipeline = Dl.Pipeline.Make(State) module Parser = Dolmen_loop.Parser.Make(State) From 3e3e2286594b0e52af810ee2ffb90701f02d8d82 Mon Sep 17 00:00:00 2001 From: Steven de Oliveira Date: Thu, 28 Sep 2023 17:21:23 +0200 Subject: [PATCH 2/4] Doc --- src/lib/frontend/d_loop.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/lib/frontend/d_loop.ml b/src/lib/frontend/d_loop.ml index 7733eb7c7..7af379baa 100644 --- a/src/lib/frontend/d_loop.ml +++ b/src/lib/frontend/d_loop.ml @@ -29,6 +29,8 @@ (**************************************************************************) exception DolmenError of int * string +(** An error raised by Dolmen; corresponds to the error code and a short + description of the error. *) module DStd = Dolmen.Std module Dl = Dolmen_loop From 411e86c398b7d0cd5d8544008b3b1cfc2f7dda43 Mon Sep 17 00:00:00 2001 From: Steven de Oliveira Date: Thu, 28 Sep 2023 17:51:25 +0200 Subject: [PATCH 3/4] Poetry --- src/bin/common/solving_loop.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/bin/common/solving_loop.ml b/src/bin/common/solving_loop.ml index 7f369a378..68826fc4b 100644 --- a/src/bin/common/solving_loop.ml +++ b/src/bin/common/solving_loop.ml @@ -258,7 +258,7 @@ let main () = Printer.print_err "%a" Errors.report e; exit 1 | D_loop.DolmenError (i, descr) -> - Printer.print_err "Dolmen failed %s (code %i)" descr i; + Printer.print_err "Failure %s (code %i)" descr i; exit 1 | _ as exn -> Printexc.raise_with_backtrace exn bt in From b1fb05fa7ecadd443641af853c11718e5826cf14 Mon Sep 17 00:00:00 2001 From: Steven de Oliveira Date: Thu, 28 Sep 2023 17:58:18 +0200 Subject: [PATCH 4/4] To error.ml --- src/bin/common/solving_loop.ml | 3 --- src/lib/frontend/d_loop.ml | 6 +----- src/lib/structures/errors.ml | 4 ++++ src/lib/structures/errors.mli | 2 ++ 4 files changed, 7 insertions(+), 8 deletions(-) diff --git a/src/bin/common/solving_loop.ml b/src/bin/common/solving_loop.ml index 68826fc4b..22afb5053 100644 --- a/src/bin/common/solving_loop.ml +++ b/src/bin/common/solving_loop.ml @@ -257,9 +257,6 @@ let main () = | Errors.Error e -> Printer.print_err "%a" Errors.report e; exit 1 - | D_loop.DolmenError (i, descr) -> - Printer.print_err "Failure %s (code %i)" descr i; - exit 1 | _ as exn -> Printexc.raise_with_backtrace exn bt in let finally ~handle_exn st e = diff --git a/src/lib/frontend/d_loop.ml b/src/lib/frontend/d_loop.ml index 7af379baa..0ab88beeb 100644 --- a/src/lib/frontend/d_loop.ml +++ b/src/lib/frontend/d_loop.ml @@ -28,10 +28,6 @@ (* *) (**************************************************************************) -exception DolmenError of int * string -(** An error raised by Dolmen; corresponds to the error code and a short - description of the error. *) - module DStd = Dolmen.Std module Dl = Dolmen_loop @@ -44,7 +40,7 @@ module State = struct let loc = Dolmen.Std.Misc.opt_map loc Dolmen.Std.Loc.full_loc in let aux _ = let code, descr = Dl.(Code.descr Dl.Report.Error.(code error)) in - raise (DolmenError (code, descr)) + raise (Errors.(error (Dolmen_error (code, descr)))) in match get report_style st with | Minimal -> diff --git a/src/lib/structures/errors.ml b/src/lib/structures/errors.ml index 61473b3fc..3e68fe623 100644 --- a/src/lib/structures/errors.ml +++ b/src/lib/structures/errors.ml @@ -92,6 +92,7 @@ type error = | Typing_error of Loc.t * typing_error | Run_error of run_error | Warning_as_error + | Dolmen_error of (int * string) exception Error of error @@ -256,4 +257,7 @@ let report fmt = function | Run_error e -> Options.pp_comment fmt "Fatal Error: "; report_run_error fmt e + | Dolmen_error (code, descr) -> + Options.pp_comment fmt + (Format.sprintf "Error %s (code %i)" descr code); | Warning_as_error -> () diff --git a/src/lib/structures/errors.mli b/src/lib/structures/errors.mli index 60ed5ffb5..1741bb1c0 100644 --- a/src/lib/structures/errors.mli +++ b/src/lib/structures/errors.mli @@ -100,6 +100,8 @@ type error = | Typing_error of Loc.t * typing_error (** Error used at typing *) | Run_error of run_error (** Error used during solving *) | Warning_as_error + | Dolmen_error of (int * string) + (** Error code + description raised by dolmen. *) (** {2 Exceptions } *)