Source file ppxsetup.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
open Std
type t = { ppxs : string list; ppxopts : string list list String.Map.t }
let empty = { ppxs = []; ppxopts = String.Map.empty }
let add_ppx ppx t =
if List.mem ppx ~set:t.ppxs then t else { t with ppxs = ppx :: t.ppxs }
let add_ppxopts ppx opts t =
match opts with
| [] -> t
| opts ->
let ppx = Filename.basename ppx in
let optss = try String.Map.find ppx t.ppxopts with Not_found -> [] in
if not (List.mem ~set:optss opts) then
let ppxopts = String.Map.add ~key:ppx ~data:(opts :: optss) t.ppxopts in
{ t with ppxopts }
else t
let union ta tb =
{ ppxs = List.filter_dup (ta.ppxs @ tb.ppxs);
ppxopts =
String.Map.merge
~f:(fun _ a b ->
match (a, b) with
| v, None | None, v -> v
| Some a, Some b -> Some (List.filter_dup (a @ b)))
ta.ppxopts tb.ppxopts
}
let command_line t =
List.fold_right
~f:(fun ppx ppxs ->
let basename = Filename.basename ppx in
let opts =
try String.Map.find basename t.ppxopts with Not_found -> []
in
let opts = List.concat (List.rev opts) in
String.concat ~sep:" " (ppx :: opts) :: ppxs)
t.ppxs ~init:[]
let dump t =
let string k = `String k in
let string_list l = `List (List.map ~f:string l) in
`Assoc
[ ("preprocessors", string_list t.ppxs);
( "options",
`Assoc
(String.Map.fold
~f:(fun ~key ~data:opts acc ->
let opts = List.rev_map ~f:string_list opts in
(key, `List opts) :: acc)
~init:[] t.ppxopts) )
]