blob: 1981776ecd4557f795cee4cff6db2620702b5bd8 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
(* *********************************************************************)
(* *)
(* 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
open Responsefile
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 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 ->
eprintf "Unknown argument `%s'\n" s; 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 =
try
let argv = expand_responsefiles Sys.argv in
parse_array spec argv 1 (Array.length argv - 1)
with Arg.Bad s ->
eprintf "%s" s;
exit 2
|
