blob: 3726760f4962f066094916c278e47ad136830ab5 (
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
|
type spec =
String of (string -> unit)
| Int of (int -> unit)
| Unit of (unit -> unit)
| Float of (float -> unit)
exception Bad of string
type error =
Unknown of string
| Wrong of string * string * string (* option, actual, expected *)
| Missing of string
| Message of string
open Printf
let stop error =
let progname =
if Array.length Sys.argv > 0 then Sys.argv.(0) else "(?)" in
begin match error with
Unknown s ->
eprintf "%s: unknown option `%s'.\n" progname s
| Missing s ->
eprintf "%s: option `%s' needs an argument.\n" progname s
| Wrong (opt, arg, expected) ->
eprintf "%s: wrong argument `%s'; option `%s' expects %s.\n"
progname arg opt expected
| Message s ->
eprintf "%s: %s.\n" progname s
end;
exit 2
let parse speclist anonfun =
let rec p = function
[] -> ()
| s :: t ->
if String.length s >= 1 & String.get s 0 = '-'
then do_key s t
else begin try (anonfun s); p t with Bad m -> stop (Message m) end
and do_key s l =
let action =
try
List.assoc s speclist
with Not_found ->
stop (Unknown s) in
try
match (action, l) with
(Unit f, l) -> f (); p l
| (String f, arg::t) -> f arg; p t
| (Int f, arg::t) ->
begin try f (int_of_string arg)
with Failure "int_of_string" -> stop (Wrong (s, arg, "an integer"))
end;
p t
| (Float f, arg::t) -> f (float_of_string arg); p t
| (_, []) -> stop (Missing s)
with Bad m -> stop (Message m)
in
match Array.to_list Sys.argv with
[] -> ()
| a::l -> p l
|
