Port configurator to dune
This commit is contained in:
Rudi Grinberg
parent
9b6abc4014
commit
3e73397638
|
|
@ -1,18 +1,14 @@
|
|||
open Base
|
||||
open Stdio
|
||||
|
||||
module Sys = Caml.Sys
|
||||
module Fn = Caml.Filename
|
||||
module Arg = Caml.Arg
|
||||
module Buffer = Caml.Buffer
|
||||
module Pervasives = Caml.Pervasives
|
||||
|
||||
let ( ^^ ) = Caml.( ^^ )
|
||||
let ( ^/ ) = Fn.concat
|
||||
open Stdune
|
||||
let sprintf = Printf.sprintf
|
||||
let eprintf = Printf.eprintf
|
||||
module Io = Jbuilder.Io
|
||||
|
||||
let ( ^/ ) = Filename.concat
|
||||
|
||||
exception Fatal_error of string
|
||||
|
||||
module String_map = Stdune.Map.Make(Stdune.String)
|
||||
|
||||
let die fmt =
|
||||
Printf.ksprintf (fun s ->
|
||||
raise (Fatal_error s);
|
||||
|
|
@ -28,7 +24,7 @@ type t =
|
|||
; c_compiler : string
|
||||
; stdlib_dir : string
|
||||
; ccomp_type : string
|
||||
; ocamlc_config : string Map.M(String).t
|
||||
; ocamlc_config : string String_map.t
|
||||
; ocamlc_config_cmd : string
|
||||
}
|
||||
|
||||
|
|
@ -47,11 +43,11 @@ module Temp = struct
|
|||
let prng = lazy(Random.State.make_self_init ())
|
||||
|
||||
let gen_name ~temp_dir ~prefix ~suffix =
|
||||
let rnd = Int.bit_and (Random.State.bits (Lazy.force prng)) 0xFFFFFF in
|
||||
let rnd = Random.State.bits (Lazy.force prng) land 0xFFFFFF in
|
||||
temp_dir ^/ (Printf.sprintf "%s%06x%s" prefix rnd suffix)
|
||||
|
||||
let create ~prefix ~suffix ~mk =
|
||||
let temp_dir = Fn.get_temp_dir_name () in
|
||||
let temp_dir = Filename.get_temp_dir_name () in
|
||||
let rec try_name counter =
|
||||
let name = gen_name ~temp_dir ~prefix ~suffix in
|
||||
match mk name with
|
||||
|
|
@ -63,7 +59,7 @@ module Temp = struct
|
|||
|
||||
let create_temp_dir ~prefix ~suffix =
|
||||
let dir = create ~prefix ~suffix ~mk:(fun name -> Unix.mkdir name 0o700) in
|
||||
Caml.at_exit (fun () -> rm_rf dir);
|
||||
at_exit (fun () -> rm_rf dir);
|
||||
dir
|
||||
end
|
||||
|
||||
|
|
@ -129,7 +125,7 @@ let quote =
|
|||
in
|
||||
fun s ->
|
||||
if String.is_empty s || String.exists ~f:need_quote s
|
||||
then Fn.quote s
|
||||
then Filename.quote s
|
||||
else s
|
||||
|
||||
let command_line prog args =
|
||||
|
|
@ -143,13 +139,13 @@ let run t ~dir cmd =
|
|||
let exit_code =
|
||||
Printf.ksprintf
|
||||
Sys.command "cd %s && %s > %s 2> %s"
|
||||
(Fn.quote dir)
|
||||
(Filename.quote dir)
|
||||
cmd
|
||||
(Fn.quote stdout_fn)
|
||||
(Fn.quote stderr_fn)
|
||||
(Filename.quote stdout_fn)
|
||||
(Filename.quote stderr_fn)
|
||||
in
|
||||
let stdout = In_channel.read_all stdout_fn in
|
||||
let stderr = In_channel.read_all stderr_fn in
|
||||
let stdout = Io.read_file stdout_fn in
|
||||
let stderr = Io.read_file stderr_fn in
|
||||
logf t "-> process exited with code %d" exit_code;
|
||||
logf t "-> stdout:";
|
||||
List.iter (String.split_lines stdout) ~f:(logf t " | %s");
|
||||
|
|
@ -169,11 +165,11 @@ let run_capture_exn t ~dir cmd =
|
|||
let run_ok t ~dir cmd = (run t ~dir cmd).exit_code = 0
|
||||
|
||||
let get_ocaml_config_var_exn ~ocamlc_config_cmd map var =
|
||||
match Map.find map var with
|
||||
match String_map.find map var with
|
||||
| None -> die "variable %S not found in the output of `%s`" var ocamlc_config_cmd
|
||||
| Some s -> s
|
||||
|
||||
let ocaml_config_var t var = Map.find t.ocamlc_config var
|
||||
let ocaml_config_var t var = String_map.find t.ocamlc_config var
|
||||
let ocaml_config_var_exn t var =
|
||||
get_ocaml_config_var_exn t.ocamlc_config var
|
||||
~ocamlc_config_cmd:t.ocamlc_config_cmd
|
||||
|
|
@ -200,31 +196,23 @@ let create ?dest_dir ?ocamlc ?(log=ignore) name =
|
|||
; c_compiler = ""
|
||||
; stdlib_dir = ""
|
||||
; ccomp_type = ""
|
||||
; ocamlc_config = Map.empty (module String)
|
||||
; ocamlc_config = String_map.empty
|
||||
; ocamlc_config_cmd
|
||||
}
|
||||
in
|
||||
let ocamlc_config =
|
||||
let colon_space = String.Search_pattern.create ": " in
|
||||
run_capture_exn t ~dir:dest_dir ocamlc_config_cmd
|
||||
|> String.split_lines
|
||||
|> List.map ~f:(fun line ->
|
||||
match String.Search_pattern.index colon_space ~in_:line with
|
||||
| Some i ->
|
||||
(String.sub line ~pos:0 ~len:i,
|
||||
String.sub line ~pos:(i + 2) ~len:(String.length line - i - 2))
|
||||
| None ->
|
||||
die "unrecognized line in the output of `%s`: %s" ocamlc_config_cmd
|
||||
line)
|
||||
|> Map.of_alist (module String)
|
||||
|> function
|
||||
| `Ok x -> x
|
||||
| `Duplicate_key key ->
|
||||
die "variable %S present twice in the output of `%s`" key ocamlc_config_cmd
|
||||
let ocamlc_config_output =
|
||||
run_capture_exn t ~dir:dest_dir ocamlc_config_cmd
|
||||
|> String.split_lines
|
||||
in
|
||||
Jbuilder.Ocamlc_config.make
|
||||
~ocamlc:(Jbuilder.Path.of_string ocamlc)
|
||||
~ocamlc_config_output:ocamlc_config_output
|
||||
|> Jbuilder.Ocamlc_config.bindings
|
||||
in
|
||||
let get = get_ocaml_config_var_exn ocamlc_config ~ocamlc_config_cmd in
|
||||
let c_compiler =
|
||||
match Map.find ocamlc_config "c_compiler" with
|
||||
match String_map.find ocamlc_config "c_compiler" with
|
||||
| Some c_comp -> c_comp ^ " " ^ get "ocamlc_cflags"
|
||||
| None -> get "bytecomp_c_compiler"
|
||||
in
|
||||
|
|
@ -249,13 +237,13 @@ let compile_c_prog t ?(c_flags=[]) ?(link_flags=[]) code =
|
|||
let c_fname = base ^ ".c" in
|
||||
let obj_fname = base ^ t.ext_obj in
|
||||
let exe_fname = base ^ ".exe" in
|
||||
Out_channel.write_all c_fname ~data:code;
|
||||
Io.write_file c_fname code;
|
||||
logf t "compiling c program:";
|
||||
List.iter (String.split_lines code) ~f:(logf t " | %s");
|
||||
let run_ok args =
|
||||
run_ok t ~dir
|
||||
(String.concat ~sep:" "
|
||||
(t.c_compiler :: List.map args ~f:Fn.quote))
|
||||
(t.c_compiler :: List.map args ~f:Filename.quote))
|
||||
in
|
||||
let ok =
|
||||
if need_to_compile_and_link_separately t then
|
||||
|
|
@ -285,27 +273,6 @@ module C_define = struct
|
|||
| Switch
|
||||
| Int
|
||||
| String
|
||||
|
||||
let compare x y =
|
||||
match x, y with
|
||||
| Switch, Switch -> 0
|
||||
| Int, Int -> 0
|
||||
| String, String -> 0
|
||||
| Switch, (Int | String) -> 1
|
||||
| (Int | String), Switch -> -1
|
||||
| Int, String -> 1
|
||||
| String, Int -> -1
|
||||
|
||||
let sexp_of_t = function
|
||||
| Switch -> Sexp.Atom "switch"
|
||||
| Int -> Sexp.Atom "int"
|
||||
| String -> Sexp.Atom "string"
|
||||
|
||||
let t_of_sexp = function
|
||||
| Sexp.Atom "switch" -> Switch
|
||||
| Sexp.Atom "int" -> Int
|
||||
| Sexp.Atom "string" -> String
|
||||
| s -> raise (Sexp.Of_sexp_error (Failure "C_define.Type.t_of_sexp", s))
|
||||
end
|
||||
|
||||
module Value = struct
|
||||
|
|
@ -313,31 +280,6 @@ module C_define = struct
|
|||
| Switch of bool
|
||||
| Int of int
|
||||
| String of string
|
||||
|
||||
let compare x y =
|
||||
match x, y with
|
||||
| Switch x, Switch y -> Bool.compare x y
|
||||
| Int x, Int y -> Int.compare x y
|
||||
| String x, String y -> String.compare x y
|
||||
| Switch _, (Int _ | String _) -> 1
|
||||
| (Int _ | String _), Switch _ -> -1
|
||||
| Int _, String _ -> 1
|
||||
| String _, Int _ -> -1
|
||||
|
||||
let sexp_of_t =
|
||||
let open Sexp in
|
||||
function
|
||||
| Switch b -> List [Atom "switch"; Bool.sexp_of_t b]
|
||||
| Int i -> List [Atom "int"; Int.sexp_of_t i]
|
||||
| String s -> List [Atom "string"; String.sexp_of_t s]
|
||||
|
||||
let t_of_sexp =
|
||||
let open Sexp in
|
||||
function
|
||||
| List [Atom "switch"; x] -> Switch (Bool.t_of_sexp x)
|
||||
| List [Atom "int"; x] -> Int (Int.t_of_sexp x)
|
||||
| List [Atom "string"; x] -> String (String.t_of_sexp x)
|
||||
| s -> raise (Sexp.Of_sexp_error (Failure "C_define.Value.t_of_sexp", s))
|
||||
end
|
||||
|
||||
let import t ?c_flags ?link_flags ~includes vars =
|
||||
|
|
@ -366,14 +308,14 @@ module C_define = struct
|
|||
match compile_c_prog t ?c_flags ?link_flags code with
|
||||
| Error () -> die "failed to compile program"
|
||||
| Ok exe ->
|
||||
run_capture_exn t ~dir:(Fn.dirname exe) (command_line exe [])
|
||||
run_capture_exn t ~dir:(Filename.dirname exe) (command_line exe [])
|
||||
|> String.split_lines
|
||||
|> List.map ~f:(fun s : (string * Value.t) ->
|
||||
|> List.map ~f:(fun s ->
|
||||
let var, data = String.lsplit2_exn s ~on:'=' in
|
||||
(var,
|
||||
match String.lsplit2_exn data ~on:':' with
|
||||
| "b", s -> Switch (Bool.of_string s)
|
||||
| "i", s -> Int (Int. of_string s)
|
||||
| "b", s -> Value.Switch (bool_of_string s)
|
||||
| "i", s -> Int (int_of_string s)
|
||||
| "s", s -> String s
|
||||
| _ -> assert false))
|
||||
|
||||
|
|
@ -382,12 +324,13 @@ module C_define = struct
|
|||
match protection_var with
|
||||
| Some v -> v
|
||||
| None ->
|
||||
String.map (t.name ^ "_" ^ Fn.basename fname) ~f:(function
|
||||
| 'a'..'z' as c -> Char.uppercase c
|
||||
String.map (t.name ^ "_" ^ Filename.basename fname) ~f:(function
|
||||
| 'a'..'z' as c -> Char.uppercase_ascii c
|
||||
| 'A'..'Z' | '0'..'9' as c -> c
|
||||
| _ -> '_')
|
||||
in
|
||||
let vars = List.sort vars ~cmp:(fun (a, _) (b, _) -> String.compare a b) in
|
||||
let vars =
|
||||
List.sort vars ~compare:(fun (a, _) (b, _) -> String.compare a b) in
|
||||
let lines =
|
||||
List.map vars ~f:(fun (name, value) ->
|
||||
match (value : Value.t) with
|
||||
|
|
@ -408,7 +351,7 @@ module C_define = struct
|
|||
logf t "writing header file %s" fname;
|
||||
List.iter lines ~f:(logf t " | %s");
|
||||
let tmp_fname = fname ^ ".tmp" in
|
||||
Out_channel.write_lines tmp_fname lines;
|
||||
Io.write_lines tmp_fname lines;
|
||||
Sys.rename tmp_fname fname
|
||||
end
|
||||
|
||||
|
|
@ -448,7 +391,7 @@ module Pkg_config = struct
|
|||
match find_in_path c "brew" with
|
||||
| Some brew ->
|
||||
let prefix =
|
||||
String.strip (run_capture_exn c ~dir (command_line brew ["--prefix"]))
|
||||
String.trim (run_capture_exn c ~dir (command_line brew ["--prefix"]))
|
||||
in
|
||||
sprintf "env PKG_CONFIG_PATH=%s/opt/%s/lib/pkgconfig:$PKG_CONFIG_PATH "
|
||||
(quote prefix) package
|
||||
|
|
@ -460,7 +403,7 @@ module Pkg_config = struct
|
|||
if run_ok c ~dir (sprintf "%s%s %s" env pkg_config package) then
|
||||
let run what =
|
||||
match
|
||||
String.strip
|
||||
String.trim
|
||||
(run_capture_exn c ~dir (sprintf "%s%s %s %s" env pkg_config what package))
|
||||
with
|
||||
| "" -> []
|
||||
|
|
@ -489,7 +432,7 @@ let main ?(args=[]) ~name f =
|
|||
] @ args)
|
||||
in
|
||||
let anon s = raise (Arg.Bad (sprintf "don't know what to do with %s" s)) in
|
||||
let usage = sprintf "%s [OPTIONS]" (Fn.basename Sys.executable_name) in
|
||||
let usage = sprintf "%s [OPTIONS]" (Filename.basename Sys.executable_name) in
|
||||
Arg.parse args anon usage;
|
||||
let log_db = ref [] in
|
||||
let log s = log_db := s :: !log_db in
|
||||
|
|
@ -507,5 +450,5 @@ let main ?(args=[]) ~name f =
|
|||
match exn with
|
||||
| Fatal_error msg ->
|
||||
eprintf "Error: %s\n%!" msg;
|
||||
Caml.exit 1
|
||||
exit 1
|
||||
| exn -> raise exn
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
open Base
|
||||
|
||||
type t
|
||||
|
||||
val create
|
||||
|
|
@ -28,11 +26,6 @@ module C_define : sig
|
|||
| Switch (** defined/undefined *)
|
||||
| Int
|
||||
| String
|
||||
|
||||
val sexp_of_t : t -> Sexp.t
|
||||
val t_of_sexp : Sexp.t -> t
|
||||
|
||||
val compare : t -> t -> int
|
||||
end
|
||||
|
||||
module Value : sig
|
||||
|
|
@ -40,11 +33,6 @@ module C_define : sig
|
|||
| Switch of bool
|
||||
| Int of int
|
||||
| String of string
|
||||
|
||||
val sexp_of_t : t -> Sexp.t
|
||||
val t_of_sexp : Sexp.t -> t
|
||||
|
||||
val compare : t -> t -> int
|
||||
end
|
||||
|
||||
(** Import some #define from the given header files. For instance:
|
||||
|
|
@ -99,7 +87,7 @@ end with type configurator := t
|
|||
|
||||
(** Typical entry point for configurator programs *)
|
||||
val main
|
||||
: ?args:(Caml.Arg.key * Caml.Arg.spec * Caml.Arg.doc) list
|
||||
: ?args:(Arg.key * Arg.spec * Arg.doc) list
|
||||
-> name:string
|
||||
-> (t -> unit)
|
||||
-> unit
|
||||
|
|
|
|||
Loading…
Reference in New Issue