Source file ninja_utils.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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
(** Ninja variable names *)
module Var = struct
type t = V of string
let make s = V s
let name (V v) = v
let v (V v) = Printf.sprintf "${%s}" v
end
module Expr = struct
type t = string list
let format =
let esc_re =
Re.(compile (alt [space; char ':']))
in
Format.pp_print_list
~pp_sep:(fun fmt () -> Format.pp_print_char fmt ' ')
(fun fmt s ->
Format.pp_print_string fmt
(Re.replace esc_re s
~f:(fun g -> "$" ^ Re.Group.get g 0)))
end
module Binding = struct
type t = Var.t * Expr.t
let make var e = var, e
let format ~global ppf (v, e) =
if not global then Format.pp_print_string ppf " ";
Format.fprintf ppf "%s = %a" (Var.name v) Expr.format e
let format_list ~global ppf l =
Format.pp_print_list ~pp_sep:Format.pp_print_newline (format ~global) ppf l
end
module Rule = struct
type t = {
name : string;
command : Expr.t;
description : Expr.t option;
vars : Binding.t list;
}
let make ?(vars = []) name ~command ~description =
{ name; command; description = Option.some description; vars }
let format fmt rule =
let bindings =
Binding.make (Var.make "command") rule.command
:: Option.(
to_list
(map
(fun d -> Binding.make (Var.make "description") d)
rule.description))
@ rule.vars
in
Format.fprintf fmt "rule %s\n%a" rule.name
(Binding.format_list ~global:false)
bindings
end
module Build = struct
type t = {
rule : string;
inputs : Expr.t option;
implicit_in : Expr.t;
outputs : Expr.t;
implicit_out : Expr.t option;
vars : Binding.t list;
}
let make ?inputs ?(implicit_in = []) ~outputs ?implicit_out ?(vars = []) rule
=
{ rule; inputs; implicit_in; outputs; implicit_out; vars }
let empty = make ~outputs:["empty"] "phony"
let unpath ?(sep = "-") path =
Re.replace_string Re.(compile (str Filename.dir_sep)) ~by:sep path
let format fmt t =
Format.fprintf fmt "build %a%a: %s%a%a%a%a" Expr.format t.outputs
(Format.pp_print_option (fun fmt i ->
Format.pp_print_string fmt " | ";
Expr.format fmt i))
t.implicit_out t.rule
(Format.pp_print_option (fun ppf e ->
Format.pp_print_char ppf ' ';
Expr.format ppf e))
t.inputs
(fun ppf -> function
| [] -> ()
| e ->
Format.pp_print_string ppf " | ";
Expr.format ppf e)
t.implicit_in
(if t.vars = [] then fun _ () -> () else Format.pp_print_newline)
()
(Binding.format_list ~global:false)
t.vars
end
module Default = struct
type t = Expr.t
let make rules = rules
let format ppf t = Format.fprintf ppf "default %a" Expr.format t
end
type def =
| Binding of Binding.t
| Rule of Rule.t
| Build of Build.t
| Default of Default.t
let s = Comment s
let binding v e = Binding (Binding.make v e)
let rule ?vars name ~command ~description =
Rule (Rule.make ?vars name ~command ~description)
let build ?inputs ?implicit_in ~outputs ?implicit_out ?vars rule =
Build (Build.make ?inputs ?implicit_in ~outputs ?implicit_out ?vars rule)
let default rules = Default (Default.make rules)
let format_def ppf def =
let () =
match def with
| Comment s ->
Format.pp_print_list ~pp_sep:Format.pp_print_newline
(fun ppf s ->
if s <> "" then Format.pp_print_string ppf "# ";
Format.pp_print_string ppf s)
ppf
(String.split_on_char '\n' s)
| Binding b -> Binding.format ~global:true ppf b
| Rule r ->
Rule.format ppf r;
Format.pp_print_newline ppf ()
| Build b -> Build.format ppf b
| Default d -> Default.format ppf d
in
Format.pp_print_flush ppf ()
type ninja = def Seq.t
let format ppf t =
Format.pp_print_seq ~pp_sep:Format.pp_print_newline format_def ppf t;
Format.pp_print_newline ppf ()