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
|
(****************************************************************************)
(* the diy toolsuite *)
(* *)
(* Jade Alglave, University College London, UK. *)
(* Luc Maranget, INRIA Paris-Rocquencourt, France. *)
(* *)
(* Copyright 2023-present Institut National de Recherche en Informatique et *)
(* en Automatique and the authors. All rights reserved. *)
(* *)
(* This software is governed by the CeCILL-B license under French law and *)
(* abiding by the rules of distribution of free software. You can use, *)
(* modify and/ or redistribute the software under the terms of the CeCILL-B *)
(* license as circulated by CEA, CNRS and INRIA at the following URL *)
(* "http://www.cecill.info". We also give a copy in LICENSE.txt. *)
(****************************************************************************)
(** Utilities for command-line options *)
open Printf
type 'a tfun = string -> ('a -> unit) -> string -> string * Arg.spec * string
type 'a tref = string -> 'a ref -> string -> string * Arg.spec * string
let badarg opt arg ty =
raise
(Arg.Bad
(sprintf "wrong argument '%s'; option '%s' expects a %s"
opt arg ty))
(* Parsing booleans *)
let parse_bool opt v msg =
opt,
Arg.Bool (fun b -> v := b),
sprintf "<bool> %s, default %b" msg !v
(* Parsing ints *)
let parse_int opt v msg =
opt,
Arg.Int (fun b -> v := b),
sprintf "<int> %s, default %i" msg !v
let parse_int_opt opt v msg =
opt,
Arg.String
(fun tag -> match tag with
| "none" -> v := None
| _ ->
try v := Some (int_of_string tag)
with _ -> badarg opt tag "integer"),
sprintf "<int|none> %s" msg
(* Parsing floats *)
let parse_float opt v msg =
opt,
Arg.Float (fun b -> v := b),
sprintf "<float> %s, default %.1f" msg !v
let parse_float_opt opt v msg =
opt,
Arg.String
(fun tag -> match tag with
| "none" -> v := None
| _ ->
try v := Some (float_of_string tag)
with _ -> badarg tag opt "float" ),
sprintf "<float|none> %s" msg
(* Parsing positions *)
type pos = float * float
let parse_pos opt v msg =
opt,
Arg.String
(fun tag -> match Misc.pos_of_string tag with
| Some p -> v := p
| None -> badarg tag opt "float,float"),
let x,y = !v in
sprintf "<float,float> %s, default %.1f,%.1f" msg x y
let parse_pos_opt opt v msg =
opt,
Arg.String
(fun tag -> match Misc.pos_of_string tag with
| Some p -> v := Some p
| None -> badarg tag opt "float,float"),
sprintf "<float,float> %s" msg
(* Parsing strings *)
let parse_string opt v msg =
opt,
Arg.String (fun s -> v := s),
sprintf "<string> %s, default %s" msg !v
let parse_string_opt opt v msg =
opt,
Arg.String (fun s -> match s with "none" -> v := None | _ -> v := Some s),
sprintf "<string|none> %s" msg
let parse_stringsetfun opt f msg =
opt,
Arg.String
(fun tag ->
let es = Misc.split_comma tag in
f (StringSet.of_list es)),
sprintf "<name,..,name> %s" msg
let parse_stringset opt v msg =
parse_stringsetfun opt (fun s -> v := StringSet.union s !v) msg
(* Parsing tags *)
type ttag =
string -> (string -> bool) -> string list
-> string -> string * Arg.spec * string
let do_tag opt set tags tag =
if not (set tag) then
raise
(Arg.Bad
(sprintf "bad tag for %s, allowed tag are %s"
opt (String.concat "," tags)))
let parse_tag opt set tags msg =
opt,
Arg.String (do_tag opt set tags),
sprintf "<%s> %s" (String.concat "|" tags) msg
let parse_tags opt set tags msg =
let do_tag = do_tag opt set tags in
opt,
Arg.String
(fun tags -> Misc.split_comma tags |> List.iter do_tag),
sprintf "<%s> (comma separated list) %s" (String.concat "|" tags) msg
|
