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
type source = Local | Unknown | Pkg of Namespaced.t | Special of Name.t
let sep = Filename.dir_sep
type t = { source: source ; file: Namespaced.t }
type path = t
module Sch = struct open Schematic
let raw_source = Sum [ "Local", Void; "Unknown", Void;
"Pkg", Namespaced.sch; "Special", String ]
let source = custom raw_source
(function
| Local -> C E
| Unknown -> C (S E)
| Pkg s -> C (S (S (Z s)))
| Special s -> C(S(S(S(Z s))))
)
(function
| C E -> Local
| C S E -> Unknown
| C S S Z s -> Pkg s
| C S S S Z s -> Special s
| _ -> .
)
let all =
custom [source; Namespaced.fileview_sch]
(fun {source;file} -> Tuple.[source;file])
Tuple.(fun [source;file] -> {source;file} )
end let sch = Sch.all
let filename ?(sep=sep) p =
begin match p.source with
| Pkg n -> String.concat sep (Namespaced.fileview_flatten n) ^ sep
| _ -> ""
end
^
String.concat sep (Namespaced.fileview_flatten p.file)
let is_known = function
| {source=Unknown; _ } -> false
| _ -> true
let module_name {file; _ } = Namespaced.module_name file
let update_extension f p =
{ p with file = Namespaced.change_file_extension f p.file }
let change_extension ext =
update_extension ( fun _ -> ext )
let cmo = change_extension "cmo"
let o = change_extension "o"
let cmi = change_extension "cmi"
let cmx = change_extension "cmx"
let cmxs = change_extension "cmx"
let mk_dep all native = update_extension @@ function
| "mli" | "m2li" -> "cmi"
| "ml" | "m2l" when all -> "cmi"
| "ml" | "m2l" ->
if native then "cmx" else "cmo"
| "cmi" -> "cmi"
| s -> raise @@Invalid_argument ("Unknown extension " ^ s)
let pp_source ppf = function
| Local -> Pp.fp ppf "Local"
| Unknown -> Pp.fp ppf "Unknown"
| Pkg n -> Pp.fp ppf "Pkg [%a]" Namespaced.pp n
| Special s -> Pp.fp ppf "Special %s" s
let pp_simple ppf {source;file}=
Pp.fp ppf "(%a)%a" pp_source source
Namespaced.pp file
let pp_gen sep ppf {source;file} =
begin match source with
| Local -> ()
| Unknown -> Pp.fp ppf "?"
| Pkg s ->
Pp.fp ppf "%a%s" Namespaced.pp_as_filepath s
sep
| Special s -> Pp.fp ppf "(*%s*)" s
end;
Namespaced.pp_as_filepath ppf file
let pp = pp_gen sep
let es ppf = Pp.fp ppf {|"%s"|}
let reflect_source ppf =
function
| Local -> Pp.fp ppf "Local"
| Unknown -> Pp.fp ppf "Unknown"
| Pkg n -> Pp.fp ppf "Pkg [%a]" Namespaced.reflect n
| Special n -> Pp.fp ppf "Special %a" es n
let reflect ppf {source;file} =
Pp.fp ppf "{source=%a; file=%a}"
reflect_source source
Namespaced.reflect file
module Set = struct
include Set.Make(struct type t = path let compare = compare end)
let pp ppf s = Pp.(clist pp) ppf (elements s)
end
module Map = Support.Map.Make(struct type t = path let compare = compare end)
type set = Set.t
type 'a map = 'a Map.t
let local file = { source = Local; file = Namespaced.filepath_of_filename file }
let (/) simple {source; file} = {source; file = Namespaced.cons simple file }