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
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Florian Angeletti, projet Cambium, Inria Paris *)
(* *)
(* Copyright 2023 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* 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. *)
(* *)
(**************************************************************************)
type intf_or_impl = Intf | Impl
type modname = string
type filename = string
type file_prefix = string
type error = Invalid_encoding of string
exception Error of error
type t = {
source_file: filename;
prefix: file_prefix;
modname: modname;
kind: intf_or_impl;
}
let source_file (x: t) = x.source_file
let modname (x: t) = x.modname
let kind (x: t) = x.kind
let prefix (x: t) = x.prefix
let basename_chop_extensions basename =
match String.index basename '.' with
| dot_pos -> String.sub basename 0 dot_pos
| exception Not_found -> basename
let strict_modulize s =
match Misc.Utf8_lexeme.capitalize s with
| Ok x -> x
| Error _ -> raise (Error (Invalid_encoding s))
let modulize s = match Misc.Utf8_lexeme.capitalize s with Ok x | Error x -> x
(* We re-export the [Misc] definition, and ignore encoding errors under the
assumption that we should focus our effort on not *producing* badly encoded
module names *)
let normalize x = match Misc.normalized_unit_filename x with
| Ok x | Error x -> x
let stem source_file =
source_file |> Filename.basename |> basename_chop_extensions
let strict_modname_from_source source_file =
source_file |> stem |> strict_modulize
let lax_modname_from_source source_file =
source_file |> stem |> modulize
(* Check validity of module name *)
let is_unit_name name = Misc.Utf8_lexeme.is_valid_identifier name
let check_unit_name file =
if not (is_unit_name (modname file)) then
Location.prerr_warning (Location.in_file (source_file file))
(Warnings.Bad_module_name (modname file))
let make ?(check_modname=true) ~source_file kind prefix =
let modname = strict_modname_from_source prefix in
let p = { modname; prefix; source_file; kind } in
if check_modname then check_unit_name p;
p
module Artifact = struct
type t =
{
source_file: filename option;
filename: filename;
modname: modname;
}
let source_file x = x.source_file
let filename x = x.filename
let modname x = x.modname
let prefix x = Filename.remove_extension (filename x)
let from_filename filename =
let modname = lax_modname_from_source filename in
{ modname; filename; source_file = None }
end
let mk_artifact ext u =
{
Artifact.filename = u.prefix ^ ext;
modname = u.modname;
source_file = Some u.source_file;
}
let companion_artifact ext x =
{ x with Artifact.filename = Artifact.prefix x ^ ext }
let cmi f = mk_artifact ".cmi" f
let cmo f = mk_artifact ".cmo" f
let cmx f = mk_artifact ".cmx" f
let obj f = mk_artifact Config.ext_obj f
let cmt f = mk_artifact ".cmt" f
let cmti f = mk_artifact ".cmti" f
let annot f = mk_artifact ".annot" f
let companion_obj f = companion_artifact Config.ext_obj f
let companion_cmt f = companion_artifact ".cmt" f
let companion_cmi f =
let prefix = Misc.chop_extensions f.Artifact.filename in
{ f with Artifact.filename = prefix ^ ".cmi"}
let mli_from_artifact f = Artifact.prefix f ^ !Config.interface_suffix
let mli_from_source u =
let prefix = Filename.remove_extension (source_file u) in
prefix ^ !Config.interface_suffix
let is_cmi f = Filename.check_suffix (Artifact.filename f) ".cmi"
let find_normalized_cmi f =
let filename = modname f ^ ".cmi" in
let filename = Load_path.find_normalized filename in
{ Artifact.filename; modname = modname f; source_file = Some f.source_file }
let report_error = function
| Invalid_encoding name ->
Location.errorf "Invalid encoding of output name: %s." name
let () =
Location.register_error_of_exn
(function
| Error err -> Some (report_error err)
| _ -> None
)
|
