diff --git a/src/configurator/v1.ml b/src/configurator/v1.ml index 697c28b6e3a..30e51f3f900 100644 --- a/src/configurator/v1.ml +++ b/src/configurator/v1.ml @@ -322,6 +322,11 @@ module C_define = struct | Switch | Int | String + + let name = function + | Switch -> "bool" + | Int -> "int" + | String -> "string" end module Value = struct @@ -329,6 +334,9 @@ module C_define = struct | Switch of bool | Int of int | String of string + + let switch b = Switch b + let int i = Int i end let extract_program ?prelude includes vars = @@ -351,7 +359,7 @@ module C_define = struct #define DUNE_D7(x) ('0'+(DUNE_ABS(x)/10000000 )%%10), DUNE_D6(x) #define DUNE_D8(x) ('0'+(DUNE_ABS(x)/100000000 )%%10), DUNE_D7(x) #define DUNE_D9(x) ('0'+(DUNE_ABS(x)/1000000000)%%10), DUNE_D8(x) -#define DUNE_SIGN(x) ((x >= 0)? '+': '-') +#define DUNE_SIGN(x) ((x >= 0)? '0': '-') |} ); List.iteri vars ~f:(fun i (name, t) -> @@ -392,15 +400,32 @@ const char *s%i = "BEGIN-%i-false-END"; |> Int.Map.of_list_exn in List.mapi vars ~f:(fun i (name, t) -> + let raw_val = + match Int.Map.find values i with + | None -> die "Unable to get value for %s" name + | Some v -> v + in 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 + | Type.Switch -> + Bool.of_string raw_val + |> Option.map ~f:Value.switch + | Int -> + Int.of_string raw_val + |> Option.map ~f:Value.int + | String -> Some (String raw_val) + in + let value = + match value with + | Some v -> v + | None -> + let msg = + sprintf "Unable to read variable %S of type %s. \ + Invalid value %S in %s found" + name (Type.name t) raw_val obj_file + in + raise (Fatal_error msg) + in (name, value)) let import t ?prelude ?c_flags ~includes vars = @@ -545,4 +570,5 @@ let main ?(args=[]) ~name f = | Fatal_error msg -> eprintf "Error: %s\n%!" msg; exit 1 - | _ -> Exn.raise_with_backtrace exn bt + | _ -> + Exn.raise_with_backtrace exn bt diff --git a/src/stdune/bool.ml b/src/stdune/bool.ml index 6400a5acefc..0b9893e1177 100644 --- a/src/stdune/bool.ml +++ b/src/stdune/bool.ml @@ -8,3 +8,5 @@ let compare x y = | false, true -> Lt let to_string = string_of_bool + +let of_string s = Option.try_with (fun () -> bool_of_string s) diff --git a/src/stdune/bool.mli b/src/stdune/bool.mli index d0ff8707a2a..cc3d0b1618f 100644 --- a/src/stdune/bool.mli +++ b/src/stdune/bool.mli @@ -3,3 +3,5 @@ type t = bool val compare : t -> t -> Ordering.t val to_string : t -> string + +val of_string : string -> t option diff --git a/src/stdune/int.ml b/src/stdune/int.ml index facc6af0754..844477ad0d6 100644 --- a/src/stdune/int.ml +++ b/src/stdune/int.ml @@ -28,3 +28,5 @@ let of_string_exn s = let to_string i = string_of_int i module Infix = Comparable.Operators(T) + +let of_string s = Option.try_with (fun () -> int_of_string s) diff --git a/src/stdune/int.mli b/src/stdune/int.mli index a9c415e952a..74dfe3ec96d 100644 --- a/src/stdune/int.mli +++ b/src/stdune/int.mli @@ -8,6 +8,7 @@ module Set : Set.S with type elt = t module Map : Map.S with type key = t val of_string_exn : string -> t +val of_string : string -> t option val to_string : t -> string diff --git a/src/stdune/option.ml b/src/stdune/option.ml index 611c39a6285..f74f0989592 100644 --- a/src/stdune/option.ml +++ b/src/stdune/option.ml @@ -71,3 +71,8 @@ let compare cmp x y = | Some _, None -> Gt | None, Some _ -> Lt | Some x, Some y -> cmp x y + +let try_with f = + match f () with + | exception _ -> None + | s -> Some s diff --git a/src/stdune/option.mli b/src/stdune/option.mli index 5cf8f0f0bdd..d7c1da34659 100644 --- a/src/stdune/option.mli +++ b/src/stdune/option.mli @@ -32,3 +32,5 @@ val to_list : 'a t -> 'a list val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool val compare : ('a -> 'a -> Ordering.t) -> 'a t -> 'a t -> Ordering.t + +val try_with : (unit -> 'a) -> 'a option