package b0

  1. Overview
  2. Docs
Software construction and deployment kit

Install 

dune-project
 Dependency

erratique.ch Readme Changelog ISC; BSD-2-Clause License Edit opam file Versions (2)

Authors

  1. T
    The b0 programmers

Maintainers

  1. Daniel Bünzli

Sources

b0-0.0.6.tbz
sha512=e9aa779e66c08fc763019f16d4706f465d16c05d6400b58fbd0313317ef33ddea51952e2b058db28e65f7ddb7012f328c8bf02d8f1da17bb543348541a2587f0

doc/src/b0.memo/b0_build_trace.ml.html

Source file b0_build_trace.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
(*---------------------------------------------------------------------------
   Copyright (c) 2017 The b0 programmers. All rights reserved.
   SPDX-License-Identifier: ISC
  ---------------------------------------------------------------------------*)

open B0_std
open B0_json
open B0_zero

let fpath p = Jsong.string (Fpath.to_string p)
let jsong_cmd c = Jsong.(list string (Cmd.to_list c))

module Trace_event = struct
  let str pp get o = Jsong.strf "%a" pp (get o)
  let span_us s =
    let span_us = Int64.(to_int @@ div (Mtime.Span.to_uint64_ns s) 1000L) in
    Jsong.int span_us

  let result ~ok = function
  | Error e -> Jsong.string e | Ok v -> Jsong.string (ok v)

  let unit_result = result ~ok:(fun () -> "ok")
  let bool_result = result ~ok:string_of_bool
  let string_result = result ~ok:(fun s -> s)
  let spawn_exit = function
  | None -> Jsong.(obj |> obj_end)
  | Some (`Exited c) -> Jsong.(obj |> mem "exited" (int c) |> obj_end)
  | Some (`Signaled c) -> Jsong.(obj |> mem "signaled" (int c) |> obj_end)

  let spawn_stdo_ui s = match Op.Spawn.stdo_ui s with
  | None -> "none"
  | Some (Ok d) -> d
  | Some (Error e) -> Fmt.str "error: %s" e

  let writes_manifest_root o obj = match Op.writes_manifest_root o with
  | None -> obj
  | Some root -> Jsong.mem "writes-manifest-root" (fpath root) obj

  let args o =
    let kind_mems obj = match Op.kind o with
    | Op.Copy c ->
        obj
        |> Jsong.mem "src" (fpath (Op.Copy.src c))
        |> Jsong.mem "dst" (fpath (Op.Copy.dst c))
        |> Jsong.mem "mode" (Jsong.strf "%o" (Op.Copy.mode c))
        |> Jsong.mem "linenum" (Jsong.(option int) (Op.Copy.linenum c))
    | Op.Delete d ->
        obj |> Jsong.mem "path" (fpath (Op.Delete.path d))
    | Op.Mkdir m ->
        obj |> Jsong.mem "dir" (fpath (Op.Mkdir.dir m))
    | Op.Notify n ->
        obj
        |> Jsong.mem "kind"
          (Jsong.string
             (B0_zero_conv.Op.notify_kind_to_string (B0_zero.Op.Notify.kind n)))
        |> Jsong.mem "msg" (Jsong.string (Op.Notify.msg n))
    | Op.Read r ->
        obj |> Jsong.mem "file" (fpath (Op.Read.file r))
    | Op.Spawn s ->
        let cmd = Cmd.(path (Op.Spawn.tool s) %% (Op.Spawn.args s)) in
        obj
        |> Jsong.mem "cmd" (jsong_cmd cmd)
        |> Jsong.mem "exit" (spawn_exit (Op.Spawn.exit s))
        |> Jsong.mem "cwd" (fpath (Op.Spawn.cwd s))
        |> Jsong.mem "env" (Jsong.(list string) (Op.Spawn.env s))
        |> Jsong.mem "success-exits"
          (Jsong.(list int) (Op.Spawn.success_exits s))
        |> Jsong.mem "stdo-ui" (Jsong.string (spawn_stdo_ui s))
    | Op.Wait_files _ -> obj
    | Op.Write w ->
        obj
        |> Jsong.mem "file" (fpath (Op.Write.file w))
        |> Jsong.mem "stamp" (Jsong.string (Op.Write.stamp w))
        |> Jsong.mem "mode" (Jsong.strf "%o" (Op.Write.mode w))
    in
    (* The order here is for the viewer. *)
    Jsong.obj
    |> Jsong.mem "kind" (Jsong.string (Op.kind_name (Op.kind o)))
    |> Jsong.mem "mark" (Jsong.string (Op.mark o))
    |> Jsong.mem "status"
      (Jsong.string (B0_zero_conv.Op.status_to_string (Op.status o)))
    |> Jsong.mem "revived" (Jsong.bool (Op.revived o))
    |> Jsong.mem "writes" (Jsong.(list fpath) (Op.writes o))
    |> writes_manifest_root o
    |> Jsong.mem "time-created" (span_us (Op.time_created o))
    |> kind_mems
    |> Jsong.mem "reads" (Jsong.(list fpath) (Op.reads o))
    |> Jsong.mem "hash" (Jsong.string (B0_hash.to_hex (Op.hash o)))
    |> Jsong.obj_end

  let op o =
    let id o = Jsong.string (string_of_int @@ Op.id o) in
    let cat o = Jsong.string @@ Op.kind_name (Op.kind o) in
    Jsong.obj
    |> Jsong.mem "name" (id o)
    |> Jsong.mem "cat" (cat o)
    |> Jsong.mem "ph" (Jsong.string "X")
    |> Jsong.mem "ts" (span_us (Op.time_started o))
    |> Jsong.mem "dur" (span_us (Op.duration o))
    |> Jsong.mem "pid" (Jsong.int 1)
    |> Jsong.mem "tid" (Jsong.int 1)
    |> Jsong.mem "args" (args o)
    |> Jsong.obj_end

  let of_ops os = Jsong.list op os
end

module Compilation_database = struct
  let spawn_out o spawn src arr out_file =
    let cmd = Cmd.(path (Op.Spawn.tool spawn) %% (Op.Spawn.args spawn)) in
    arr |> Jsong.el begin
      Jsong.obj
      |> Jsong.mem "directory" (fpath (Op.Spawn.cwd spawn))
      |> Jsong.mem "file" (fpath src)
      |> Jsong.mem "arguments" (jsong_cmd cmd)
      |> Jsong.mem "output" (fpath out_file)
      |> Jsong.mem "id" (Jsong.int (Op.id o))
      |> Jsong.obj_end
    end

  let add_op arr o = match Op.kind o with
  | Op.Spawn s ->
      let src = match Op.reads o with [] -> Fpath.null | fs -> List.hd fs in
      List.fold_left (spawn_out o s src) arr (Op.writes o)
  | _ -> arr

  let of_ops os = Jsong.array_end (List.fold_left add_op Jsong.array os)
end