Extract #define's using @whitequark's hack

src/configurator/extract_obj.mli

@@ -0,0 +1,4 @@
+(** Read and extract the strings between a pair of BEGIN-\d+- and -END
+    delimiters. This is used to extract the copmile time values from .obj
+    files *)
+val extract : (int * string) list -> Lexing.lexbuf -> (int * string) list

src/configurator/extract_obj.mll

@@ -0,0 +1,11 @@
+{}
+rule extract acc = parse
+  | "BEGIN-" (['0' - '9']+ as i) "-"
+      { read acc (int_of_string i) (Buffer.create 8) lexbuf }
+  | _ { extract acc lexbuf }
+  | eof { List.rev acc }
+and read acc i b = parse
+  | "-END" { extract ((i, Buffer.contents b) :: acc) lexbuf }
+  | _ as c { Buffer.add_char b c; read acc i b lexbuf }
+  | eof { failwith "Unterminated BEGIN-" }
+{}

src/configurator/jbuild

@@ -1,3 +1,5 @@
+(ocamllex (extract_obj))
+
 (library
  ((name configurator)
   (public_name jbuilder.configurator)

src/configurator/v1.ml

@@ -1,4 +1,5 @@
 open Stdune
+
 let sprintf = Printf.sprintf
 let eprintf = Printf.eprintf
 
@@ -7,6 +8,7 @@ let ( ^/ ) = Filename.concat
 exception Fatal_error of string
 
 module String_map = Stdune.Map.Make(Stdune.String)
+module Int_map = Stdune.Map.Make(Stdune.Int)
 
 let die fmt =
   Printf.ksprintf (fun s ->
@@ -231,7 +233,7 @@ let need_to_compile_and_link_separately t =
   | "msvc" -> true
   | _      -> false
 
-let compile_c_prog t ?(c_flags=[]) ?(link_flags=[]) code =
+let compile_and_link_c_prog t ?(c_flags=[]) ?(link_flags=[]) code =
   let dir = t.dest_dir ^/ sprintf "c-test-%d" (gen_id t) in
   Unix.mkdir dir 0o777;
   let base = dir ^/ "test" in
@@ -248,53 +250,47 @@ let compile_c_prog t ?(c_flags=[]) ?(link_flags=[]) code =
   in
   let ok =
     if need_to_compile_and_link_separately t then
-      run_ok (c_flags @ ["-I"; t.stdlib_dir; "-c"; c_fname]) &&
+      run_ok (c_flags @ ["-I"; t.stdlib_dir; "-c"; c_fname])
-      run_ok ("-o" :: exe_fname :: obj_fname :: link_flags)
+      && run_ok ("-o" :: exe_fname :: obj_fname :: link_flags)
     else
       run_ok
         (List.concat
            [ c_flags
-           ; [ "-I"; t.stdlib_dir
+           ; [ "-I" ; t.stdlib_dir
-             ; "-o"; exe_fname
+             ; "-o" ; exe_fname
              ; c_fname
              ]
-           ; link_flags
            ])
   in
-  if ok then Ok exe_fname else Error ()
+  if ok then Ok () else Error ()
 
-let pp_c_prog t ?(c_flags=[]) code =
+let compile_c_prog t ?(c_flags=[]) code =
-  let c_flags = "-E" :: c_flags in
   let dir = t.dest_dir ^/ sprintf "c-test-%d" (gen_id t) in
   Unix.mkdir dir 0o777;
   let base = dir ^/ "test" in
   let c_fname = base ^ ".c" in
+  let obj_fname = base ^ t.ext_obj in
   Io.write_file c_fname code;
-  logf t "preprocessing c program:";
+  logf t "compiling c program:";
   List.iter (String.split_lines code) ~f:(logf t " | %s");
   let run_ok args =
-    try
+    run_ok t ~dir
-      Ok (
+      (String.concat ~sep:" "
-        run_capture_exn t ~dir
+         (t.c_compiler :: List.map args ~f:Filename.quote))
-          (String.concat ~sep:" "
-             (t.c_compiler :: List.map args ~f:Filename.quote))
-      )
-    with e ->
-      Error e
   in
-  if need_to_compile_and_link_separately t then
+  let ok =
-    run_ok (c_flags @ ["-I"; t.stdlib_dir; "-c"; c_fname])
+    run_ok (List.concat
-  else
+              [ c_flags
-    run_ok
+              ; [ "-I" ; t.stdlib_dir
-      (List.concat
+                ; "-o" ; obj_fname
-         [ c_flags
+                ; "-c" ; c_fname
-         ; [ "-I"; t.stdlib_dir
+                ]
-           ; c_fname
+              ])
-           ]
+  in
-         ])
+  if ok then Ok obj_fname else Error ()
 
 let c_test t ?c_flags ?link_flags code =
-  match compile_c_prog t ?c_flags ?link_flags code with
+  match compile_and_link_c_prog t ?c_flags ?link_flags code with
   | Ok    _ -> true
   | Error _ -> false
 
@@ -313,58 +309,80 @@ module C_define = struct
       | String of string
   end
 
-  let import t ?prelude ?c_flags ?link_flags ~includes vars =
+  let extract_program ?prelude includes vars =
-    Option.iter link_flags ~f:(fun link_flags ->
+    let has_type t = List.exists vars ~f:(fun (_, t') -> t = t') in
-      Format.eprintf
-        "Configurator.C_define.import: link_flags argument is always ignored@.\
-        ~link_flags:[%a]"
-        (Format.pp_print_list
-           ~pp_sep:(fun fmt () -> Format.fprintf fmt " ;@,")
-           (fun fmt s -> Format.fprintf fmt "%S" s)) link_flags
-    );
     let buf = Buffer.create 1024 in
     let pr fmt = Printf.bprintf buf (fmt ^^ "\n") in
-    let prefix = "--- configurator " in
-    let pr_cfg fmt =
-      Buffer.add_string buf prefix;
-      Printf.bprintf buf (fmt ^^ "\n") in
-    let includes = "stdio.h" :: includes in
     List.iter includes ~f:(pr "#include <%s>");
     pr "";
     Option.iter prelude ~f:(pr "%s");
-    List.iter vars ~f:(fun (name, (kind : Type.t)) ->
+    if has_type Type.Int then (
-      match kind with
+      pr {|
-      | Switch ->
+#define D0(x) ('0'+(x/1         )%%10)
-        pr {|#if defined(%s)|} name;
+#define D1(x) ('0'+(x/10        )%%10), D0(x)
-        pr_cfg "%S=b:true" name;
+#define D2(x) ('0'+(x/100       )%%10), D1(x)
-        pr {|#else|};
+#define D3(x) ('0'+(x/1000      )%%10), D2(x)
-        pr_cfg "%S=b:false" name;
+#define D4(x) ('0'+(x/10000     )%%10), D3(x)
-        pr {|#endif|}
+#define D5(x) ('0'+(x/100000    )%%10), D4(x)
-      | Int ->
+#define D6(x) ('0'+(x/1000000   )%%10), D5(x)
-        pr_cfg "%S=i:%s" name name;
+#define D7(x) ('0'+(x/10000000  )%%10), D6(x)
+#define D8(x) ('0'+(x/100000000 )%%10), D7(x)
+#define D9(x) ('0'+(x/1000000000)%%10), D8(x)
+|}
+    );
+    List.iteri vars ~f:(fun i (name, t) ->
+      match t with
+      | Type.Int ->
+        let c_arr_i =
+          let b = Buffer.create 8 in
+          let is = string_of_int i in
+          for i=0 to String.length is - 1 do
+            Printf.bprintf b "'%c', " is.[i]
+          done;
+          Buffer.contents b
+        in
+        pr {|
+const char s%i[] = {
+  'B', 'E', 'G', 'I', 'N', '-', %s'-',
+  D9((%s)),
+  '-', 'E', 'N', 'D'
+};
+|} i c_arr_i name
       | String ->
-        pr_cfg "%S=s:%s" name name);
+        pr {|const char *s%i = "BEGIN-%i-" %s "-END";|} i i name;
-    let code = Buffer.contents buf in
+      | Switch ->
-    match pp_c_prog t ?c_flags code with
+        pr {|
+#ifdef %s
+const char *s%i = "BEGIN-%i-true-END";
+#else
+const char *s%i = "BEGIN-%i-false-END";
+#endif
+|} name i i i i
+    );
+    Buffer.contents buf
+
+  let extract_values obj_file vars =
+    let values =
+      Io.with_lexbuf_from_file obj_file ~f:(Extract_obj.extract [])
+      |> Int_map.of_list_exn
+    in
+    List.mapi vars ~f:(fun i (name, t) ->
+      let value =
+        let raw_val =
+          match Int_map.find values i with
+          | None -> die "Unable to get value for %s" name
+          | Some v -> v in
+        match t with
+        | Type.Switch -> Value.Switch (bool_of_string raw_val)
+        | Int -> Int (int_of_string raw_val)
+        | String -> String raw_val in
+      (name, value))
+
+  let import t ?prelude ?c_flags ~includes vars =
+    let program = extract_program ?prelude ("stdio.h" :: includes) vars in
+    match compile_c_prog t ?c_flags program with
     | Error _ -> die "failed to compile program"
-    | Ok pped_lines ->
+    | Ok obj -> extract_values obj vars
-      String.split_lines pped_lines
-      |> List.filter_map ~f:(fun l ->
-        try
-          Scanf.sscanf l "--- configurator %S=%[ibs]:%s" (fun name typ v ->
-            Some (
-              ( name
-              , match typ with
-              | "b" -> Value.Switch (bool_of_string v)
-              | "i" -> Int (int_of_string v)
-              | "s" -> String v
-              | _ -> assert false)
-            )
-          )
-        with
-        | End_of_file
-        | Scanf.Scan_failure _ -> None
-      )
 
   let gen_header_file t ~fname ?protection_var vars =
     let protection_var =
@@ -402,7 +420,6 @@ module C_define = struct
     Sys.rename tmp_fname fname
 end
 
-
 let find_in_path t prog =
   logf t "find_in_path: %s" prog;
   let x = Find_in_path.find prog in

src/configurator/v1.mli

@@ -48,7 +48,6 @@ module C_define : sig
     (** Define extra code be used with extracting values below. Note that the
         compiled code is never executed. *)
     -> ?c_flags:   string list
-    -> ?link_flags:string list (** @deprecated, this argument is ignored *)
     -> includes:   string list
     -> (string * Type.t ) list
     -> (string * Value.t) list