From c8943f946c4c3614db80e70c38c5ae7367ad433b Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Mon, 20 May 2019 09:26:50 -0700 Subject: [PATCH] [sledge] Change type of warn to be consistent with fail Summary: Require a final `()` argument to explicitly indicate the end of the arguments to the printf-like functions. For `warn` this is not any safer because the return type is `unit` anyhow, but for `fail` the return type is polymorphic so the final `()` prevents unintentionally forgetting an argument. Reviewed By: ngorogiannis Differential Revision: D15403367 fbshipit-source-id: ce3fe4035 --- sledge/src/import/import.ml | 2 +- sledge/src/import/import.mli | 2 +- sledge/src/llair/frontend.ml | 12 ++++++------ 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/sledge/src/import/import.ml b/sledge/src/import/import.ml index c1b87e23a..a3f47aafb 100644 --- a/sledge/src/import/import.ml +++ b/sledge/src/import/import.ml @@ -58,7 +58,7 @@ let warn fmt = Format.pp_open_box fs 2 ; Format.pp_print_string fs "Warning: " ; Format.kfprintf - (fun fs -> + (fun fs () -> Format.pp_close_box fs () ; Format.pp_force_newline fs () ) fs fmt diff --git a/sledge/src/import/import.mli b/sledge/src/import/import.mli index ddd80c2b3..acdd521a1 100644 --- a/sledge/src/import/import.mli +++ b/sledge/src/import/import.mli @@ -75,7 +75,7 @@ type ('a, 'b) fmt = ('a, Formatter.t, unit, 'b) format4 exception Unimplemented of string -val warn : ('a, unit) fmt -> 'a +val warn : ('a, unit -> unit) fmt -> 'a (** Issue a warning for a survivable problem. *) val todo : ('a, unit -> _) fmt -> 'a diff --git a/sledge/src/llair/frontend.ml b/sledge/src/llair/frontend.ml index 816554f76..d9e573f26 100644 --- a/sledge/src/llair/frontend.ml +++ b/sledge/src/llair/frontend.ml @@ -58,7 +58,7 @@ let (scan_locs : Llvm.llmodule -> unit), (find_loc : Llvm.llvalue -> Loc.t) (List.find_a_dup ~compare:Loc.compare [loc; data; Loc.none]) then warn "ignoring location %a conflicting with %a for %a" Loc.pp - loc Loc.pp data pp_llvalue key ) ; + loc Loc.pp data pp_llvalue key () ) ; data ) in let scan_locs m = @@ -76,7 +76,7 @@ let (scan_locs : Llvm.llmodule -> unit), (find_loc : Llvm.llvalue -> Loc.t) "could not find variable for debug info %a at %a with \ metadata %a" pp_llvalue (Llvm.operand i 0) Loc.pp loc - (List.pp ", " pp_llvalue) (Array.to_list md) + (List.pp ", " pp_llvalue) (Array.to_list md) () | _ -> () ) | _ -> () in @@ -913,7 +913,7 @@ let xlate_instr : let fname = Llvm.value_name llfunc in let skip msg = ( match Hash_set.strict_add ignored_callees fname with - | Ok () -> warn "ignoring uninterpreted %s %s" msg fname + | Ok () -> warn "ignoring uninterpreted %s %s" msg fname () | Error _ -> () ) ; let reg = xlate_name_opt instr in let msg = Llvm.string_of_llvalue instr in @@ -980,7 +980,7 @@ let xlate_instr : else ( warn "ignoring variable arguments to variadic function: %a" - pp_llvalue instr ; + pp_llvalue instr () ; Array.length (Llvm.param_types (Llvm.element_type lltyp)) ) in List.rev_init num_args ~f:(fun i -> @@ -1009,7 +1009,7 @@ let xlate_instr : Llvm.num_arg_operands instr else ( warn "ignoring variable arguments to variadic function: %a" - pp_llvalue instr ; + pp_llvalue instr () ; Array.length (Llvm.param_types (Llvm.element_type lltyp)) ) in let args = @@ -1244,7 +1244,7 @@ let xlate_instr : | VAArg -> let reg = xlate_name_opt instr in let msg = Llvm.string_of_llvalue instr in - warn "variadic function argument: %s" msg ; + warn "variadic function argument: %s" msg () ; emit_inst (Llair.Inst.nondet ~reg ~msg ~loc) | CleanupRet | CatchRet | CatchPad | CleanupPad | CatchSwitch -> todo "windows exception handling: %a" pp_llvalue instr ()