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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
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 (*IF_AT_LEAST 408 = 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 (*IF_AT_LEAST 408 = 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 (*IF_AT_LEAST 408 = Ocaml_common.Location.error *) (*IF_NOT_AT_LEAST 408 = old_t *)
  (** On ocaml >= 4.08: [t] is a [location_report] for which [location_report_kind] must be [Report_error]. *)

  type version_specific_t = [`New_error of location_report | `Old_error of old_t]

  let version_specific_t_of_t : t -> version_specific_t = fun x ->
    (*IF_AT_LEAST 408 `New_error x *)
    (*IF_NOT_AT_LEAST 408 `Old_error x *)

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

  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 error =
    match version_specific_t_of_t error with
    | `New_error { main; _ } ->
        { txt = string_of_location_msg main; loc = main.loc }
    | `Old_error { msg; loc; _ } -> { txt = msg; loc }

  let sub_msgs error =
    match version_specific_t_of_t error with
    | `New_error { sub; _ } ->
        List.map
          (fun err -> { txt = string_of_location_msg err; loc = err.loc })
          sub
    | `Old_error { sub; _ } ->
        let rec deeply_flattened_sub_msgs acc = function
          | [] -> acc
          | { loc; msg; sub; _ } :: tail ->
              deeply_flattened_sub_msgs ({ txt = msg; loc } :: acc) (sub @ tail)
        in
        deeply_flattened_sub_msgs [] sub

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

  let _set_main_msg_old error msg = { error with msg }

  let _set_main_txt error txt =
    let main = { error.main with txt } in
    { error with main }

  let _set_main_msg_new 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 set_main_msg error msg =
    (*IF_NOT_AT_LEAST 408 _set_main_msg_old error msg*)
    (*IF_AT_LEAST 408 _set_main_msg_new error msg*)

  let _make_error_of_message_old ~sub { loc; txt } =
    let sub =
      List.map
        (fun { loc; txt } -> { loc; msg = txt; sub = []; if_highlight = txt })
        sub
    in
    { loc; msg = txt; sub; if_highlight = txt }

  let _make_error_of_message_new ~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 make ~sub msg =
    (*IF_NOT_AT_LEAST 408 _make_error_of_message_old ~sub msg*)
    (*IF_AT_LEAST 408 _make_error_of_message_new ~sub msg*)

  let _set_main_loc_old error loc = { error with loc }

  let _set_main_loc_new error loc =
    let main = { error.main with loc } in
    { error with main }

  let set_main_loc error loc =
    (*IF_NOT_AT_LEAST 408 _set_main_loc_old error loc*)
    (*IF_AT_LEAST 408 _set_main_loc_new error loc*)
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.kasprintf (fun s -> raise_errorf ?loc "%s" s) msg *)
  (*IF_NOT_AT_LEAST 503 raise_errorf ?loc msg *)