Revised parsing of command-line arguments (in preparation for adding more).

Honor "ccomp -E foo.h" for GCC compatibility.
Accept .o.ext files as object files for GCC compatibility.
Fixed and improved handling of Cminor source files.

1 files changed, 105 insertions, 0 deletions

diff --git a/driver/Commandline.ml b/driver/Commandline.ml
new file mode 100644
index 00000000..bc095af6
--- /dev/null
+++ b/driver/Commandline.ml
@@ -0,0 +1,105 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              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)
+
+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 usage 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 ->
+          if s <> "-help" && s <> "--help" 
+          then eprintf "Unknown argument `%s'\n" s
+          else printf "%s" usage;
+          exit 2
+      | 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
+            eprintf "Option `%s' expects an argument\n" s; exit 2
+          end
+      | Some(Integer fn) ->
+          if i + 1 <= last then begin
+            let n =
+              try
+                int_of_string argv.(i+1)
+              with Failure _ ->
+                eprintf "Argument to option `%s' must be an integer\n" s;
+                exit 2
+            in
+            fn n; parse (i+2)
+          end else begin
+            eprintf "Option `%s' expects an argument\n" s; exit 2
+          end
+    end
+  in parse first
+
+let parse_cmdline spec usage =
+  parse_array spec usage Sys.argv 1 (Array.length Sys.argv - 1)