pghs975uc
/
infer_clone
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

[CLOpt] isolate the subset of Arg.spec used

Browse Source 
Summary:
We only ever use very few of the possible `Arg.spec` constructors and,
crucially, all of them declare a function to pass argument values to. This is
needed for the next diff, which adds deprecation messages.

Reviewed By: jeremydubreil

Differential Revision: D4430217

fbshipit-source-id: c5ffe5f
master
Jules Villard 8 years ago committed by Facebook Github Bot
parent 618e9c9338
commit cb1e241411
1 changed files with 43 additions and 26 deletions
Show Stats Download Patch File Download Diff File

69
infer/src/base/CommandLineOption.ml
Unescape View File

@ -14,6 +14,20 @@ open! IStd
module F = Format module F = Format
module YBU = Yojson.Basic.Util module YBU = Yojson.Basic.Util
(** This is the subset of Arg.spec that we actually use. What's important is that all these specs
call back functions. We use this to mark deprecated arguments. What's not important is that, eg,
Arg.Float is missing. *)
type spec =
| Unit of (unit -> unit)
| String of (string -> unit)
| Symbol of string list * (string -> unit)
| Rest of (string -> unit)
let to_arg_spec = function
| Unit f -> Arg.Unit f
| String f -> Arg.String f
| Symbol (symbols, f) -> Arg.Symbol (symbols, f)
| Rest f -> Arg.Rest f
(** Each command line option may appear in the --help list of any executable, these tags are used to (** Each command line option may appear in the --help list of any executable, these tags are used to
specify which executables for which an option will be documented. *) specify which executables for which an option will be documented. *)
@ -37,7 +51,7 @@ let exe_name =
let frontend_exes = [Clang] let frontend_exes = [Clang]
type desc = { type desc = {
long: string; short: string; meta: string; doc: string; spec: Arg.spec; long: string; short: string; meta: string; doc: string; spec: spec;
(** how to go from an option in the json config file to a list of command-line options *) (** how to go from an option in the json config file to a list of command-line options *)
decode_json: Yojson.Basic.json -> string list ; decode_json: Yojson.Basic.json -> string list ;
} }
@ -51,7 +65,7 @@ let short_meta {short; meta; spec} =
String.concat ~sep:" " String.concat ~sep:" "
((if short = "" then [] else ["| -" ^ short]) @ ((if short = "" then [] else ["| -" ^ short]) @
(match spec with (match spec with
| Arg.Symbol (symbols, _) -> | Symbol (symbols, _) ->
["{ " ^ (String.concat ~sep:" | " symbols) ^ " }" ^ meta] ["{ " ^ (String.concat ~sep:" | " symbols) ^ " }" ^ meta]
| _ -> | _ ->
if meta = "" then [] else ["<" ^ meta ^ ">"])) if meta = "" then [] else ["<" ^ meta ^ ">"]))
@ -62,7 +76,7 @@ let left_length long short_meta =
let max_left_length limit current ({long; spec} as desc) = let max_left_length limit current ({long; spec} as desc) =
let short_meta = let short_meta =
match spec with match spec with
| Arg.Symbol _ -> short_meta {desc with spec = Arg.Unit (fun () -> ())} | Symbol _ -> short_meta {desc with spec = Unit (fun () -> ())}
| _ -> short_meta desc in | _ -> short_meta desc in
let length = left_length long short_meta in let length = left_length long short_meta in
if length > limit then current else max current length if length > limit then current else max current length
@ -78,8 +92,8 @@ let xdesc {long; short; spec; doc} =
let xspec long spec = let xspec long spec =
match spec with match spec with
(* translate Symbol to String for better formatting of --help messages *) (* translate Symbol to String for better formatting of --help messages *)
| Arg.Symbol (symbols, action) -> | Symbol (symbols, action) ->
Arg.String (fun arg -> String (fun arg ->
if IList.mem ( = ) arg symbols then if IList.mem ( = ) arg symbols then
action arg action arg
else else
@ -247,7 +261,7 @@ let mk_set var value ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
~default_to_string:(fun () -> "") ~default_to_string:(fun () -> "")
~decode_json:(string_json_decoder ~long) ~decode_json:(string_json_decoder ~long)
~mk_setter:(fun _ _ -> setter ()) ~mk_setter:(fun _ _ -> setter ())
~mk_spec:(fun _ -> Arg.Unit setter) ) ~mk_spec:(fun _ -> Unit setter) )
let mk_option ?(default=None) ?(default_to_string=fun _ -> "") ~f let mk_option ?(default=None) ?(default_to_string=fun _ -> "") ~f
?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
@ -255,7 +269,7 @@ let mk_option ?(default=None) ?(default_to_string=fun _ -> "") ~f
~default_to_string ~default_to_string
~decode_json:(string_json_decoder ~long) ~decode_json:(string_json_decoder ~long)
~mk_setter:(fun var str -> var := f str) ~mk_setter:(fun var str -> var := f str)
~mk_spec:(fun set -> Arg.String set) ~mk_spec:(fun set -> String set)
let mk_bool ?(deprecated_no=[]) ?(default=false) ?(f=fun b -> b) let mk_bool ?(deprecated_no=[]) ?(default=false) ?(f=fun b -> b)
?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
@ -285,7 +299,7 @@ let mk_bool ?(deprecated_no=[]) ?(default=false) ?(f=fun b -> b)
else else
("", "Deactivates: " ^ doc long) in ("", "Deactivates: " ^ doc long) in
let default_to_string _ = "" in let default_to_string _ = "" in
let mk_spec set = Arg.Unit (fun () -> set "") in let mk_spec set = Unit (fun () -> set "") in
let var = let var =
mk ~long ?short ~deprecated ~default ?exes mk ~long ?short ~deprecated ~default ?exes
~meta doc ~default_to_string ~mk_setter:(fun var _ -> var := f true) ~meta doc ~default_to_string ~mk_setter:(fun var _ -> var := f true)
@ -314,7 +328,7 @@ let mk_int ~default ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
~default_to_string:string_of_int ~default_to_string:string_of_int
~mk_setter:(fun var str -> var := (int_of_string str)) ~mk_setter:(fun var str -> var := (int_of_string str))
~decode_json:(string_json_decoder ~long) ~decode_json:(string_json_decoder ~long)
~mk_spec:(fun set -> Arg.String set) ~mk_spec:(fun set -> String set)
let mk_int_opt ?default ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = let mk_int_opt ?default ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
let default_to_string = function Some f -> string_of_int f | None -> "" in let default_to_string = function Some f -> string_of_int f | None -> "" in
@ -326,7 +340,7 @@ let mk_float ~default ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
~default_to_string:string_of_float ~default_to_string:string_of_float
~mk_setter:(fun var str -> var := (float_of_string str)) ~mk_setter:(fun var str -> var := (float_of_string str))
~decode_json:(string_json_decoder ~long) ~decode_json:(string_json_decoder ~long)
~mk_spec:(fun set -> Arg.String set) ~mk_spec:(fun set -> String set)
let mk_float_opt ?default ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = let mk_float_opt ?default ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
let default_to_string = function Some f -> string_of_float f | None -> "" in let default_to_string = function Some f -> string_of_float f | None -> "" in
@ -338,7 +352,7 @@ let mk_string ~default ?(f=fun s -> s) ?(deprecated=[]) ~long ?short ?exes ?(met
~default_to_string:(fun s -> s) ~default_to_string:(fun s -> s)
~mk_setter:(fun var str -> var := f str) ~mk_setter:(fun var str -> var := f str)
~decode_json:(string_json_decoder ~long) ~decode_json:(string_json_decoder ~long)
~mk_spec:(fun set -> Arg.String set) ~mk_spec:(fun set -> String set)
let mk_string_opt ?default ?(f=fun s -> s) ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = let mk_string_opt ?default ?(f=fun s -> s) ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
let default_to_string = function Some s -> s | None -> "" in let default_to_string = function Some s -> s | None -> "" in
@ -351,7 +365,7 @@ let mk_string_list ?(default=[]) ?(f=fun s -> s)
~default_to_string:(String.concat ~sep:", ") ~default_to_string:(String.concat ~sep:", ")
~mk_setter:(fun var str -> var := (f str) :: !var) ~mk_setter:(fun var str -> var := (f str) :: !var)
~decode_json:(list_json_decoder (string_json_decoder ~long)) ~decode_json:(list_json_decoder (string_json_decoder ~long))
~mk_spec:(fun set -> Arg.String set) ~mk_spec:(fun set -> String set)
let mk_path_helper ~setter ~default_to_string let mk_path_helper ~setter ~default_to_string
~default ~deprecated ~long ~short ~exes ~meta ~decode_json doc = ~default ~deprecated ~long ~short ~exes ~meta ~decode_json doc =
@ -372,7 +386,7 @@ let mk_path_helper ~setter ~default_to_string
~mk_setter:(fun var str -> ~mk_setter:(fun var str ->
let abs_path = normalize_path_in_args_being_parsed str in let abs_path = normalize_path_in_args_being_parsed str in
setter var abs_path) setter var abs_path)
~mk_spec:(fun set -> Arg.String set) ~mk_spec:(fun set -> String set)
let mk_path ~default ?(deprecated=[]) ~long ?short ?exes ?(meta="path") = let mk_path ~default ?(deprecated=[]) ~long ?short ?exes ?(meta="path") =
mk_path_helper mk_path_helper
@ -404,7 +418,7 @@ let mk_symbol ~default ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") d
~default_to_string:(fun s -> to_string s) ~default_to_string:(fun s -> to_string s)
~mk_setter:(fun var str -> var := of_string str) ~mk_setter:(fun var str -> var := of_string str)
~decode_json:(string_json_decoder ~long) ~decode_json:(string_json_decoder ~long)
~mk_spec:(fun set -> Arg.Symbol (strings, set)) ~mk_spec:(fun set -> Symbol (strings, set))
let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
let strings = IList.map fst symbols in let strings = IList.map fst symbols in
@ -413,7 +427,7 @@ let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
~default_to_string:(fun _ -> "") ~default_to_string:(fun _ -> "")
~mk_setter:(fun var str -> var := Some (of_string str)) ~mk_setter:(fun var str -> var := Some (of_string str))
~decode_json:(string_json_decoder ~long) ~decode_json:(string_json_decoder ~long)
~mk_spec:(fun set -> Arg.Symbol (strings, set)) ~mk_spec:(fun set -> Symbol (strings, set))
let mk_symbol_seq ?(default=[]) ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = let mk_symbol_seq ?(default=[]) ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
let sym_to_str = IList.map (fun (x,y) -> (y,x)) symbols in let sym_to_str = IList.map (fun (x,y) -> (y,x)) symbols in
@ -426,7 +440,7 @@ let mk_symbol_seq ?(default=[]) ~symbols ?(deprecated=[]) ~long ?short ?exes ?(m
~decode_json:(fun json -> ~decode_json:(fun json ->
[dashdash long; [dashdash long;
String.concat ~sep:"," (YBU.convert_each YBU.to_string json)]) String.concat ~sep:"," (YBU.convert_each YBU.to_string json)])
~mk_spec:(fun set -> Arg.String set) ~mk_spec:(fun set -> String set)
let mk_set_from_json ~default ~default_to_string ~f let mk_set_from_json ~default ~default_to_string ~f
?(deprecated=[]) ~long ?short ?exes ?(meta="json") doc = ?(deprecated=[]) ~long ?short ?exes ?(meta="json") doc =
@ -434,14 +448,14 @@ let mk_set_from_json ~default ~default_to_string ~f
~default ~default_to_string ~default ~default_to_string
~mk_setter:(fun var json -> var := f (Yojson.Basic.from_string json)) ~mk_setter:(fun var json -> var := f (Yojson.Basic.from_string json))
~decode_json:(fun json -> [dashdash long; Yojson.Basic.to_string json]) ~decode_json:(fun json -> [dashdash long; Yojson.Basic.to_string json])
~mk_spec:(fun set -> Arg.String set) ~mk_spec:(fun set -> String set)
let mk_json ?(deprecated=[]) ~long ?short ?exes ?(meta="json") doc = let mk_json ?(deprecated=[]) ~long ?short ?exes ?(meta="json") doc =
mk ~deprecated ~long ?short ?exes ~meta doc mk ~deprecated ~long ?short ?exes ~meta doc
~default:(`List []) ~default_to_string:Yojson.Basic.to_string ~default:(`List []) ~default_to_string:Yojson.Basic.to_string
~mk_setter:(fun var json -> var := Yojson.Basic.from_string json) ~mk_setter:(fun var json -> var := Yojson.Basic.from_string json)
~decode_json:(fun json -> [dashdash long; Yojson.Basic.to_string json]) ~decode_json:(fun json -> [dashdash long; Yojson.Basic.to_string json])
~mk_spec:(fun set -> Arg.String set) ~mk_spec:(fun set -> String set)
(** A ref to a function used during argument parsing to process anonymous arguments. By default, (** A ref to a function used during argument parsing to process anonymous arguments. By default,
anonymous arguments are rejected. *) anonymous arguments are rejected. *)
@ -456,7 +470,7 @@ let mk_anon () =
let mk_rest ?(exes=[]) doc = let mk_rest ?(exes=[]) doc =
let rest = ref [] in let rest = ref [] in
let spec = Arg.Rest (fun arg -> rest := arg :: !rest) in let spec = Rest (fun arg -> rest := arg :: !rest) in
add exes {long = "--"; short = ""; meta = ""; doc; spec; decode_json = fun _ -> []} ; add exes {long = "--"; short = ""; meta = ""; doc; spec; decode_json = fun _ -> []} ;
rest rest
@ -465,7 +479,7 @@ let accept_unknown_args = ref false
let mk_subcommand ?(exes=[]) doc command_to_speclist = let mk_subcommand ?(exes=[]) doc command_to_speclist =
let rest = ref [] in let rest = ref [] in
let spec = let spec =
Arg.String (fun arg -> String (fun arg ->
rest := List.rev (Array.to_list (Array.slice !args_to_parse (!arg_being_parsed + 1) 0)) ; rest := List.rev (Array.to_list (Array.slice !args_to_parse (!arg_being_parsed + 1) 0)) ;
accept_unknown_args := true ; accept_unknown_args := true ;
anon_fun := (fun _ -> ()) ; anon_fun := (fun _ -> ()) ;
@ -546,19 +560,21 @@ let parse ?(incomplete=false) ?(accept_unknown=false) ?config_file current_exe e
in in
let usage_msg = exe_usage current_exe let usage_msg = exe_usage current_exe
in in
let convert_spec_triple (x, spec, y) = (x, to_arg_spec spec, y) in
let convert_speclist = List.map ~f:convert_spec_triple in
let curr_usage status = let curr_usage status =
prerr_endline (String.concat_array ~sep:" " !args_to_parse) ; prerr_endline (String.concat_array ~sep:" " !args_to_parse) ;
Arg.usage !curr_speclist usage_msg ; Arg.usage !curr_speclist usage_msg ;
exit status exit status
and full_usage status = and full_usage status =
Arg.usage !full_speclist usage_msg ; Arg.usage (convert_speclist !full_speclist) usage_msg ;
exit status exit status
in in
(* "-help" and "--help" are automatically recognized by Arg.parse, so we have to give them special (* "-help" and "--help" are automatically recognized by Arg.parse, so we have to give them special
treatment *) treatment *)
let add_or_suppress_help (speclist, (doc_width,left_width)) = let add_or_suppress_help (speclist, (doc_width,left_width)) =
let unknown opt = let unknown opt =
(opt, Arg.Unit (fun () -> raise (Arg.Bad ("unknown option '" ^ opt ^ "'"))), "") in (opt, Unit (fun () -> raise (Arg.Bad ("unknown option '" ^ opt ^ "'"))), "") in
let mk_spec ~long ?(short="") spec doc = let mk_spec ~long ?(short="") spec doc =
pad_and_xform doc_width left_width { long; short; meta=""; spec; doc; pad_and_xform doc_width left_width { long; short; meta=""; spec; doc;
decode_json=fun _ -> raise (Arg.Bad long)} in decode_json=fun _ -> raise (Arg.Bad long)} in
@ -570,10 +586,10 @@ let parse ?(incomplete=false) ?(accept_unknown=false) ?config_file current_exe e
else else
speclist @ [ speclist @ [
mk_spec ~long:"help" ~short:"h" mk_spec ~long:"help" ~short:"h"
(Arg.Unit (fun () -> curr_usage 0)) (Unit (fun () -> curr_usage 0))
"Display this list of options"; "Display this list of options";
mk_spec ~long:"help-full" mk_spec ~long:"help-full"
(Arg.Unit (fun () -> full_usage 0)) (Unit (fun () -> full_usage 0))
"Display the full list of options, including internal and experimental options"; "Display the full list of options, including internal and experimental options";
(unknown "-help") (unknown "-help")
] ]
@ -600,12 +616,13 @@ let parse ?(incomplete=false) ?(accept_unknown=false) ?config_file current_exe e
in in
let add_to_curr_speclist ?(add_help=false) ?header exe = let add_to_curr_speclist ?(add_help=false) ?header exe =
let mk_header_spec heading = let mk_header_spec heading =
("", Arg.Unit (fun () -> ()), "\n " ^ heading ^ "\n") in ("", Unit (fun () -> ()), "\n " ^ heading ^ "\n") in
let exe_descs = IList.assoc ( = ) exe exe_desc_lists in let exe_descs = IList.assoc ( = ) exe exe_desc_lists in
let (exe_speclist, widths) = normalize !exe_descs in let (exe_speclist, widths) = normalize !exe_descs in
let exe_speclist = if add_help let exe_speclist = if add_help
then add_or_suppress_help (exe_speclist, widths) then add_or_suppress_help (exe_speclist, widths)
else exe_speclist in else exe_speclist in
let exe_speclist = convert_speclist exe_speclist in
(* Return false if the same option appears in [speclist], unless [doc] is non-empty and the (* Return false if the same option appears in [speclist], unless [doc] is non-empty and the
documentation in [speclist] is empty. The goal is to keep only one instance of each option, documentation in [speclist] is empty. The goal is to keep only one instance of each option,
and that instance is the one that has a non-empty docstring if there is one. *) and that instance is the one that has a non-empty docstring if there is one. *)
@ -616,7 +633,7 @@ let parse ?(incomplete=false) ?(accept_unknown=false) ?config_file current_exe e
let unique_exe_speclist = IList.filter (is_not_dup_with_doc !curr_speclist) exe_speclist in let unique_exe_speclist = IList.filter (is_not_dup_with_doc !curr_speclist) exe_speclist in
curr_speclist := IList.filter (is_not_dup_with_doc unique_exe_speclist) !curr_speclist @ curr_speclist := IList.filter (is_not_dup_with_doc unique_exe_speclist) !curr_speclist @
(match header with (match header with
| Some s -> mk_header_spec s:: unique_exe_speclist | Some s -> (convert_spec_triple (mk_header_spec s)):: unique_exe_speclist
| None -> unique_exe_speclist) | None -> unique_exe_speclist)
in in
(* speclist includes args for current exe with docs, and all other args without docs, so (* speclist includes args for current exe with docs, and all other args without docs, so

Write Preview
Loading…
Cancel
Save