zachshipko.com
C build tool of the 21st century
1open Types
2
3type t = {
4 name : string;
5 command :
6 flags:Flags.t ->
7 objects:Object_file.t Seq.t ->
8 output:Object_file.t ->
9 string list;
10 transform_output : Object_file.t -> Object_file.t;
11 parallel : bool;
12 ext : String_set.t;
13 wrap_c_flags : Flags.t -> Flags.t;
14}
15
16let c_like ?(force_color = "-fdiagnostics-color=always") cc =
17 fun ~flags ~objects:_ ~output ->
18 cc
19 @ [ force_color; "-c"; "-o"; Eio.Path.native_exn output.Object_file.path ]
20 @ flags.Flags.compile
21 @ [ Eio.Path.native_exn output.source.path ]
22
23let clang =
24 {
25 name = "clang";
26 command = c_like [ "clang" ];
27 ext = String_set.of_list [ "c"; "s"; "ll"; "bc" ];
28 transform_output = Fun.id;
29 parallel = true;
30 wrap_c_flags = Fun.id;
31 }
32
33let clangxx =
34 {
35 name = "clang++";
36 command = c_like [ "clang++" ];
37 ext = String_set.of_list [ "cc"; "cpp"; "cxx" ];
38 transform_output = Fun.id;
39 parallel = true;
40 wrap_c_flags = Fun.id;
41 }
42
43let ispc =
44 {
45 name = "ispc";
46 command =
47 (fun ~flags ~objects:_ ~output ->
48 [
49 "ispc";
50 "--colored-output";
51 "--emit-obj";
52 "-o";
53 Eio.Path.native_exn output.Object_file.path;
54 ]
55 @ flags.compile
56 @ [ Eio.Path.native_exn output.source.path ]);
57 ext = String_set.of_list [ "ispc" ];
58 transform_output = Fun.id;
59 parallel = true;
60 wrap_c_flags = Fun.id;
61 }
62
63let ghc =
64 {
65 name = "ghc";
66 command =
67 (fun ~flags ~objects ~output ->
68 let objects = List.of_seq objects in
69 let output_dir =
70 match Eio.Path.split output.Object_file.path with
71 | None -> []
72 | Some (p, _) -> [ Eio.Path.native_exn p ]
73 in
74 let dep_dirs =
75 List.filter_map
76 (fun obj ->
77 match Eio.Path.split obj.Object_file.path with
78 | None -> None
79 | Some (p, _) -> Some (Eio.Path.native_exn p))
80 objects
81 in
82 let hidir_dirs =
83 List.sort_uniq String.compare (output_dir @ dep_dirs)
84 in
85 let include_dirs = List.sort_uniq String.compare dep_dirs in
86
87 let hidir = List.concat_map (fun p -> [ "-hidir"; p ]) hidir_dirs in
88 let include_paths = List.map (fun p -> "-i" ^ p) include_dirs in
89 [
90 "ghc";
91 "-fdiagnostics-color=always";
92 "-v0";
93 "-package";
94 "base";
95 "-package";
96 "text";
97 "-c";
98 "-o";
99 Eio.Path.native_exn output.Object_file.path;
100 ]
101 @ hidir @ include_paths @ flags.Flags.compile
102 @ [ Eio.Path.native_exn output.source.path ]);
103 ext = String_set.of_list [ "hs"; "lhs" ];
104 transform_output = Fun.id;
105 parallel = false;
106 wrap_c_flags =
107 (fun flags ->
108 let compile =
109 List.concat_map (fun x -> [ "-optc" ^ x ]) flags.Flags.compile
110 in
111 let link = List.concat_map (fun x -> [ "-optl" ^ x ]) flags.link in
112 Flags.v ~compile ~link ());
113 }
114
115let ocaml =
116 {
117 name = "ocamlfind";
118 command =
119 (fun ~flags ~objects ~output ->
120 let o_path =
121 let p, s = output.Object_file.path in
122 let s = Filename.chop_extension s ^ ".o" in
123 (p, s)
124 in
125 let output_dir =
126 match Eio.Path.split output.Object_file.path with
127 | None -> []
128 | Some (p, _) -> [ Eio.Path.native_exn p ]
129 in
130 let dep_dirs =
131 List.filter_map
132 (fun obj ->
133 match Eio.Path.split obj.Object_file.path with
134 | None -> None
135 | Some (p, _) -> Some (Eio.Path.native_exn p))
136 (List.of_seq objects)
137 in
138 let dirs = List.sort_uniq String.compare (output_dir @ dep_dirs) in
139 let include_paths = List.concat_map (fun p -> [ "-I"; p ]) dirs in
140 [
141 "ocamlfind";
142 "ocamlopt";
143 "-cc";
144 "clang";
145 "-I";
146 "+unix";
147 "-color=always";
148 "-c";
149 "-o";
150 Eio.Path.native_exn o_path;
151 ]
152 @ include_paths @ flags.Flags.compile
153 @ [ Eio.Path.native_exn output.source.path ]);
154 ext = String_set.of_list [ "ml" ];
155 transform_output =
156 (fun obj ->
157 let p, s = obj.path in
158 let dest =
159 (Filename.chop_extension @@ Filename.chop_extension @@ s) ^ ".cmx"
160 in
161 { obj with path = (p, dest) });
162 parallel = false;
163 wrap_c_flags =
164 (fun flags ->
165 let compile =
166 List.concat_map (fun x -> [ "-ccopt"; x ]) flags.Flags.compile
167 in
168 let link = List.concat_map (fun x -> [ "-cclib"; x ]) flags.link in
169 Flags.v ~compile ~link ());
170 }
171
172let mlton =
173 {
174 name = "mlton";
175 command =
176 (fun ~flags ~objects:_ ~output ->
177 let out =
178 Filename.quote (Eio.Path.native_exn output.Object_file.path)
179 in
180 let src = Filename.quote (Eio.Path.native_exn output.source.path) in
181 let args =
182 [ "mlton"; "-cc"; "clang"; "-stop"; "o"; "-output"; out ]
183 @ flags.compile @ [ src ]
184 in
185 let keep_externs =
186 if Util.uname = "Darwin" then "-keep_private_externs" else ""
187 in
188 [
189 "sh";
190 "-c";
191 String.concat " " args
192 ^ Printf.sprintf
193 " && ld -r %s %s.0.o %s.1.o -o %s && rm %s.0.o %s.1.o"
194 keep_externs out out out out out;
195 ]);
196 ext = String_set.of_list [ "sml"; "mlb" ];
197 transform_output = Fun.id;
198 parallel = true;
199 wrap_c_flags =
200 (fun flags ->
201 let compile =
202 List.concat_map (fun x -> [ "-cc-opt"; x ]) flags.Flags.compile
203 in
204 let link = List.concat_map (fun x -> [ "-link-opt"; x ]) flags.link in
205 Flags.v ~compile ~link ());
206 }
207
208let ats2 =
209 {
210 name = "patscc";
211 command =
212 c_like [ "patscc"; "-Wno-unused-command-line-argument"; "-cleanaft" ];
213 ext = String_set.of_list [ "dats"; "sats" ];
214 transform_output = Fun.id;
215 parallel = true;
216 wrap_c_flags = Fun.id;
217 }
218
219let flang =
220 {
221 name = "flang-new";
222 command = c_like [ "flang-new" ];
223 ext = String_set.of_list [ "f"; "f90"; "f95"; "f03"; "f08"; "F"; "F90" ];
224 transform_output = Fun.id;
225 parallel = true;
226 wrap_c_flags = Fun.id;
227 }
228
229let default = [ clang; clangxx; ispc; ghc; mlton; ats2; flang; ocaml ]
230let all = ref default
231
232let compile_obj t ~env ~sw ~output ~checker ~log_level ~build_dir ~build_mtime
233 ~objects flags =
234 let st =
235 try
236 Option.some
237 ( Eio.Path.stat ~follow:true output.Object_file.path,
238 Eio.Path.stat ~follow:true output.source.path )
239 with _ -> None
240 in
241 let src_path =
242 if not (Util.is_verbose log_level) then
243 Util.truncate_path_left output.source.path
244 else Eio.Path.native_exn output.source.path
245 in
246 let obj_path =
247 if not (Util.is_verbose log_level) then
248 Util.truncate_path_left output.Object_file.path
249 else Eio.Path.native_exn output.path
250 in
251 match st with
252 | Some (obj, src) when obj.mtime > src.mtime && obj.mtime > build_mtime ->
253 Util.log_spinner
254 ~verbose:(Util.is_verbose log_level)
255 "CACHE %s -> %s" src_path obj_path;
256 None
257 | _ ->
258 Util.log_spinner
259 ~verbose:(Util.is_verbose log_level)
260 "COMPILE(%s) %s -> %s" t.name src_path obj_path;
261 Util.mkparent output.Object_file.path;
262 let cmd = t.command ~flags ~output ~objects in
263 Command.check_command checker t.name;
264 if log_level = `Debug then Util.log " $ %s" (String.concat " " cmd);
265 Log_file.with_log_file ~keep:true ~build_dir
266 ~name:(Digest.to_hex (Digest.string (String.concat " " cmd)))
267 @@ fun (tmp_path, log_file) ->
268 let proc =
269 Eio.Process.spawn env#process_mgr cmd ~sw ~stdout:log_file
270 ~stderr:log_file
271 in
272 Some (tmp_path, proc)
273
274let register compiler =
275 if not (List.exists (fun c -> c.name = compiler.name) !all) then
276 all := compiler :: !all
277
278let find_by_name ?compilers c =
279 match
280 List.find_opt (fun x -> x.name = c) (Option.value ~default:!all compilers)
281 with
282 | Some x -> Some x
283 | None -> (
284 match String.lowercase_ascii c with
285 | "c" | "cc" | "clang" -> Some clang
286 | "clang++" | "c++" | "cxx" | "cpp" -> Some clangxx
287 | "ispc" -> Some ispc
288 | "ghc" | "hs" | "lhs" -> Some ghc
289 | "flang-new" | "flang" | "fortran" -> Some flang
290 | "sml" | "mlton" -> Some mlton
291 | "ats" | "ats2" | "pats" | "patscc" -> Some ats2
292 | "ocaml" | "ml" | "ocamlopt" | "ocamlfind" -> Some ocaml
293 | _ -> None)
294
295module Set = struct
296 include Set.Make (struct
297 type nonrec t = t
298
299 let compare a b = String_set.compare a.ext b.ext
300 end)
301
302 let default = of_list default
303end