Source file info.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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
(* This module is trying to minimize dependencies on modules in Core, so as to allow
   [Info], [Error], and [Or_error] to be used in is many places places as possible.
   Please avoid adding new dependencies. *)

open! Import
open! Info_intf

module type S = Base.Info.S

module Source_code_position = Source_code_position0
module Binable = Binable0

module Sexp = struct
  include Sexplib.Sexp

  include (
  struct
    type t = Base.Sexp.t =
      | Atom of string
      | List of t list
    [@@deriving bin_io, compare, hash]
  end :
  sig
    type t [@@deriving bin_io, compare, hash]
  end
  with type t := t)
end

module Binable_exn = struct
  module Stable = struct
    module V1 = struct
      module T = struct
        type t = exn [@@deriving sexp_of]
      end

      include T

      include
        Binable.Stable.Of_binable.V1 [@alert "-legacy"]
          (Sexp)
          (struct
            include T

            let to_binable t = t |> [%sexp_of: t]
            let of_binable = Exn.create_s
          end)
    end
  end
end

module Extend (Info : Base.Info.S) = struct
  include Info

  module Internal_repr = struct
    module Stable = struct
      module Binable_exn = Binable_exn.Stable

      module Source_code_position = struct
        module V1 = struct
          type t = Source_code_position.Stable.V1.t [@@deriving bin_io]

          (* [sexp_of_t] as defined here is unstable; this is OK because there is no
             [t_of_sexp].  [sexp_of_t] is only used to produce a sexp that is never
             deserialized as a [Source_code_position]. *)
          let sexp_of_t = Source_code_position.sexp_of_t
        end
      end

      module V2 = struct
        type t = Info.Internal_repr.t =
          | Could_not_construct of Sexp.t
          | String of string
          | Exn of Binable_exn.V1.t
          | Sexp of Sexp.t
          | Tag_sexp of string * Sexp.t * Source_code_position.V1.t option
          | Tag_t of string * t
          | Tag_arg of string * Sexp.t * t
          | Of_list of int option * t list
          | With_backtrace of t * string (* backtrace *)
        [@@deriving bin_io, sexp_of]
      end
    end

    include Stable.V2

    let to_info = Info.Internal_repr.to_info
    let of_info = Info.Internal_repr.of_info
  end

  module Stable = struct
    module V2 = struct
      module T = struct
        type t = Info.t [@@deriving sexp, compare, hash]
      end

      include T
      include Comparator.Stable.V1.Make (T)

      include
        Binable.Stable.Of_binable.V1 [@alert "-legacy"]
          (Internal_repr.Stable.V2)
          (struct
            type nonrec t = t

            let to_binable = Info.Internal_repr.of_info
            let of_binable = Info.Internal_repr.to_info
          end)
    end

    module V1 = struct
      module T = struct
        type t = Info.t [@@deriving compare]

        include
          Sexpable.Stable.Of_sexpable.V1
            (Sexp)
            (struct
              type nonrec t = t

              let to_sexpable = Info.sexp_of_t
              let of_sexpable = Info.t_of_sexp
            end)

        let compare = compare
      end

      include T
      include Comparator.Stable.V1.Make (T)

      include
        Binable.Stable.Of_binable.V1 [@alert "-legacy"]
          (Sexp)
          (struct
            type nonrec t = t

            let to_binable = sexp_of_t
            let of_binable = t_of_sexp
          end)
    end
  end

  type t = Stable.V2.t [@@deriving bin_io]
end

include Extend (Base.Info)