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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
(* 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, stable_witness]
    end :
      sig
        type t [@@deriving bin_io, compare, hash, stable_witness]
      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, stable_witness]
      end

      include T

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

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

            let to_binable = to_binable
            let of_binable = of_binable
          end)

      let stable_witness =
        Stable_witness.of_serializable Sexp.stable_witness of_binable to_binable
      ;;
    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, stable_witness]

          (* [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, stable_witness]
      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, sexp_grammar, compare, equal, hash]
      end

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

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

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

            let to_binable = to_binable
            let of_binable = of_binable
          end)

      let stable_witness =
        Stable_witness.of_serializable
          Internal_repr.Stable.V2.stable_witness
          of_binable
          to_binable
      ;;

      include Diffable.Atomic.Make (struct
        type nonrec t = t [@@deriving sexp, bin_io, equal]
      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)

      let to_binable = sexp_of_t
      let of_binable = t_of_sexp

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

            let to_binable = to_binable
            let of_binable = of_binable
          end)

      let stable_witness =
        Stable_witness.of_serializable Sexp.stable_witness of_binable to_binable
      ;;
    end
  end

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

  module Diff = Stable.V2.Diff
end

include Extend (Base.Info)