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 -------------------------------------------------- 1 file changed, 141 deletions(-) delete mode 100644 driver/Commandline.ml (limited to 'driver/Commandline.ml') 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 -- cgit