author | wenzelm |
Sat, 04 Sep 2021 22:05:35 +0200 | |
changeset 74234 | 4f2bd13edce3 |
parent 74161 | 3f371ba2b4fc |
child 75589 | 3bee51daf9a9 |
permissions | -rw-r--r-- |
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
1 |
(* Title: Pure/System/options.ML |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
2 |
Author: Makarius |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
3 |
|
51945 | 4 |
System options with external string representation. |
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
5 |
*) |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
6 |
|
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
7 |
signature OPTIONS = |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
8 |
sig |
51943 | 9 |
val boolT: string |
10 |
val intT: string |
|
11 |
val realT: string |
|
12 |
val stringT: string |
|
13 |
val unknownT: string |
|
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
14 |
type T |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
15 |
val empty: T |
71911 | 16 |
val dest: T -> (string * Position.T) list |
51942 | 17 |
val typ: T -> string -> string |
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
18 |
val bool: T -> string -> bool |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
19 |
val int: T -> string -> int |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
20 |
val real: T -> string -> real |
62791 | 21 |
val seconds: T -> string -> Time.time |
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
22 |
val string: T -> string -> string |
51943 | 23 |
val put_bool: string -> bool -> T -> T |
24 |
val put_int: string -> int -> T -> T |
|
25 |
val put_real: string -> real -> T -> T |
|
26 |
val put_string: string -> string -> T -> T |
|
56465 | 27 |
val declare: {pos: Position.T, name: string, typ: string, value: string} -> T -> T |
51943 | 28 |
val update: string -> string -> T -> T |
74161 | 29 |
val encode: T XML.Encode.T |
30 |
val decode: T XML.Decode.T |
|
48698
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
31 |
val default: unit -> T |
51946 | 32 |
val default_typ: string -> string |
51942 | 33 |
val default_bool: string -> bool |
34 |
val default_int: string -> int |
|
35 |
val default_real: string -> real |
|
62791 | 36 |
val default_seconds: string -> Time.time |
51942 | 37 |
val default_string: string -> string |
51943 | 38 |
val default_put_bool: string -> bool -> unit |
39 |
val default_put_int: string -> int -> unit |
|
40 |
val default_put_real: string -> real -> unit |
|
41 |
val default_put_string: string -> string -> unit |
|
42 |
val get_default: string -> string |
|
43 |
val put_default: string -> string -> unit |
|
48698
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
44 |
val set_default: T -> unit |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
45 |
val reset_default: unit -> unit |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
46 |
val load_default: unit -> unit |
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
47 |
end; |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
48 |
|
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
49 |
structure Options: OPTIONS = |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
50 |
struct |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
51 |
|
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
52 |
(* representation *) |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
53 |
|
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
54 |
val boolT = "bool"; |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
55 |
val intT = "int"; |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
56 |
val realT = "real"; |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
57 |
val stringT = "string"; |
51943 | 58 |
val unknownT = "unknown"; |
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
59 |
|
56465 | 60 |
datatype T = Options of {pos: Position.T, typ: string, value: string} Symtab.table; |
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
61 |
|
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
62 |
val empty = Options Symtab.empty; |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
63 |
|
71911 | 64 |
fun dest (Options tab) = |
65 |
Symtab.fold (fn (name, {pos, ...}) => cons (name, pos)) tab [] |
|
66 |
|> sort_by #1; |
|
59812 | 67 |
|
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
68 |
|
51943 | 69 |
(* check *) |
51942 | 70 |
|
51943 | 71 |
fun check_name (Options tab) name = |
72 |
let val opt = Symtab.lookup tab name in |
|
73 |
if is_some opt andalso #typ (the opt) <> unknownT then the opt |
|
51978 | 74 |
else error ("Unknown system option " ^ quote name) |
51943 | 75 |
end; |
76 |
||
77 |
fun check_type options name typ = |
|
78 |
let val opt = check_name options name in |
|
79 |
if #typ opt = typ then opt |
|
51978 | 80 |
else error ("Ill-typed system option " ^ quote name ^ " : " ^ #typ opt ^ " vs. " ^ typ) |
51943 | 81 |
end; |
51942 | 82 |
|
83 |
||
56467 | 84 |
(* typ *) |
85 |
||
51943 | 86 |
fun typ options name = #typ (check_name options name); |
87 |
||
88 |
||
89 |
(* basic operations *) |
|
90 |
||
91 |
fun put T print name x (options as Options tab) = |
|
92 |
let val opt = check_type options name T |
|
56465 | 93 |
in Options (Symtab.update (name, {pos = #pos opt, typ = #typ opt, value = print x}) tab) end; |
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
94 |
|
51943 | 95 |
fun get T parse options name = |
96 |
let val opt = check_type options name T in |
|
97 |
(case parse (#value opt) of |
|
98 |
SOME x => x |
|
99 |
| NONE => |
|
51978 | 100 |
error ("Malformed value for system option " ^ quote name ^ |
51943 | 101 |
" : " ^ T ^ " =\n" ^ quote (#value opt))) |
102 |
end; |
|
103 |
||
104 |
||
105 |
(* internal lookup and update *) |
|
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
106 |
|
63806 | 107 |
val bool = get boolT (try Value.parse_bool); |
108 |
val int = get intT (try Value.parse_int); |
|
109 |
val real = get realT (try Value.parse_real); |
|
62791 | 110 |
val seconds = Time.fromReal oo real; |
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
111 |
val string = get stringT SOME; |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
112 |
|
63806 | 113 |
val put_bool = put boolT Value.print_bool; |
114 |
val put_int = put intT Value.print_int; |
|
115 |
val put_real = put realT Value.print_real; |
|
51943 | 116 |
val put_string = put stringT I; |
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
117 |
|
51943 | 118 |
|
119 |
(* external updates *) |
|
120 |
||
121 |
fun check_value options name = |
|
122 |
let val opt = check_name options name in |
|
123 |
if #typ opt = boolT then ignore (bool options name) |
|
124 |
else if #typ opt = intT then ignore (int options name) |
|
125 |
else if #typ opt = realT then ignore (real options name) |
|
126 |
else if #typ opt = stringT then ignore (string options name) |
|
127 |
else () |
|
128 |
end; |
|
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
129 |
|
56465 | 130 |
fun declare {pos, name, typ, value} (Options tab) = |
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
131 |
let |
56465 | 132 |
val options' = |
133 |
(case Symtab.lookup tab name of |
|
134 |
SOME other => |
|
135 |
error ("Duplicate declaration of system option " ^ quote name ^ Position.here pos ^ |
|
136 |
Position.here (#pos other)) |
|
137 |
| NONE => Options (Symtab.update (name, {pos = pos, typ = typ, value = value}) tab)); |
|
51943 | 138 |
val _ = |
139 |
typ = boolT orelse typ = intT orelse typ = realT orelse typ = stringT orelse |
|
56465 | 140 |
error ("Unknown type for system option " ^ quote name ^ " : " ^ quote typ ^ |
141 |
Position.here pos); |
|
51943 | 142 |
val _ = check_value options' name; |
143 |
in options' end; |
|
144 |
||
145 |
fun update name value (options as Options tab) = |
|
146 |
let |
|
147 |
val opt = check_name options name; |
|
56465 | 148 |
val options' = |
149 |
Options (Symtab.update (name, {pos = #pos opt, typ = #typ opt, value = value}) tab); |
|
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
150 |
val _ = check_value options' name; |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
151 |
in options' end; |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
152 |
|
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
153 |
|
74161 | 154 |
(* XML data *) |
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
155 |
|
74161 | 156 |
fun encode (Options tab) = |
157 |
let |
|
158 |
val opts = |
|
74234 | 159 |
build (tab |> Symtab.fold (fn (name, {pos, typ, value}) => |
160 |
cons (Position.properties_of pos, (name, (typ, value))))); |
|
74161 | 161 |
open XML.Encode; |
162 |
in list (pair properties (pair string (pair string string))) opts end; |
|
56465 | 163 |
|
74161 | 164 |
fun decode body = |
165 |
let |
|
166 |
open XML.Decode; |
|
167 |
val decode_options = |
|
168 |
list (pair properties (pair string (pair string string))) |
|
169 |
#> map (fn (props, (name, (typ, value))) => |
|
170 |
{pos = Position.of_properties props, name = name, typ = typ, value = value}); |
|
171 |
in fold declare (decode_options body) empty end; |
|
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
172 |
|
48698
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
173 |
|
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
174 |
|
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
175 |
(** global default **) |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
176 |
|
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
177 |
val global_default = Synchronized.var "Options.default" (NONE: T option); |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
178 |
|
51978 | 179 |
fun err_no_default () = error "Missing default for system options within Isabelle process"; |
51943 | 180 |
|
181 |
fun change_default f x y = |
|
182 |
Synchronized.change global_default |
|
183 |
(fn SOME options => SOME (f x y options) |
|
184 |
| NONE => err_no_default ()); |
|
185 |
||
48698
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
186 |
fun default () = |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
187 |
(case Synchronized.value global_default of |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
188 |
SOME options => options |
51943 | 189 |
| NONE => err_no_default ()); |
48698
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
190 |
|
51946 | 191 |
fun default_typ name = typ (default ()) name; |
51942 | 192 |
fun default_bool name = bool (default ()) name; |
193 |
fun default_int name = int (default ()) name; |
|
194 |
fun default_real name = real (default ()) name; |
|
62791 | 195 |
fun default_seconds name = seconds (default ()) name; |
51942 | 196 |
fun default_string name = string (default ()) name; |
197 |
||
51943 | 198 |
val default_put_bool = change_default put_bool; |
199 |
val default_put_int = change_default put_int; |
|
200 |
val default_put_real = change_default put_real; |
|
201 |
val default_put_string = change_default put_string; |
|
202 |
||
203 |
fun get_default name = |
|
204 |
let val options = default () in get (typ options name) SOME options name end; |
|
205 |
val put_default = change_default update; |
|
206 |
||
48698
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
207 |
fun set_default options = Synchronized.change global_default (K (SOME options)); |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
208 |
fun reset_default () = Synchronized.change global_default (K NONE); |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
209 |
|
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
210 |
fun load_default () = |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
211 |
(case getenv "ISABELLE_PROCESS_OPTIONS" of |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
212 |
"" => () |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
213 |
| name => |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
214 |
let val path = Path.explode name in |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
215 |
(case try File.read path of |
62885 | 216 |
SOME s => set_default (decode (YXML.parse_body s)) |
48698
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
217 |
| NONE => ()) |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
218 |
end); |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
219 |
|
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
220 |
val _ = load_default (); |
62878 | 221 |
val _ = ML_Print_Depth.set_print_depth (default_int "ML_print_depth"); |
48698
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
222 |
|
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
223 |
end; |