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
open Ppxlib
let tag = "config"
let user_env =
Unix.environment () |> Array.to_list
|> List.map (fun kv ->
let[@warning "-8"] (k :: v) = String.split_on_char '=' kv in
(k, String.concat "=" v))
let env =
user_env
@ [
("target_os", Cfg.target_os);
("target_arch", Cfg.target_arch);
("target_env", Cfg.target_env);
]
|> List.sort_uniq (fun (k1, _) (k2, _) -> String.compare k1 k2)
let () =
if Option.is_some (Sys.getenv_opt "CONFIG_DEBUG") then (
Format.printf "Config PPX running with environment:\n\n%!";
List.iter (fun (k, v) -> Format.printf " %s = %S\r\n" k v) env;
Format.printf "\n%!")
let env = List.map (fun (k, v) -> (k, Cfg_lang.Parser.String v)) env
let should_keep_module attr =
let loc = attr.attr_loc in
match attr.attr_payload with
| PStr payload ->
let payload = Pprintast.string_of_structure payload in
let payload = String.sub payload 2 (String.length payload - 2) in
if Cfg_lang.eval ~loc ~env payload then `keep else `drop
| _ -> failwith "invalid payload"
let apply_config stri =
try
match stri.pstr_desc with
| Pstr_module { pmb_attributes = [ attr ]; _ } ->
if should_keep_module attr = `keep then Some stri else None
| _ -> Some stri
with Cfg_lang.Error { loc; error } ->
let ext = Location.error_extensionf ~loc "%s" error in
Some (Ast_builder.Default.pstr_extension ~loc ext [])
let preprocess_impl str =
match str with
| { pstr_desc = Pstr_attribute attr; _ } :: rest
when String.equal attr.attr_name.txt tag ->
if should_keep_module attr = `keep then rest else []
| _ -> List.filter_map apply_config str
let () = Driver.register_transformation tag ~preprocess_impl