Source file `ModuleId.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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
type state = Standard of StandardModuleId.t | Special of SpecialModuleId.t

let compare_state s1 s2 =
  match (s1, s2) with
  | Standard _, Special _ -> -1
  | Standard a1, Standard a2 -> StandardModuleId.compare a1 a2
  | Special a1, Special a2 -> SpecialModuleId.compare a1 a2
  | Special _, Standard _ -> 1

type t = {
  library_id : LibraryId.t;
  namespace_front : string list;
  namespace_tail : string;
  state : state;
}
(** INVARIANT: [module_path] is not ["lib__"] or any other reserved name. *)

let compare
    { library_id = a1; namespace_front = c1; namespace_tail = d1; state = e1 }
    { library_id = a2; namespace_front = c2; namespace_tail = d2; state = e2 } =
  match LibraryId.compare a1 a2 with
  | 0 -> (
      match List.compare String.compare c1 c2 with
      | 0 -> (
          match String.compare d1 d2 with 0 -> compare_state e1 e2 | c -> c)
      | c -> c)
  | c -> c

let mk_namespace namespace_front namespace_tail =
  namespace_front @ [ namespace_tail ]

let namespace_ { namespace_front; namespace_tail; _ } =
  mk_namespace namespace_front namespace_tail

let create_standard ~library_id ~namespace_front ~namespace_tail =
  (* Validation is done by StandardModuleId *)
  {
    library_id;
    namespace_front;
    namespace_tail;
    state =
      Standard
        (StandardModuleId.create_explicit ~library_id ~namespace_front
           ~namespace_tail);
  }

let create_standard_optimistic ~library_id ~namespace_front ~namespace_tail
    ~optimistic =
  (* Validation is done by StandardModuleId *)
  {
    library_id;
    namespace_front;
    namespace_tail;
    state =
      Standard
        (StandardModuleId.create_optimistic ~library_id ~namespace_front
           ~namespace_tail optimistic);
  }

let create_signature ~library_id =
  {
    library_id;
    namespace_front = [];
    namespace_tail = ModuleParsing.signature_simple_name;
    state = Special (SpecialModuleId.create_signature library_id);
  }

let create_libopen ~library_id =
  {
    library_id;
    namespace_front = [];
    namespace_tail = ModuleParsing.libopen_simple_name;
    state = Special (SpecialModuleId.create_libopen library_id);
  }

let create_proxy_of_standard_module_id
    ({ library_id; namespace_front; namespace_tail; definition = _ } :
      StandardModuleId.t) =
  {
    library_id;
    namespace_front;
    namespace_tail = namespace_tail ^ ModuleParsing.proxy_suffix;
    state =
      Special
        (SpecialModuleId.create_proxy_of_standard_module_id ~library_id
           ~namespace_front ~namespace_tail);
  }

let of_standard_module_id
    ({ library_id; namespace_front; namespace_tail; definition = _ } :
      StandardModuleId.t) =
  create_standard ~library_id ~namespace_front ~namespace_tail

let of_special_module_id ({ library_id; typ } : SpecialModuleId.t) =
  (* See PackageId.mli Venn diagram. Intersection of SpecialModuleId and ModuleId
     is SpecialModuleId. *)
  match typ with
  | SignatureModule -> create_signature ~library_id
  | LibOpenModule -> create_libopen ~library_id
  | ProxyModule { namespace_front; namespace_tail } ->
      create_proxy_of_standard_module_id
        (StandardModuleId.create_explicit ~library_id ~namespace_front
           ~namespace_tail)

let is_standard { state; _ } =
  match state with Standard _ -> true | _ -> false

let is_standard_explicit { state; _ } =
  match state with Standard { definition = Explicit; _ } -> true | _ -> false

let is_libcontrol { state; _ } =
  match state with
  | Special { library_id = _; typ = SignatureModule } -> true
  | _ -> false

let is_libopen { state; _ } =
  match state with
  | Special { library_id = _; typ = LibOpenModule } -> true
  | _ -> false

let namespace_tail { state; _ } =
  match state with
  | Standard { namespace_tail; _ } -> namespace_tail
  | Special { library_id = _; typ = SignatureModule } ->
      ModuleParsing.signature_simple_name
  | Special { library_id = _; typ = LibOpenModule } ->
      ModuleParsing.libopen_simple_name
  | Special
      {
        library_id = _;
        typ = ProxyModule { namespace_front = _; namespace_tail };
      } ->
      namespace_tail

let namespace_front { state; _ } =
  match state with
  | Standard { namespace_front; _ } -> namespace_front
  | Special { library_id = _; typ = SignatureModule } -> []
  | Special { library_id = _; typ = LibOpenModule } -> []
  | Special
      {
        library_id = _;
        typ = ProxyModule { namespace_front; namespace_tail = _ };
      } ->
      namespace_front

let full_name { library_id; namespace_front; namespace_tail; state = _ } =
  Printf.sprintf "%s.%s"
    (LibraryId.full_name library_id)
    (String.concat "." (mk_namespace namespace_front namespace_tail))

let pp_any any fmt _v = Format.fprintf fmt "%s" any

let pp_full_name fmt { library_id; namespace_front; namespace_tail; state = _ }
    =
  Format.fprintf fmt "%s.%a"
    (LibraryId.full_name library_id)
    Format.(pp_print_list ~pp_sep:(pp_any ".") pp_print_string)
    (mk_namespace namespace_front namespace_tail)

let pp = pp_full_name

let show_double_underscore
    { library_id; namespace_front; namespace_tail; state = _ } =
  Format.asprintf "%s__%a"
    (LibraryId.full_name library_id)
    Format.(pp_print_list ~pp_sep:(pp_any "__") pp_print_string)
    (mk_namespace namespace_front namespace_tail)

let library_id { library_id; _ } = library_id

let cast_as_unit_id { state; _ } =
  match state with
  | Standard standard_module_id ->
      `PackageId (StandardModuleId.cast_as_package_id standard_module_id)
  | Special special_module_id -> `SpecialModuleId special_module_id

let downcast_package_id ({ library_id; namespace; _ } : PackageId.t) =
  (* See PackageId.mli Venn diagram. Intersection of PackageId and ModuleId
     are StandardModuleIds. *)
  match namespace with
  | [] -> None
  | hd :: tl ->
      let namespace_tail, namespace_front =
        StandardModuleId.ForAdvancedUse.get_namespace_tail_and_front hd tl
      in
      Some (create_standard ~library_id ~namespace_front ~namespace_tail)

let downcast_unit_id = function
  | `SpecialModuleId special_module_id ->
      Some (of_special_module_id special_module_id)
  | `PackageId package_id -> downcast_package_id package_id

let downcast_special_id_as_proxy_standard_id :
    SpecialModuleId.t -> StandardModuleId.t option = function
  | { typ = ProxyModule { namespace_front; namespace_tail }; library_id } ->
      Some
        (StandardModuleId.create_explicit ~library_id ~namespace_front
           ~namespace_tail)
  | { typ = SignatureModule; library_id = _ }
  | { typ = LibOpenModule; library_id = _ } ->
      None