Source file location.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
include Ocaml_common.Location

let set_input_name name = input_name := name
let set_input_lexbuf lexbuf_opt = input_lexbuf := lexbuf_opt

module Error = struct
  [@@@warning "-37"]

  type old_t (*IF_NOT_AT_LEAST 408 = Ocaml_common.Location.error *) = {
    loc: t;
    msg: string;
    sub: old_t list;
    if_highlight: string;
  }

  type location_report_kind = Ocaml_common.Location.report_kind =
  | Report_error
  | Report_warning of string
  | Report_warning_as_error of string
  | Report_alert of string
  | Report_alert_as_error of string

  type location_msg =
    (*IF_AT_LEAST 503 Ocaml_common.Format_doc.t loc *)
    (*IF_NOT_AT_LEAST 503 (Format.formatter -> unit) loc *)

  type location_report = Ocaml_common.Location.report = {
    kind : location_report_kind;
    main : location_msg;
    sub : location_msg list;
    (*IF_AT_LEAST 503 footnote: Format_doc.t option; *)
  }

  type t = Ocaml_common.Location.error

  let is_well_formed error =
    match error with
    | { kind = Report_error; _ } -> true
    | _ -> false

  let string_of_location_msg (msg : location_msg) =
     (*IF_AT_LEAST 503 Format.asprintf "%a" Ocaml_common.Format_doc.Doc.format msg.txt *)
     (*IF_NOT_AT_LEAST 503 Format.asprintf "%t" msg.txt *)

  let main_msg { main; _ } =
    { txt = string_of_location_msg main; loc = main.loc }

  let sub_msgs { sub; _ } =
    List.map
      (fun err -> { txt = string_of_location_msg err; loc = err.loc })
      sub

  let of_exn exn =
    match error_of_exn exn with
    | Some (`Ok e) -> Some e
    | None | Some `Already_displayed -> None

  let set_main_msg error msg =
    (*IF_AT_LEAST 503 let txt = Ocaml_common.Format_doc.Doc.msg "%s" msg in *)
    (*IF_NOT_AT_LEAST 503 let txt ppf = Format.pp_print_string ppf msg in *)
    let main = { error.main with txt } in
    { error with main }

  let make ~sub { loc; txt } =
    (*IF_AT_LEAST 503 let mk_txt x = Ocaml_common.Format_doc.Doc.msg "%s" x in *)
    (*IF_NOT_AT_LEAST 503 let mk_txt x ppf = Format.pp_print_string ppf x in *)
    let mk loc x = { loc; txt = mk_txt x } in
    {
      kind = Report_error;
      main = mk loc txt;
      sub = List.map (fun { loc; txt } -> mk loc txt) sub;
      (*IF_AT_LEAST 503 footnote = None; *)
    }

  let set_main_loc error loc =
    let main = { error.main with loc } in
    { error with main }
end

let raise_errorf ?loc msg =
  (* Update from [kasprintf] to [kdprintf] + [Format_doc.deprecated_printer]
     when ocaml lower bound is 4.08+ *)
  (*IF_AT_LEAST 503 Format.kdprintf (fun pr -> raise_errorf ?loc "%t" (Format_doc.deprecated_printer pr)) msg *)
  (*IF_NOT_AT_LEAST 503 raise_errorf ?loc msg *)