zachshipko.com
C build tool of the 21st century
1open Types
2
3type visited = (string, unit) Hashtbl.t
4type process = Process : 'a Eio.Process.t -> process
5type compile_process = path * process
6
7open Effect
8open! Effect.Deep
9
10exception Build_failed of string
11
12type _ Effect.t +=
13 | Script : { script : string } -> unit t
14 | External : { ext : Build.External.t } -> unit t
15 | Compile : {
16 compiler : Compiler.t;
17 output : Object_file.t;
18 objects : Object_file.t Seq.t;
19 flags : Flags.t;
20 }
21 -> compile_process option t
22 | Link : {
23 output : path;
24 linker : Linker.t;
25 objects : Object_file.t list;
26 flags : Flags.t;
27 }
28 -> unit t
29
30let compile ~compiler ~output ~objects ~flags =
31 Effect.perform (Compile { compiler; output; objects; flags })
32
33let script script = Effect.perform (Script { script })
34let extern ext = Effect.perform (External { ext })
35
36let link ~output ~linker ~objects ~flags =
37 Effect.perform (Link { output; linker; objects; flags })
38
39let run_script mgr ~build_dir s =
40 let cmd = [ "sh"; "-c"; s ] in
41 Log_file.with_log_file ~build_dir ~name:(Digest.to_hex (Digest.string s))
42 @@ fun (tmp_path, log_file) ->
43 try Eio.Process.run mgr cmd ~stdout:log_file ~stderr:log_file
44 with exn ->
45 (try
46 let log = Log_file.get tmp_path in
47 Util.log_clear "❌ script failed %s\n%s" s log
48 with _ -> ());
49 raise exn
50
51let run_external (e : Build.External.t) executed =
52 let zenon_bin = Sys.executable_name in
53 let start = Unix.gettimeofday () in
54 Util.log_clear "◎ %s:%s" e.path e.target;
55 let name =
56 Digest.to_hex @@ Digest.string @@ Format.sprintf "%s:%s" e.path e.target
57 in
58 Log_file.with_log_file ~build_dir:e.Build.External.build.Build.build ~name
59 @@ fun (tmp_file, log_file) ->
60 try
61 Eio.Process.run e.Build.External.build.Build.env#process_mgr
62 ~stderr:log_file ~stdout:log_file
63 ~cwd:Eio.Path.(e.Build.External.build.Build.env#fs / e.path)
64 [ zenon_bin; "build"; e.target ];
65 Util.log_clear "✓ %s:%s (%fsec)" e.path e.target
66 (Unix.gettimeofday () -. start);
67 Hashtbl.add executed (Node.node_id (External e)) ()
68 with _exn ->
69 let log = Log_file.get tmp_file in
70 Util.log_clear "%s" log;
71 raise (Build_failed "")
72
73let handle (build : Build.t) ~visited ~sw f =
74 let checker = Command.v build.env#process_mgr in
75 try f () with
76 | effect Script { script }, k ->
77 Util.log ~verbose:(Util.is_verbose build.log_level) "• SCRIPT %s" script;
78 run_script build.Build.env#process_mgr ~build_dir:build.build script;
79 continue k ()
80 | effect External { ext }, k ->
81 run_external ext visited;
82 continue k ()
83 | effect Compile { compiler; output; objects; flags }, k ->
84 let obj =
85 Compiler.compile_obj compiler ~checker ~output ~sw
86 ~log_level:build.log_level ~build_dir:build.build
87 ~build_mtime:build.mtime ~env:build.env ~objects flags
88 in
89 let obj = Option.map (fun (a, b) -> (a, Process b)) obj in
90 continue k obj
91 | effect Link { output; linker; objects; flags }, k ->
92 (if Util.is_debug build.log_level then
93 let link_cmd = linker.command ~flags ~objs:objects ~output in
94 Util.log " $ %s" (String.concat " " link_cmd));
95 Linker.link linker build.env#process_mgr ~checker ~objs:objects ~output
96 ~flags ~build_dir:build.build;
97 continue k ()
98
99let wait_process (log_path, Process process) =
100 Eio.Process.await_exn process;
101 Eio.Path.unlink log_path
102
103let build_error (b : Build.t) (obj : Object_file.t) ~cmd ~exn (log_path, _) =
104 let log = Log_file.get ~unlink:true log_path in
105 let filepath = Util.relative_to b.source obj.source.path in
106 Util.log_error ~log_output:log ~filepath ~target:b.name
107 ~command:(String.concat " " cmd) ~exn ();
108 raise (Build_failed b.name)