diff --git a/src/build.ml b/src/build.ml index 1d69484a..4b5078c9 100644 --- a/src/build.ml +++ b/src/build.ml @@ -62,12 +62,16 @@ module Repr = struct let get_if_file_exists_exn state = match !state with | Decided (_, t) -> t - | Undecided _ -> code_errorf "Build.get_if_file_exists_exn: got undecided" + | Undecided _ -> + Exn.code_error "Build.get_if_file_exists_exn: got undecided" [] let get_glob_result_exn state = match !state with | G_evaluated l -> l - | G_unevaluated _ -> code_errorf "Build.get_glob_result_exn: got unevaluated" + | G_unevaluated (loc, path, _) -> + Exn.code_error "Build.get_glob_result_exn: got unevaluated" + [ "loc", Loc.sexp_of_t loc + ; "path", Path.sexp_of_t path ] end include Repr let repr t = t diff --git a/src/build_interpret.ml b/src/build_interpret.ml index 8ae453d2..7144a23b 100644 --- a/src/build_interpret.ml +++ b/src/build_interpret.ml @@ -169,13 +169,19 @@ let targets = | Fail _ -> acc | If_file_exists (_, state) -> begin match !state with - | Decided _ -> code_errorf "Build_interpret.targets got decided if_file_exists" + | Decided (v, _) -> + Exn.code_error "Build_interpret.targets got decided if_file_exists" + ["exists", Sexp.To_sexp.bool v] | Undecided (a, b) -> match loop a [], loop b [] with | [], [] -> acc - | _ -> - code_errorf "Build_interpret.targets: cannot have targets \ - under a [if_file_exists]" + | a, b -> + let targets x = Path.Set.sexp_of_t (Target.paths x) in + Exn.code_error "Build_interpret.targets: cannot have targets \ + under a [if_file_exists]" + [ "targets-a", targets a + ; "targets-b", targets b + ] end | Memo m -> loop m.t acc | Catch (t, _) -> loop t acc diff --git a/src/build_system.ml b/src/build_system.ml index 995c750a..0f5ec198 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -407,9 +407,11 @@ let entry_point t ~f = (match t.load_dir_stack with | [] -> () - | _ :: _ -> - code_errorf - "Build_system.entry_point: called inside the rule generator callback"); + | stack -> + Exn.code_error + "Build_system.entry_point: called inside the rule generator callback" + ["stack", Sexp.To_sexp.list Path.sexp_of_t stack] + ); f () module Target = Build_interpret.Target diff --git a/src/errors.ml b/src/errors.ml index 453f3543..d12c1aed 100644 --- a/src/errors.ml +++ b/src/errors.ml @@ -12,8 +12,5 @@ let kerrf fmt ~f = f s) err_ppf fmt -let code_errorf fmt = - kerrf fmt ~f:(fun s -> Stdune.Exn.code_error s []) - let die fmt = kerrf fmt ~f:(fun s -> raise (Fatal_error s)) diff --git a/src/errors.mli b/src/errors.mli index cb728d76..d61f0321 100644 --- a/src/errors.mli +++ b/src/errors.mli @@ -22,9 +22,6 @@ exception Already_reported (** Raise a [Fatal_error] exception *) val die : ('a, Format.formatter, unit, 'b) format4 -> 'a -(** Raise a [Code_error] exception *) -val code_errorf : ('a, Format.formatter, unit, 'b) format4 -> 'a - (**/**) (* Referenced in Ansi_color and Report_error *) val err_buf : Buffer.t diff --git a/src/module.ml b/src/module.ml index b46f85c9..df187f99 100644 --- a/src/module.ml +++ b/src/module.ml @@ -31,7 +31,8 @@ module File = struct let to_ocaml t = match t.syntax with - | OCaml -> code_errorf "to_ocaml: can only convert reason Files" () + | OCaml -> Exn.code_error "to_ocaml: can only convert reason Files" + ["t.name", Sexp.To_sexp.string t.name] | Reason -> { syntax = OCaml ; name = @@ -40,7 +41,9 @@ module File = struct (match Filename.extension t.name with | ".re" -> ".ml" | ".rei" -> ".mli" - | _ -> code_errorf "to_ocaml: unrecognized extension %s" ext ()) + | _ -> Exn.code_error "to_ocaml: unrecognized extension" + [ "name", Sexp.To_sexp.string t.name + ; "ext", Sexp.To_sexp.string ext ]) } end diff --git a/src/path.ml b/src/path.ml index 38dd7911..e3350a4e 100644 --- a/src/path.ml +++ b/src/path.ml @@ -78,7 +78,7 @@ module Local = struct let parent = function | "" -> - code_errorf "Path.Local.parent called on the root" + Exn.code_error "Path.Local.parent called on the root" [] | t -> match String.rindex_from t (String.length t - 1) '/' with | exception Not_found -> "" @@ -86,7 +86,7 @@ module Local = struct let basename = function | "" -> - code_errorf "Path.Local.basename called on the root" + Exn.code_error "Path.Local.basename called on the root" [] | t -> let len = String.length t in match String.rindex_from t (len - 1) '/' with