author | wenzelm |
Thu, 06 Jun 2024 22:03:20 +0200 | |
changeset 80271 | 198fc882ec0f |
parent 76092 | 282f5e980a67 |
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 get_default: string -> string |
39 |
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
|
40 |
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
|
41 |
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
|
42 |
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
|
43 |
end; |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
44 |
|
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
45 |
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
|
46 |
struct |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
47 |
|
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
48 |
(* representation *) |
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
49 |
|
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
50 |
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
|
51 |
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
|
52 |
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
|
53 |
val stringT = "string"; |
51943 | 54 |
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
|
55 |
|
56465 | 56 |
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
|
57 |
|
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
58 |
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
|
59 |
|
71911 | 60 |
fun dest (Options tab) = |
61 |
Symtab.fold (fn (name, {pos, ...}) => cons (name, pos)) tab [] |
|
62 |
|> sort_by #1; |
|
59812 | 63 |
|
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
64 |
|
51943 | 65 |
(* check *) |
51942 | 66 |
|
51943 | 67 |
fun check_name (Options tab) name = |
68 |
let val opt = Symtab.lookup tab name in |
|
69 |
if is_some opt andalso #typ (the opt) <> unknownT then the opt |
|
51978 | 70 |
else error ("Unknown system option " ^ quote name) |
51943 | 71 |
end; |
72 |
||
73 |
fun check_type options name typ = |
|
74 |
let val opt = check_name options name in |
|
75 |
if #typ opt = typ then opt |
|
51978 | 76 |
else error ("Ill-typed system option " ^ quote name ^ " : " ^ #typ opt ^ " vs. " ^ typ) |
51943 | 77 |
end; |
51942 | 78 |
|
79 |
||
56467 | 80 |
(* typ *) |
81 |
||
51943 | 82 |
fun typ options name = #typ (check_name options name); |
83 |
||
84 |
||
85 |
(* basic operations *) |
|
86 |
||
87 |
fun put T print name x (options as Options tab) = |
|
88 |
let val opt = check_type options name T |
|
56465 | 89 |
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
|
90 |
|
51943 | 91 |
fun get T parse options name = |
92 |
let val opt = check_type options name T in |
|
93 |
(case parse (#value opt) of |
|
94 |
SOME x => x |
|
95 |
| NONE => |
|
51978 | 96 |
error ("Malformed value for system option " ^ quote name ^ |
51943 | 97 |
" : " ^ T ^ " =\n" ^ quote (#value opt))) |
98 |
end; |
|
99 |
||
100 |
||
101 |
(* 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
|
102 |
|
63806 | 103 |
val bool = get boolT (try Value.parse_bool); |
104 |
val int = get intT (try Value.parse_int); |
|
105 |
val real = get realT (try Value.parse_real); |
|
62791 | 106 |
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
|
107 |
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
|
108 |
|
63806 | 109 |
val put_bool = put boolT Value.print_bool; |
110 |
val put_int = put intT Value.print_int; |
|
111 |
val put_real = put realT Value.print_real; |
|
51943 | 112 |
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
|
113 |
|
51943 | 114 |
|
115 |
(* external updates *) |
|
116 |
||
117 |
fun check_value options name = |
|
118 |
let val opt = check_name options name in |
|
119 |
if #typ opt = boolT then ignore (bool options name) |
|
120 |
else if #typ opt = intT then ignore (int options name) |
|
121 |
else if #typ opt = realT then ignore (real options name) |
|
122 |
else if #typ opt = stringT then ignore (string options name) |
|
123 |
else () |
|
124 |
end; |
|
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
125 |
|
56465 | 126 |
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
|
127 |
let |
56465 | 128 |
val options' = |
129 |
(case Symtab.lookup tab name of |
|
130 |
SOME other => |
|
131 |
error ("Duplicate declaration of system option " ^ quote name ^ Position.here pos ^ |
|
132 |
Position.here (#pos other)) |
|
133 |
| NONE => Options (Symtab.update (name, {pos = pos, typ = typ, value = value}) tab)); |
|
51943 | 134 |
val _ = |
135 |
typ = boolT orelse typ = intT orelse typ = realT orelse typ = stringT orelse |
|
56465 | 136 |
error ("Unknown type for system option " ^ quote name ^ " : " ^ quote typ ^ |
137 |
Position.here pos); |
|
51943 | 138 |
val _ = check_value options' name; |
139 |
in options' end; |
|
140 |
||
141 |
fun update name value (options as Options tab) = |
|
142 |
let |
|
143 |
val opt = check_name options name; |
|
56465 | 144 |
val options' = |
145 |
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
|
146 |
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
|
147 |
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
|
148 |
|
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
149 |
|
74161 | 150 |
(* 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
|
151 |
|
74161 | 152 |
fun encode (Options tab) = |
153 |
let |
|
154 |
val opts = |
|
74234 | 155 |
build (tab |> Symtab.fold (fn (name, {pos, typ, value}) => |
156 |
cons (Position.properties_of pos, (name, (typ, value))))); |
|
74161 | 157 |
open XML.Encode; |
158 |
in list (pair properties (pair string (pair string string))) opts end; |
|
56465 | 159 |
|
74161 | 160 |
fun decode body = |
161 |
let |
|
162 |
open XML.Decode; |
|
163 |
val decode_options = |
|
164 |
list (pair properties (pair string (pair string string))) |
|
165 |
#> map (fn (props, (name, (typ, value))) => |
|
166 |
{pos = Position.of_properties props, name = name, typ = typ, value = value}); |
|
167 |
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
|
168 |
|
48698
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
169 |
|
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
170 |
|
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
171 |
(** global default **) |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
172 |
|
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
173 |
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
|
174 |
|
51978 | 175 |
fun err_no_default () = error "Missing default for system options within Isabelle process"; |
51943 | 176 |
|
177 |
fun change_default f x y = |
|
178 |
Synchronized.change global_default |
|
179 |
(fn SOME options => SOME (f x y options) |
|
180 |
| NONE => err_no_default ()); |
|
181 |
||
48698
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
182 |
fun default () = |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
183 |
(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
|
184 |
SOME options => options |
51943 | 185 |
| 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
|
186 |
|
51946 | 187 |
fun default_typ name = typ (default ()) name; |
51942 | 188 |
fun default_bool name = bool (default ()) name; |
189 |
fun default_int name = int (default ()) name; |
|
190 |
fun default_real name = real (default ()) name; |
|
62791 | 191 |
fun default_seconds name = seconds (default ()) name; |
51942 | 192 |
fun default_string name = string (default ()) name; |
193 |
||
51943 | 194 |
fun get_default name = |
195 |
let val options = default () in get (typ options name) SOME options name end; |
|
196 |
val put_default = change_default update; |
|
197 |
||
48698
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
198 |
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
|
199 |
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
|
200 |
|
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
201 |
fun load_default () = |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
202 |
(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
|
203 |
"" => () |
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
204 |
| name => |
75626 | 205 |
try Bytes.read (Path.explode name) |
206 |
|> Option.app (set_default o decode o YXML.parse_body_bytes)); |
|
48698
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
207 |
|
2585042b1a30
pass Isabelle/Scala system options into ML process of Isar tty or build jobs;
wenzelm
parents:
48456
diff
changeset
|
208 |
val _ = load_default (); |
62878 | 209 |
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
|
210 |
|
48456
d8ff14f44a40
added ML version of stand-alone options, with XML.encode/decode operations (unidirectional from Scala to ML);
wenzelm
parents:
diff
changeset
|
211 |
end; |