Source file `import_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
(**************************************************************************)
(*                                                                        *)
(*                                 OCaml                                  *)
(*                                                                        *)
(*             Mark Shinwell, Jane Street UK Partnership LLP              *)
(*                                                                        *)
(*   Copyright 2022 Jane Street Group LLC                                 *)
(*                                                                        *)
(*   All rights reserved.  This file is distributed under the terms of    *)
(*   the GNU Lesser General Public License version 2.1, with the          *)
(*   special exception on linking described in the file LICENSE.          *)
(*                                                                        *)
(**************************************************************************)

module CU = Compilation_unit

type intf =
  | Normal of CU.t * Digest.t
  | Alias of CU.Name.t
  | Parameter of CU.Name.t * Digest.t

type impl =
  | Loaded of CU.t * Digest.t
  | Unloaded of CU.t

(* CR-soon lmaurer: This combined type should go away soon, since each [t] is
   actually statically known to be either an [intf] or an [impl] (see PR
   #1933) *)
type t =
  | Intf of intf
  | Impl of impl

let check_name name cu =
  if not (CU.Name.equal (CU.name cu) name)
  then
    Misc.fatal_errorf_doc
      "@[<hv>Mismatched import name and compilation unit:@ %a != %a@]"
      CU.Name.print name CU.print cu

let create cu_name ~crc_with_unit =
  (* This creates an [Intf] just to be minimally restrictive. Any caller that
     cares should use the [Impl] API. *)
  match crc_with_unit with
  | None -> Intf (Alias cu_name)
  | Some (cu, crc) ->
    check_name cu_name cu;
    Intf (Normal (cu, crc))

let create_normal cu ~crc =
  match crc with
  | Some crc -> Impl (Loaded (cu, crc))
  | None -> Impl (Unloaded cu)

let name t =
  match t with
  | Impl (Loaded (cu, _) | Unloaded cu) -> CU.name cu
  | Intf (Normal (cu, _)) -> CU.name cu
  | Intf (Alias name | Parameter (name, _)) -> name

let cu t =
  match t with
  | Intf (Normal (cu, _)) -> cu
  | Impl (Loaded (cu, _) | Unloaded cu) -> cu
  | Intf (Alias name | Parameter (name, _)) ->
    Misc.fatal_errorf
      "Cannot extract [Compilation_unit.t] from [Import_info.t] (for unit %a) \
       that never received it"
      (Format_doc.compat CU.Name.print)
      name

let crc t =
  match t with
  | Intf (Normal (_, crc) | Parameter (_, crc)) -> Some crc
  | Intf (Alias _) -> None
  | Impl (Loaded (_, crc)) -> Some crc
  | Impl (Unloaded _) -> None

let has_name t ~name:name' = CU.Name.equal (name t) name'

let dummy = Intf (Alias CU.Name.dummy)

module Intf = struct
  (* Currently this is the same type as [Impl.t] but this will change (see PR
     #1746). *)
  type nonrec t = t

  let create_normal name cu ~crc =
    if CU.instance_arguments cu <> []
    then
      Misc.fatal_errorf_doc "@[<hv>Interface import with arguments:@ %a@]"
        CU.print cu;
    check_name name cu;
    Intf (Normal (cu, crc))

  let create_alias name = Intf (Alias name)

  let create_parameter name ~crc = Intf (Parameter (name, crc))

  module Nonalias = struct
    module Kind = struct
      type t =
        | Normal of CU.t
        | Parameter
    end

    type t = Kind.t * Digest.t
  end

  let create name nonalias =
    match (nonalias : Nonalias.t option) with
    | None -> create_alias name
    | Some (Normal cu, crc) -> create_normal name cu ~crc
    | Some (Parameter, crc) -> create_parameter name ~crc

  let expect_intf t =
    match t with
    | Intf intf -> intf
    | Impl (Loaded (cu, _) | Unloaded cu) ->
      Misc.fatal_errorf_doc "Expected an [Import_info.Impl.t] but found %a"
        CU.print cu

  let name t =
    match expect_intf t with
    | Normal (cu, _) -> CU.name cu
    | Alias name | Parameter (name, _) -> name

  let info t : Nonalias.t option =
    match expect_intf t with
    | Normal (cu, crc) -> Some (Normal cu, crc)
    | Parameter (_, crc) -> Some (Parameter, crc)
    | Alias _ -> None

  let crc t =
    match expect_intf t with
    | Normal (_, crc) | Parameter (_, crc) -> Some crc
    | Alias _ -> None

  let has_name t ~name:name' = CU.Name.equal (name t) name'

  let dummy = dummy
end

module Impl = struct
  (* Currently this is the same type as [Intf.t] but this will change (see PR
     #1746). *)
  type nonrec t = t

  let create_loaded cu ~crc = Impl (Loaded (cu, crc))

  let create_unloaded cu = Impl (Unloaded cu)

  let create cu ~crc =
    match crc with
    | Some crc -> create_loaded cu ~crc
    | None -> create_unloaded cu

  let expect_impl t =
    match t with
    | Impl impl -> impl
    | Intf _ ->
      Misc.fatal_errorf "Expected an [Import_info.Intf.t] but found %a"
        (Format_doc.compat CU.Name.print)
        (Intf.name t)

  let cu t = match expect_impl t with Loaded (cu, _) | Unloaded cu -> cu

  let name t = CU.name (cu t)

  let crc t =
    match expect_impl t with Loaded (_, crc) -> Some crc | Unloaded _ -> None

  let dummy = Impl (Unloaded CU.dummy)
end
Source file import_info.ml

Source file `import_info.ml`
