blob: 2f0d7cc1db4b8aba3e2c2755bceceb611f5e3627 (
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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
(* *********************************************************************)
(* *)
(* 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 Lesser General Public License as *)
(* published by the Free Software Foundation, either version 2.1 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
|
