From 4a676623badb718da4055b7f26ee05f5097f4e7b Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Mon, 4 May 2020 11:11:27 +0200 Subject: Move Commandline to the lib/ directory The Commandline module is reusable in other projects, and its license (GPL) allows such reuse, so its natural place is in lib/ rather than in driver/ --- driver/Commandline.ml | 141 ------------------------------------------------- driver/Commandline.mli | 55 ------------------- 2 files changed, 196 deletions(-) delete mode 100644 driver/Commandline.ml delete mode 100644 driver/Commandline.mli (limited to 'driver') diff --git a/driver/Commandline.ml b/driver/Commandline.ml deleted file mode 100644 index 672ed834..00000000 --- a/driver/Commandline.ml +++ /dev/null @@ -1,141 +0,0 @@ -(* *********************************************************************) -(* *) -(* The Compcert verified compiler *) -(* *) -(* Xavier Leroy, INRIA Paris-Rocquencourt *) -(* *) -(* Copyright Institut National de Recherche en Informatique et en *) -(* Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU General Public License as published by *) -(* the Free Software Foundation, either version 2 of the License, or *) -(* (at your option) any later version. This file is also distributed *) -(* under the terms of the INRIA Non-Commercial License Agreement. *) -(* *) -(* *********************************************************************) - -(* Parsing of command-line flags and arguments *) - -open Printf - -type pattern = - | Exact of string - | Prefix of string - | Suffix of string - | Regexp of Str.regexp - -let _Regexp re = Regexp (Str.regexp re) - -type action = - | Set of bool ref - | Unset of bool ref - | Self of (string -> unit) - | String of (string -> unit) - | Integer of (int -> unit) - | Ignore - | Unit of (unit -> unit) - -exception CmdError of string - -let match_pattern text = function - | Exact s -> - text = s - | Prefix pref -> - let lpref = String.length pref and ltext = String.length text in - lpref < ltext && String.sub text 0 lpref = pref - (* strict prefix: no match if pref = text. See below. *) - | Suffix suff -> - let lsuff = String.length suff and ltext = String.length text in - lsuff < ltext && String.sub text (ltext - lsuff) lsuff = suff - (* strict suffix: no match if suff = text, so that e.g. ".c" - causes an error rather than being treated as a C source file. *) - | Regexp re -> - Str.string_match re text 0 - -let rec find_action text = function - | [] -> None - | (pat, act) :: rem -> - if match_pattern text pat then Some act else find_action text rem - -let parse_array spec argv first last = - (* Split the spec into Exact patterns (in a hashtable) and other patterns *) - let exact_cases = (Hashtbl.create 29 : (string, action) Hashtbl.t) in - let rec split_spec = function - | [] -> [] - | (Exact s, act) :: rem -> Hashtbl.add exact_cases s act; split_spec rem - | (pat, act) :: rem -> (pat, act) :: split_spec rem in - let inexact_cases = split_spec spec in - (* Parse the vector of arguments *) - let rec parse i = - if i <= last then begin - let s = argv.(i) in - let optact = - try Some (Hashtbl.find exact_cases s) - with Not_found -> find_action s inexact_cases in - match optact with - | None -> - let msg = sprintf "unknown argument `%s'" s in - raise (CmdError msg) - | Some(Set r) -> - r := true; parse (i+1) - | Some(Unset r) -> - r := false; parse (i+1) - | Some(Self fn) -> - fn s; parse (i+1) - | Some(String fn) -> - if i + 1 <= last then begin - fn argv.(i+1); parse (i+2) - end else begin - let msg = sprintf "option `%s' expects an argument" s in - raise (CmdError msg) - end - | Some(Integer fn) -> - if i + 1 <= last then begin - let n = - try - int_of_string argv.(i+1) - with Failure _ -> - let msg = sprintf "argument to option `%s' must be an integer" s in - raise (CmdError msg) - in - fn n; parse (i+2) - end else begin - let msg = sprintf "option `%s' expects an argument" s in - raise (CmdError msg) - end - | Some (Ignore) -> - if i + 1 <= last then begin - parse (i+2) - end else begin - let msg = sprintf "option `%s' expects an argument" s in - raise (CmdError msg) - end - | Some (Unit f) -> f (); parse (i+1) - end - in parse first - -let argv = - try - Responsefile.expandargv Sys.argv - with Responsefile.Error msg | Sys_error msg -> - eprintf "Error while processing the command line: %s\n" msg; - exit 2 - -let parse_cmdline spec = - parse_array spec argv 1 (Array.length argv - 1) - -let long_int_action key s = - let ls = String.length s - and lkey = String.length key in - assert (ls > lkey); - let s = String.sub s (lkey + 1) (ls - lkey - 1) in - try - int_of_string s - with Failure _ -> - let msg = sprintf "argument to option `%s' must be an integer" key in - raise (CmdError msg) - -let longopt_int key f = - let act s = - let n = long_int_action key s in - f n in - Prefix (key ^ "="),Self act diff --git a/driver/Commandline.mli b/driver/Commandline.mli deleted file mode 100644 index 8bb6f18f..00000000 --- a/driver/Commandline.mli +++ /dev/null @@ -1,55 +0,0 @@ -(* *********************************************************************) -(* *) -(* The Compcert verified compiler *) -(* *) -(* Xavier Leroy, INRIA Paris-Rocquencourt *) -(* *) -(* Copyright Institut National de Recherche en Informatique et en *) -(* Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU General Public License as published by *) -(* the Free Software Foundation, either version 2 of the License, or *) -(* (at your option) any later version. This file is also distributed *) -(* under the terms of the INRIA Non-Commercial License Agreement. *) -(* *) -(* *********************************************************************) - -(* Parsing of command-line flags and arguments *) - -(* A command-line specification is a list of pairs (pattern, action). - Command-line words are matched against the patterns, and the - corresponding actions are invoked. *) - -type pattern = - | Exact of string (** exactly this string *) - | Prefix of string (** any string starting with this prefix *) - | Suffix of string (** any string ending with this suffix *) - | Regexp of Str.regexp (** any string matching this anchored regexp *) - -val _Regexp: string -> pattern (** text of an [Str] regexp *) - -type action = - | Set of bool ref (** set the given ref to true *) - | Unset of bool ref (** set the given ref to false *) - | Self of (string -> unit) (** call the function with the matched string *) - | String of (string -> unit) (** read next arg as a string, call function *) - | Integer of (int -> unit) (** read next arg as an int, call function *) - | Ignore (** ignore the next arg *) - | Unit of (unit -> unit) (** call the function with unit as argument *) -(* Note on precedence: [Exact] patterns are tried first, then the other - patterns are tried in the order in which they appear in the list. *) - -exception CmdError of string -(** Raise by [parse_cmdline] when an error occurred *) - -val parse_cmdline: (pattern * action) list -> unit -(** [parse_cmdline actions] parses the command line (after @-file expansion) - and performs all [actions]. Raises [CmdError] if an error occurred. -*) - -val longopt_int: string -> (int -> unit) -> pattern * action -(** [longopt_int key fn] generates a pattern and an action for - options of the form [key=] and calls [fn] with the integer argument -*) - -val argv: string array -(** [argv] contains the complete command line after @-file expandsion *) -- cgit