Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 2009-2012,2014-2017 Matthew Fluet. |
2 | * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh | |
3 | * Jagannathan, and Stephen Weeks. | |
4 | * Copyright (C) 1997-2000 NEC Research Institute. | |
5 | * | |
6 | * MLton is released under a BSD-style license. | |
7 | * See the file MLton-LICENSE for details. | |
8 | *) | |
9 | ||
10 | structure ControlFlags: CONTROL_FLAGS = | |
11 | struct | |
12 | ||
13 | structure C = Control () | |
14 | open C | |
15 | ||
16 | structure Align = | |
17 | struct | |
18 | datatype t = Align4 | Align8 | |
19 | ||
20 | val toString = | |
21 | fn Align4 => "4" | |
22 | | Align8 => "8" | |
23 | end | |
24 | ||
25 | datatype align = datatype Align.t | |
26 | ||
27 | val align = control {name = "align", | |
28 | default = Align4, | |
29 | toString = Align.toString} | |
30 | ||
31 | val atMLtons = control {name = "atMLtons", | |
32 | default = Vector.new0 (), | |
33 | toString = fn v => Layout.toString (Vector.layout | |
34 | String.layout v)} | |
35 | ||
36 | structure Chunk = | |
37 | struct | |
38 | datatype t = | |
39 | OneChunk | |
40 | | ChunkPerFunc | |
41 | | Coalesce of {limit: int} | |
42 | ||
43 | val toString = | |
44 | fn OneChunk => "one chunk" | |
45 | | ChunkPerFunc => "chunk per function" | |
46 | | Coalesce {limit} => concat ["coalesce ", Int.toString limit] | |
47 | end | |
48 | ||
49 | datatype chunk = datatype Chunk.t | |
50 | ||
51 | val chunk = control {name = "chunk", | |
52 | default = Coalesce {limit = 4096}, | |
53 | toString = Chunk.toString} | |
54 | ||
55 | val closureConvertGlobalize = control {name = "closureConvertGlobalize", | |
56 | default = true, | |
57 | toString = Bool.toString} | |
58 | ||
59 | val closureConvertShrink = control {name = "closureConvertShrink", | |
60 | default = true, | |
61 | toString = Bool.toString} | |
62 | ||
63 | structure Codegen = | |
64 | struct | |
65 | datatype t = | |
66 | AMD64Codegen | |
67 | | CCodegen | |
68 | | LLVMCodegen | |
69 | | X86Codegen | |
70 | ||
71 | val all = [X86Codegen,AMD64Codegen,CCodegen,LLVMCodegen] | |
72 | ||
73 | val toString: t -> string = | |
74 | fn AMD64Codegen => "amd64" | |
75 | | CCodegen => "c" | |
76 | | LLVMCodegen => "llvm" | |
77 | | X86Codegen => "x86" | |
78 | end | |
79 | ||
80 | datatype codegen = datatype Codegen.t | |
81 | ||
82 | val codegen = control {name = "codegen", | |
83 | default = Codegen.X86Codegen, | |
84 | toString = Codegen.toString} | |
85 | ||
86 | val contifyIntoMain = control {name = "contifyIntoMain", | |
87 | default = false, | |
88 | toString = Bool.toString} | |
89 | ||
90 | val debug = control {name = "debug", | |
91 | default = false, | |
92 | toString = Bool.toString} | |
93 | ||
94 | val defaultChar = control {name = "defaultChar", | |
95 | default = "char8", | |
96 | toString = fn s => s} | |
97 | val defaultWideChar = control {name = "defaultWideChar", | |
98 | default = "widechar32", | |
99 | toString = fn s => s} | |
100 | val defaultInt = control {name = "defaultInt", | |
101 | default = "int32", | |
102 | toString = fn s => s} | |
103 | val defaultReal = control {name = "defaultReal", | |
104 | default = "real64", | |
105 | toString = fn s => s} | |
106 | val defaultWord = control {name = "defaultWord", | |
107 | default = "word32", | |
108 | toString = fn s => s} | |
109 | ||
110 | val diagPasses = | |
111 | control {name = "diag passes", | |
112 | default = [], | |
113 | toString = List.toString | |
114 | (Layout.toString o | |
115 | Regexp.Compiled.layout)} | |
116 | ||
117 | val executePasses = | |
118 | control {name = "execute passes", | |
119 | default = [], | |
120 | toString = List.toString | |
121 | (Layout.toString o | |
122 | (Layout.tuple2 | |
123 | (Regexp.Compiled.layout, Bool.layout)))} | |
124 | ||
125 | structure Elaborate = | |
126 | struct | |
127 | structure DiagEIW = | |
128 | struct | |
129 | datatype t = | |
130 | Error | |
131 | | Ignore | |
132 | | Warn | |
133 | ||
134 | val fromString: string -> t option = | |
135 | fn "error" => SOME Error | |
136 | | "ignore" => SOME Ignore | |
137 | | "warn" => SOME Warn | |
138 | | _ => NONE | |
139 | ||
140 | val toString: t -> string = | |
141 | fn Error => "error" | |
142 | | Ignore => "ignore" | |
143 | | Warn => "warn" | |
144 | end | |
145 | ||
146 | structure DiagDI = | |
147 | struct | |
148 | datatype t = | |
149 | Default | |
150 | | Ignore | |
151 | ||
152 | val fromString: string -> t option = | |
153 | fn "default" => SOME Default | |
154 | | "ignore" => SOME Ignore | |
155 | | _ => NONE | |
156 | ||
157 | val toString: t -> string = | |
158 | fn Default => "default" | |
159 | | Ignore => "ignore" | |
160 | end | |
161 | ||
162 | structure ResolveScope = | |
163 | struct | |
164 | datatype t = | |
165 | Dec | |
166 | | Strdec | |
167 | | Topdec | |
168 | | Program | |
169 | ||
170 | val fromString: string -> t option = | |
171 | fn "dec" => SOME Dec | |
172 | | "strdec" => SOME Strdec | |
173 | | "topdec" => SOME Topdec | |
174 | | "program" => SOME Program | |
175 | | _ => NONE | |
176 | ||
177 | val toString: t -> string = | |
178 | fn Dec => "dec" | |
179 | | Strdec => "strdec" | |
180 | | Topdec => "topdec" | |
181 | | Program => "program" | |
182 | end | |
183 | ||
184 | structure Id = | |
185 | struct | |
186 | datatype t = T of {enabled: bool ref, | |
187 | expert: bool, | |
188 | name: string} | |
189 | fun equals (T {enabled = enabled1, ...}, | |
190 | T {enabled = enabled2, ...}) = | |
191 | enabled1 = enabled2 | |
192 | ||
193 | val enabled = fn (T {enabled, ...}) => !enabled | |
194 | val setEnabled = fn (T {enabled, ...}, b) => (enabled := b; true) | |
195 | val expert = fn (T {expert, ...}) => expert | |
196 | val name = fn (T {name, ...}) => name | |
197 | end | |
198 | structure Args = | |
199 | struct | |
200 | datatype t = T of {fillArgs: unit -> (unit -> unit), | |
201 | processAnn: unit -> (unit -> unit), | |
202 | processDef: unit -> bool} | |
203 | local | |
204 | fun make sel (T r) = sel r | |
205 | in | |
206 | fun processAnn args = (make #processAnn args) () | |
207 | fun processDef args = (make #processDef args) () | |
208 | end | |
209 | end | |
210 | datatype ('args, 'st) t = T of {args: 'args option ref, | |
211 | cur: 'st ref, | |
212 | def: 'st ref, | |
213 | id: Id.t} | |
214 | fun current (T {cur, ...}) = !cur | |
215 | fun default (T {def, ...}) = !def | |
216 | fun id (T {id, ...}) = id | |
217 | fun enabled ctrl = Id.enabled (id ctrl) | |
218 | fun expert ctrl = Id.expert (id ctrl) | |
219 | fun name ctrl = Id.name (id ctrl) | |
220 | fun equalsId (ctrl, id') = Id.equals (id ctrl, id') | |
221 | ||
222 | datatype 'a parseResult = | |
223 | Bad | Good of 'a | Other | Proxy of 'a list * {deprecated: bool} | |
224 | val deGood = | |
225 | fn Good z => z | |
226 | | _ => Error.bug "Control.Elaborate.deGood" | |
227 | ||
228 | val documentation: {choices: string list option, | |
229 | expert: bool, | |
230 | name: string} list ref = ref [] | |
231 | ||
232 | fun document {expert} = | |
233 | let | |
234 | val all = !documentation | |
235 | val all = | |
236 | if expert then all | |
237 | else List.keepAll (all, not o #expert) | |
238 | val all = | |
239 | List.insertionSort | |
240 | (all, fn ({name = n, ...}, {name = n', ...}) => n <= n') | |
241 | open Layout | |
242 | in | |
243 | align | |
244 | (List.map | |
245 | (all, fn {choices, name, ...} => | |
246 | str (concat [name, | |
247 | case choices of | |
248 | NONE => "" | |
249 | | SOME cs => | |
250 | concat [" {", | |
251 | concat (List.separate (cs, "|")), | |
252 | "}"]]))) | |
253 | end | |
254 | ||
255 | local | |
256 | fun make ({choices: 'st list option, | |
257 | default: 'st, | |
258 | expert: bool, | |
259 | toString: 'st -> string, | |
260 | name: string, | |
261 | newCur: 'st * 'args -> 'st, | |
262 | newDef: 'st * 'args -> 'st, | |
263 | parseArgs: string list -> 'args option}, | |
264 | {parseId: string -> Id.t parseResult, | |
265 | parseIdAndArgs: string list -> (Id.t * Args.t) parseResult, | |
266 | withDef: unit -> (unit -> unit), | |
267 | snapshot: unit -> unit -> (unit -> unit)}) = | |
268 | let | |
269 | val () = | |
270 | List.push | |
271 | (documentation, | |
272 | {choices = Option.map (choices, fn cs => | |
273 | List.map (cs, toString)), | |
274 | expert = expert, | |
275 | name = name}) | |
276 | val ctrl as T {args = argsRef, cur, def, | |
277 | id as Id.T {enabled, ...}, ...} = | |
278 | T {args = ref NONE, | |
279 | cur = ref default, | |
280 | def = control {name = concat ["elaborate ", name, | |
281 | " (default)"], | |
282 | default = default, | |
283 | toString = toString}, | |
284 | id = Id.T {enabled = control {name = concat ["elaborate ", name, | |
285 | " (enabled)"], | |
286 | default = true, | |
287 | toString = Bool.toString}, | |
288 | expert = expert, | |
289 | name = name}} | |
290 | val parseId = fn name' => | |
291 | if String.equals (name', name) | |
292 | then Good id | |
293 | else parseId name' | |
294 | val parseIdAndArgs = fn ss => | |
295 | case ss of | |
296 | name'::args' => | |
297 | if String.equals (name', name) | |
298 | then | |
299 | case parseArgs args' of | |
300 | SOME v => | |
301 | let | |
302 | fun fillArgs () = | |
303 | (argsRef := SOME v | |
304 | ; fn () => argsRef := NONE) | |
305 | fun processAnn () = | |
306 | if !enabled | |
307 | then let | |
308 | val old = !cur | |
309 | val new = newCur (old, v) | |
310 | in | |
311 | cur := new | |
312 | ; fn () => cur := old | |
313 | end | |
314 | else fn () => () | |
315 | fun processDef () = | |
316 | let | |
317 | val old = !def | |
318 | val new = newDef (old, v) | |
319 | in | |
320 | def := new | |
321 | ; true | |
322 | end | |
323 | val args = | |
324 | Args.T {fillArgs = fillArgs, | |
325 | processAnn = processAnn, | |
326 | processDef = processDef} | |
327 | in | |
328 | Good (id, args) | |
329 | end | |
330 | | NONE => Bad | |
331 | else parseIdAndArgs ss | |
332 | | _ => Bad | |
333 | val withDef : unit -> (unit -> unit) = | |
334 | fn () => | |
335 | let | |
336 | val restore = withDef () | |
337 | val old = !cur | |
338 | in | |
339 | cur := !def | |
340 | ; fn () => (cur := old | |
341 | ; restore ()) | |
342 | end | |
343 | val snapshot : unit -> unit -> (unit -> unit) = | |
344 | fn () => | |
345 | let | |
346 | val withSaved = snapshot () | |
347 | val saved = !cur | |
348 | in | |
349 | fn () => | |
350 | let | |
351 | val restore = withSaved () | |
352 | val old = !cur | |
353 | in | |
354 | cur := saved | |
355 | ; fn () => (cur := old | |
356 | ; restore ()) | |
357 | end | |
358 | end | |
359 | in | |
360 | (ctrl, | |
361 | {parseId = parseId, | |
362 | parseIdAndArgs = parseIdAndArgs, | |
363 | withDef = withDef, | |
364 | snapshot = snapshot}) | |
365 | end | |
366 | ||
367 | fun makeBool ({default: bool, | |
368 | expert: bool, | |
369 | name: string}, ac) = | |
370 | make ({choices = SOME (if default then [true, false] | |
371 | else [false, true]), | |
372 | default = default, | |
373 | expert = expert, | |
374 | toString = Bool.toString, | |
375 | name = name, | |
376 | newCur = fn (_,b) => b, | |
377 | newDef = fn (_,b) => b, | |
378 | parseArgs = fn args' => | |
379 | case args' of | |
380 | [arg'] => Bool.fromString arg' | |
381 | | _ => NONE}, | |
382 | ac) | |
383 | ||
384 | fun makeDiagnostic ({choices, | |
385 | default, | |
386 | diagToString, | |
387 | diagFromString, | |
388 | expert: bool, | |
389 | name: string}, ac) = | |
390 | make ({choices = choices, | |
391 | default = default, | |
392 | expert = expert, | |
393 | toString = diagToString, | |
394 | name = name, | |
395 | newCur = fn (_,d) => d, | |
396 | newDef = fn (_,d) => d, | |
397 | parseArgs = fn args' => | |
398 | case args' of | |
399 | [arg'] => diagFromString arg' | |
400 | | _ => NONE}, | |
401 | ac) | |
402 | fun makeDiagEIW ({default: DiagEIW.t, | |
403 | expert: bool, | |
404 | name: string}, ac) = | |
405 | makeDiagnostic ({choices = (SOME | |
406 | (let | |
407 | datatype z = datatype DiagEIW.t | |
408 | in | |
409 | case default of | |
410 | Error => [Error, Ignore, Warn] | |
411 | | Ignore => [Ignore, Error, Warn] | |
412 | | Warn => [Warn, Ignore, Error] | |
413 | end)), | |
414 | default = default, | |
415 | diagToString = DiagEIW.toString, | |
416 | diagFromString = DiagEIW.fromString, | |
417 | expert = expert, | |
418 | name = name}, ac) | |
419 | fun makeDiagDI ({default: DiagDI.t, | |
420 | expert: bool, | |
421 | name: string}, ac) = | |
422 | makeDiagnostic ({choices = (SOME | |
423 | (let | |
424 | datatype z = datatype DiagDI.t | |
425 | in | |
426 | case default of | |
427 | Default => [Default, Ignore] | |
428 | | Ignore => [Ignore, Default] | |
429 | end)), | |
430 | default = default, | |
431 | diagToString = DiagDI.toString, | |
432 | diagFromString = DiagDI.fromString, | |
433 | expert = expert, | |
434 | name = name}, ac) | |
435 | in | |
436 | val ac = | |
437 | {parseId = fn _ => Bad, | |
438 | parseIdAndArgs = fn _ => Bad, | |
439 | withDef = fn () => (fn () => ()), | |
440 | snapshot = fn () => fn () => (fn () => ())} | |
441 | ||
442 | ||
443 | val (allowConstant, ac) = | |
444 | makeBool ({name = "allowConstant", | |
445 | default = false, expert = true}, ac) | |
446 | val (allowFFI, ac) = | |
447 | makeBool ({name = "allowFFI", | |
448 | default = false, expert = false}, ac) | |
449 | val (allowPrim, ac) = | |
450 | makeBool ({name = "allowPrim", | |
451 | default = false, expert = true}, ac) | |
452 | val (allowOverload, ac) = | |
453 | makeBool ({name = "allowOverload", | |
454 | default = false, expert = true}, ac) | |
455 | val (allowRedefineSpecialIds, ac) = | |
456 | makeBool ({name = "allowRedefineSpecialIds", | |
457 | default = false, expert = true}, ac) | |
458 | val (allowSpecifySpecialIds, ac) = | |
459 | makeBool ({name = "allowSpecifySpecialIds", | |
460 | default = false, expert = true}, ac) | |
461 | val (deadCode, ac) = | |
462 | makeBool ({name = "deadCode", | |
463 | default = false, expert = true}, ac) | |
464 | val (forceUsed, ac) = | |
465 | make ({choices = NONE, | |
466 | default = false, | |
467 | expert = false, | |
468 | toString = Bool.toString, | |
469 | name = "forceUsed", | |
470 | newCur = fn (b,()) => b, | |
471 | newDef = fn (_,()) => true, | |
472 | parseArgs = fn args' => | |
473 | case args' of | |
474 | [] => SOME () | |
475 | | _ => NONE}, | |
476 | ac) | |
477 | val (ffiStr, ac) = | |
478 | make ({choices = SOME [SOME "<longstrid>"], | |
479 | default = NONE, | |
480 | expert = true, | |
481 | toString = fn NONE => "" | SOME s => s, | |
482 | name = "ffiStr", | |
483 | newCur = fn (_,s) => SOME s, | |
484 | newDef = fn _ => NONE, | |
485 | parseArgs = fn args' => | |
486 | case args' of | |
487 | [s] => SOME s | |
488 | | _ => NONE}, | |
489 | ac) | |
490 | val (nonexhaustiveBind, ac) = | |
491 | makeDiagEIW ({name = "nonexhaustiveBind", | |
492 | default = DiagEIW.Warn, expert = false}, ac) | |
493 | val (nonexhaustiveExnBind, ac) = | |
494 | makeDiagDI ({name = "nonexhaustiveExnBind", | |
495 | default = DiagDI.Default, expert = false}, ac) | |
496 | val (redundantBind, ac) = | |
497 | makeDiagEIW ({name = "redundantBind", | |
498 | default = DiagEIW.Warn, expert = false}, ac) | |
499 | val (nonexhaustiveMatch, ac) = | |
500 | makeDiagEIW ({name = "nonexhaustiveMatch", | |
501 | default = DiagEIW.Warn, expert = false}, ac) | |
502 | val (nonexhaustiveExnMatch, ac) = | |
503 | makeDiagDI ({name = "nonexhaustiveExnMatch", | |
504 | default = DiagDI.Default, expert = false}, ac) | |
505 | val (redundantMatch, ac) = | |
506 | makeDiagEIW ({name = "redundantMatch", | |
507 | default = DiagEIW.Warn, expert = false}, ac) | |
508 | val (nonexhaustiveRaise, ac) = | |
509 | makeDiagEIW ({name = "nonexhaustiveRaise", | |
510 | default = DiagEIW.Ignore, expert = false}, ac) | |
511 | val (nonexhaustiveExnRaise, ac) = | |
512 | makeDiagDI ({name = "nonexhaustiveExnRaise", | |
513 | default = DiagDI.Ignore, expert = false}, ac) | |
514 | val (redundantRaise, ac) = | |
515 | makeDiagEIW ({name = "redundantRaise", | |
516 | default = DiagEIW.Warn, expert = false}, ac) | |
517 | val (resolveScope, ac) = | |
518 | make ({choices = SOME [ResolveScope.Dec, ResolveScope.Strdec, ResolveScope.Topdec, ResolveScope.Program], | |
519 | default = ResolveScope.Strdec, | |
520 | expert = true, | |
521 | toString = ResolveScope.toString, | |
522 | name = "resolveScope", | |
523 | newCur = fn (_,rs) => rs, | |
524 | newDef = fn (_,rs) => rs, | |
525 | parseArgs = fn args' => | |
526 | case args' of | |
527 | [arg'] => ResolveScope.fromString arg' | |
528 | | _ => NONE}, | |
529 | ac) | |
530 | val (sequenceNonUnit, ac) = | |
531 | makeDiagEIW ({name = "sequenceNonUnit", | |
532 | default = DiagEIW.Ignore, expert = false}, ac) | |
533 | val (valrecConstr, ac) = | |
534 | makeDiagEIW ({name = "valrecConstr", | |
535 | default = DiagEIW.Warn, expert = false}, ac) | |
536 | val (warnUnused, ac) = | |
537 | makeBool ({name = "warnUnused", | |
538 | default = false, expert = false}, ac) | |
539 | ||
540 | (* Successor ML *) | |
541 | val (allowDoDecls, ac) = | |
542 | makeBool ({name = "allowDoDecls", | |
543 | default = false, expert = false}, ac) | |
544 | val (allowExtendedNumConsts, ac) = | |
545 | makeBool ({name = "allowExtendedNumConsts", | |
546 | default = false, expert = false}, ac) | |
547 | val (allowExtendedTextConsts, ac) = | |
548 | makeBool ({name = "allowExtendedTextConsts", | |
549 | default = false, expert = false}, ac) | |
550 | val (allowLineComments, ac) = | |
551 | makeBool ({name = "allowLineComments", | |
552 | default = false, expert = false}, ac) | |
553 | val (allowOptBar, ac) = | |
554 | makeBool ({name = "allowOptBar", | |
555 | default = false, expert = false}, ac) | |
556 | val (allowOptSemicolon, ac) = | |
557 | makeBool ({name = "allowOptSemicolon", | |
558 | default = false, expert = false}, ac) | |
559 | val (allowOrPats, ac) = | |
560 | makeBool ({name = "allowOrPats", | |
561 | default = false, expert = false}, ac) | |
562 | val (allowRecordPunExps, ac) = | |
563 | makeBool ({name = "allowRecordPunExps", | |
564 | default = false, expert = false}, ac) | |
565 | val (allowSigWithtype, ac) = | |
566 | makeBool ({name = "allowSigWithtype", | |
567 | default = false, expert = false}, ac) | |
568 | val (allowVectorExps, ac) = | |
569 | makeBool ({name = "allowVectorExps", | |
570 | default = false, expert = false}, ac) | |
571 | val (allowVectorPats, ac) = | |
572 | makeBool ({name = "allowVectorPats", | |
573 | default = false, expert = false}, ac) | |
574 | val extendedConstsCtrls = | |
575 | [allowExtendedNumConsts, allowExtendedTextConsts] | |
576 | val vectorCtrls = | |
577 | [allowVectorExps, allowVectorPats] | |
578 | val successorMLCtrls = | |
579 | [allowDoDecls, allowExtendedNumConsts, | |
580 | allowExtendedTextConsts, allowLineComments, allowOptBar, | |
581 | allowOptSemicolon, allowOrPats, allowRecordPunExps, | |
582 | allowSigWithtype, allowVectorExps, allowVectorPats] | |
583 | ||
584 | ||
585 | val {parseId, parseIdAndArgs, withDef, snapshot} = ac | |
586 | end | |
587 | ||
588 | local | |
589 | fun makeProxy ({alts: (Id.t * ('args -> string list option)) list, | |
590 | choices: 'args list option, | |
591 | deprecated: bool, | |
592 | expert: bool, | |
593 | toString: 'args -> string, | |
594 | name: string, | |
595 | parseArgs: string list -> 'args option}, | |
596 | {parseId: string -> Id.t parseResult, | |
597 | parseIdAndArgs: string list -> (Id.t * Args.t) parseResult}) = | |
598 | let | |
599 | val () = | |
600 | if deprecated then () else | |
601 | List.push | |
602 | (documentation, | |
603 | {choices = Option.map (choices, fn cs => | |
604 | List.map (cs, toString)), | |
605 | expert = expert, | |
606 | name = name}) | |
607 | val parseId = fn name' => | |
608 | if String.equals (name', name) | |
609 | then Proxy (List.map (alts, fn (id, _) => id), {deprecated = deprecated}) | |
610 | else parseId name' | |
611 | val parseIdAndArgs = fn ss => | |
612 | case ss of | |
613 | name'::args' => | |
614 | if String.equals (name', name) | |
615 | then | |
616 | case parseArgs args' of | |
617 | SOME v => let | |
618 | val alts = | |
619 | List.keepAllMap | |
620 | (alts, fn (id, mkArgs) => | |
621 | Option.map | |
622 | (mkArgs v, fn ss => | |
623 | deGood (parseIdAndArgs ((Id.name id)::ss)))) | |
624 | in | |
625 | Proxy (alts, {deprecated = deprecated}) | |
626 | end | |
627 | | NONE => Bad | |
628 | else parseIdAndArgs ss | |
629 | | _ => Bad | |
630 | in | |
631 | {parseId = parseId, | |
632 | parseIdAndArgs = parseIdAndArgs} | |
633 | end | |
634 | ||
635 | fun makeProxyBoolSimple ({alts: Id.t list, | |
636 | default: bool, | |
637 | deprecated: bool, | |
638 | expert: bool, | |
639 | name: string}, ac) = | |
640 | makeProxy ({alts = List.map (alts, fn id => (id, fn b => SOME [Bool.toString b])), | |
641 | choices = SOME (if default then [true, false] | |
642 | else [false, true]), | |
643 | deprecated = deprecated, | |
644 | expert = expert, | |
645 | toString = Bool.toString, | |
646 | name = name, | |
647 | parseArgs = fn args' => | |
648 | case args' of | |
649 | [arg'] => Bool.fromString arg' | |
650 | | _ => NONE}, | |
651 | ac) | |
652 | in | |
653 | val ac = {parseId = parseId, parseIdAndArgs = parseIdAndArgs} | |
654 | ||
655 | (* Successor ML *) | |
656 | val ac = | |
657 | makeProxyBoolSimple ({alts = List.map (extendedConstsCtrls, id), | |
658 | default = false, | |
659 | deprecated = false, | |
660 | expert = false, | |
661 | name = "allowExtendedConsts"}, ac) | |
662 | val ac = | |
663 | makeProxyBoolSimple ({alts = List.map (vectorCtrls, id), | |
664 | default = false, | |
665 | deprecated = false, | |
666 | expert = false, | |
667 | name = "allowVectorExpsAndPats"}, ac) | |
668 | val ac = | |
669 | makeProxyBoolSimple ({alts = List.map (successorMLCtrls, id), | |
670 | default = false, | |
671 | deprecated = false, | |
672 | expert = false, | |
673 | name = "allowSuccessorML"}, ac) | |
674 | ||
675 | val {parseId, parseIdAndArgs} = ac | |
676 | end | |
677 | ||
678 | local | |
679 | fun checkPrefix (s, f) = | |
680 | case String.peeki (s, fn (_, c) => c = #":") of | |
681 | NONE => f s | |
682 | | SOME (i, _) => | |
683 | let | |
684 | val comp = String.prefix (s, i) | |
685 | val comp = String.deleteSurroundingWhitespace comp | |
686 | val s = String.dropPrefix (s, i + 1) | |
687 | in | |
688 | if String.equals (comp, "mlton") | |
689 | then f s | |
690 | else Other | |
691 | end | |
692 | in | |
693 | val parseId = fn s => checkPrefix (s, parseId) | |
694 | val parseIdAndArgs = fn s => checkPrefix (s, fn s => parseIdAndArgs (String.tokens (s, Char.isSpace))) | |
695 | end | |
696 | ||
697 | val processDefault = fn s => | |
698 | case parseIdAndArgs s of | |
699 | Bad => Bad | |
700 | | Good (id, args) => if Args.processDef args then Good id else Bad | |
701 | | Proxy (alts, {deprecated}) => | |
702 | List.fold | |
703 | (alts, Proxy (List.map (alts, #1), {deprecated = deprecated}), | |
704 | fn ((_,args),res) => | |
705 | if Args.processDef args then res else Bad) | |
706 | | Other => Bad | |
707 | ||
708 | val processEnabled = fn (s, b) => | |
709 | case parseId s of | |
710 | Bad => Bad | |
711 | | Proxy (alts, {deprecated}) => | |
712 | List.fold | |
713 | (alts, Proxy (alts, {deprecated = deprecated}), | |
714 | fn (id, res) => | |
715 | if Id.setEnabled (id, b) then res else Bad) | |
716 | | Good id => if Id.setEnabled (id, b) then Good id else Bad | |
717 | | Other => Bad | |
718 | ||
719 | val withDef : (unit -> 'a) -> 'a = fn f => | |
720 | let | |
721 | val restore = withDef () | |
722 | in | |
723 | Exn.finally (f, restore) | |
724 | end | |
725 | ||
726 | val snapshot : unit -> (unit -> 'a) -> 'a = fn () => | |
727 | let | |
728 | val withSaved = snapshot () | |
729 | in | |
730 | fn f => | |
731 | let | |
732 | val restore = withSaved () | |
733 | in | |
734 | Exn.finally (f, restore) | |
735 | end | |
736 | end | |
737 | ||
738 | end | |
739 | ||
740 | val elaborateOnly = | |
741 | control {name = "elaborate only", | |
742 | default = false, | |
743 | toString = Bool.toString} | |
744 | ||
745 | val emitMain = | |
746 | control {name = "emit main", | |
747 | default = true, | |
748 | toString = Bool.toString} | |
749 | ||
750 | val exportHeader = | |
751 | control {name = "export header", | |
752 | default = NONE, | |
753 | toString = Option.toString File.toString} | |
754 | ||
755 | val exnHistory = control {name = "exn history", | |
756 | default = false, | |
757 | toString = Bool.toString} | |
758 | ||
759 | structure Format = | |
760 | struct | |
761 | datatype t = | |
762 | Archive | |
763 | | Executable | |
764 | | LibArchive | |
765 | | Library | |
766 | ||
767 | (* Default option first for usage message. *) | |
768 | val all = [Executable, Archive, LibArchive, Library] | |
769 | ||
770 | val toString: t -> string = | |
771 | fn Archive => "archive" | |
772 | | Executable => "executable" | |
773 | | LibArchive => "libarchive" | |
774 | | Library => "library" | |
775 | end | |
776 | ||
777 | datatype format = datatype Format.t | |
778 | ||
779 | val format = control {name = "generated output format", | |
780 | default = Format.Executable, | |
781 | toString = Format.toString} | |
782 | ||
783 | structure GcCheck = | |
784 | struct | |
785 | datatype t = | |
786 | Limit | |
787 | | First | |
788 | | Every | |
789 | ||
790 | local open Layout | |
791 | in | |
792 | val layout = | |
793 | fn Limit => str "Limit" | |
794 | | First => str "First" | |
795 | | Every => str "Every" | |
796 | end | |
797 | val toString = Layout.toString o layout | |
798 | end | |
799 | ||
800 | datatype gcCheck = datatype GcCheck.t | |
801 | ||
802 | val gcCheck = control {name = "gc check", | |
803 | default = Limit, | |
804 | toString = GcCheck.toString} | |
805 | ||
806 | val indentation = control {name = "indentation", | |
807 | default = 3, | |
808 | toString = Int.toString} | |
809 | ||
810 | val inlineIntoMain = control {name = "inlineIntoMain", | |
811 | default = true, | |
812 | toString = Bool.toString} | |
813 | ||
814 | val inlineLeafA = | |
815 | control {name = "inlineLeafA", | |
816 | default = {loops = true, | |
817 | repeat = true, | |
818 | size = SOME 20}, | |
819 | toString = | |
820 | fn {loops, repeat, size} => | |
821 | Layout.toString | |
822 | (Layout.record [("loops", Bool.layout loops), | |
823 | ("repeat", Bool.layout repeat), | |
824 | ("size", Option.layout Int.layout size)])} | |
825 | val inlineLeafB = | |
826 | control {name = "inlineLeafB", | |
827 | default = {loops = true, | |
828 | repeat = true, | |
829 | size = SOME 40}, | |
830 | toString = | |
831 | fn {loops, repeat, size} => | |
832 | Layout.toString | |
833 | (Layout.record [("loops", Bool.layout loops), | |
834 | ("repeat", Bool.layout repeat), | |
835 | ("size", Option.layout Int.layout size)])} | |
836 | ||
837 | val inlineNonRec = | |
838 | control {name = "inlineNonRec", | |
839 | default = {small = 60, | |
840 | product = 320}, | |
841 | toString = | |
842 | fn {small, product} => | |
843 | Layout.toString | |
844 | (Layout.record [("small", Int.layout small), | |
845 | ("product", Int.layout product)])} | |
846 | ||
847 | val inputFile = control {name = "input file", | |
848 | default = "<bogus>", | |
849 | toString = File.toString} | |
850 | ||
851 | val keepAST = control {name = "keep AST", | |
852 | default = false, | |
853 | toString = Bool.toString} | |
854 | ||
855 | val keepCoreML = control {name = "keep CoreML", | |
856 | default = false, | |
857 | toString = Bool.toString} | |
858 | ||
859 | val keepDefUse = control {name = "keep def use", | |
860 | default = true, | |
861 | toString = Bool.toString} | |
862 | ||
863 | val keepDot = control {name = "keep dot", | |
864 | default = false, | |
865 | toString = Bool.toString} | |
866 | ||
867 | val keepMachine = control {name = "keep Machine", | |
868 | default = false, | |
869 | toString = Bool.toString} | |
870 | ||
871 | val keepPasses = control {name = "keep passes", | |
872 | default = [], | |
873 | toString = List.toString | |
874 | (Layout.toString o | |
875 | Regexp.Compiled.layout)} | |
876 | ||
877 | val keepRSSA = control {name = "keep RSSA", | |
878 | default = false, | |
879 | toString = Bool.toString} | |
880 | ||
881 | val keepSSA = control {name = "keep SSA", | |
882 | default = false, | |
883 | toString = Bool.toString} | |
884 | ||
885 | val keepSSA2 = control {name = "keep SSA2", | |
886 | default = false, | |
887 | toString = Bool.toString} | |
888 | ||
889 | val keepSXML = control {name = "keep SXML", | |
890 | default = false, | |
891 | toString = Bool.toString} | |
892 | ||
893 | ||
894 | val keepXML = control {name = "keep XML", | |
895 | default = false, | |
896 | toString = Bool.toString} | |
897 | ||
898 | val labelsHaveExtra_ = control {name = "extra_", | |
899 | default = false, | |
900 | toString = Bool.toString} | |
901 | ||
902 | val libDir = control {name = "lib dir", | |
903 | default = "<libDir unset>", | |
904 | toString = fn s => s} | |
905 | ||
906 | val libTargetDir = control {name = "lib target dir", | |
907 | default = "<libTargetDir unset>", | |
908 | toString = fn s => s} | |
909 | ||
910 | val libname = ref "" | |
911 | ||
912 | val loopSsaPasses = control {name = "loop ssa passes", | |
913 | default = 1, | |
914 | toString = Int.toString} | |
915 | ||
916 | val loopSsa2Passes = control {name = "loop ssa2 passes", | |
917 | default = 1, | |
918 | toString = Int.toString} | |
919 | ||
920 | val loopUnrollLimit = control {name = "loop unrolling limit", | |
921 | default = 150, | |
922 | toString = Int.toString} | |
923 | val loopUnswitchLimit = control {name = "loop unswitching limit", | |
924 | default = 300, | |
925 | toString = Int.toString} | |
926 | ||
927 | val markCards = control {name = "mark cards", | |
928 | default = true, | |
929 | toString = Bool.toString} | |
930 | ||
931 | val maxFunctionSize = control {name = "max function size", | |
932 | default = 10000, | |
933 | toString = Int.toString} | |
934 | ||
935 | val mlbPathVars = | |
936 | control | |
937 | {name = "mlb path vars", | |
938 | default = [], | |
939 | toString = List.toString | |
940 | (fn {var, path} => | |
941 | concat ["{var = ", var, ", path = ", path, "}"])} | |
942 | ||
943 | structure Native = | |
944 | struct | |
945 | val commented = control {name = "native commented", | |
946 | default = 0, | |
947 | toString = Int.toString} | |
948 | ||
949 | val liveStack = control {name = "native live stack", | |
950 | default = false, | |
951 | toString = Bool.toString} | |
952 | ||
953 | val optimize = control {name = "native optimize", | |
954 | default = 1, | |
955 | toString = Int.toString} | |
956 | ||
957 | val moveHoist = control {name = "native move hoist", | |
958 | default = true, | |
959 | toString = Bool.toString} | |
960 | ||
961 | val copyProp = control {name = "native copy prop", | |
962 | default = true, | |
963 | toString = Bool.toString} | |
964 | ||
965 | val copyPropCutoff = control {name = "native copy prop cutoff", | |
966 | default = 1000, | |
967 | toString = Int.toString} | |
968 | ||
969 | val cutoff = control {name = "native cutoff", | |
970 | default = 100, | |
971 | toString = Int.toString} | |
972 | ||
973 | val liveTransfer = control {name = "native live transfer", | |
974 | default = 8, | |
975 | toString = Int.toString} | |
976 | ||
977 | val shuffle = control {name = "native shuffle", | |
978 | default = true, | |
979 | toString = Bool.toString} | |
980 | ||
981 | val IEEEFP = control {name = "native ieee fp", | |
982 | default = false, | |
983 | toString = Bool.toString} | |
984 | ||
985 | val split = control {name = "native split", | |
986 | default = SOME 20000, | |
987 | toString = Option.toString Int.toString} | |
988 | end | |
989 | ||
990 | val optFuel = | |
991 | control {name = "optFuel", | |
992 | default = NONE, | |
993 | toString = Option.toString Int.toString} | |
994 | ||
995 | fun optFuelAvailAndUse () = | |
996 | case !optFuel of | |
997 | NONE => true | |
998 | | SOME i => if i > 0 | |
999 | then (optFuel := SOME (i - 1); true) | |
1000 | else false | |
1001 | (* Suppress unused variable warning | |
1002 | * This variable is purposefully unused in production, | |
1003 | * but is retained to make it easy to use in development of new | |
1004 | * optimization passes. | |
1005 | *) | |
1006 | val _ = optFuelAvailAndUse | |
1007 | ||
1008 | val optimizationPasses: | |
1009 | {il: string, set: string -> unit Result.t, get: unit -> string} list ref = | |
1010 | control {name = "optimizationPasses", | |
1011 | default = [], | |
1012 | toString = List.toString | |
1013 | (fn {il,get,...} => concat ["<",il,"::",get (),">"])} | |
1014 | ||
1015 | val polyvariance = | |
1016 | control {name = "polyvariance", | |
1017 | default = SOME {hofo = true, | |
1018 | rounds = 2, | |
1019 | small = 30, | |
1020 | product = 300}, | |
1021 | toString = | |
1022 | fn p => | |
1023 | Layout.toString | |
1024 | (Option.layout | |
1025 | (fn {hofo, rounds, small, product} => | |
1026 | Layout.record [("hofo", Bool.layout hofo), | |
1027 | ("rounds", Int.layout rounds), | |
1028 | ("small", Int.layout small), | |
1029 | ("product", Int.layout product)]) | |
1030 | p)} | |
1031 | ||
1032 | val positionIndependent = ref false | |
1033 | ||
1034 | val preferAbsPaths = control {name = "prefer abs paths", | |
1035 | default = false, | |
1036 | toString = Bool.toString} | |
1037 | ||
1038 | val profPasses = | |
1039 | control {name = "prof passes", | |
1040 | default = [], | |
1041 | toString = List.toString | |
1042 | (Layout.toString o | |
1043 | Regexp.Compiled.layout)} | |
1044 | ||
1045 | structure Profile = | |
1046 | struct | |
1047 | datatype t = | |
1048 | ProfileNone | |
1049 | | ProfileAlloc | |
1050 | | ProfileCallStack | |
1051 | | ProfileCount | |
1052 | | ProfileDrop | |
1053 | | ProfileLabel | |
1054 | | ProfileTimeField | |
1055 | | ProfileTimeLabel | |
1056 | ||
1057 | val toString = | |
1058 | fn ProfileNone => "None" | |
1059 | | ProfileAlloc => "Alloc" | |
1060 | | ProfileCallStack => "CallStack" | |
1061 | | ProfileCount => "Count" | |
1062 | | ProfileDrop => "Drop" | |
1063 | | ProfileLabel => "Label" | |
1064 | | ProfileTimeField => "TimeField" | |
1065 | | ProfileTimeLabel => "TimeLabel" | |
1066 | end | |
1067 | ||
1068 | datatype profile = datatype Profile.t | |
1069 | ||
1070 | val profile = control {name = "profile", | |
1071 | default = ProfileNone, | |
1072 | toString = Profile.toString} | |
1073 | ||
1074 | val profileBranch = control {name = "profile branch", | |
1075 | default = false, | |
1076 | toString = Bool.toString} | |
1077 | ||
1078 | val profileC = control {name = "profile C", | |
1079 | default = [], | |
1080 | toString = List.toString | |
1081 | (Layout.toString o | |
1082 | Regexp.Compiled.layout)} | |
1083 | ||
1084 | structure ProfileIL = | |
1085 | struct | |
1086 | datatype t = ProfileSource | ProfileSSA | ProfileSSA2 | |
1087 | ||
1088 | val toString = | |
1089 | fn ProfileSource => "ProfileSource" | |
1090 | | ProfileSSA => "ProfileSSA" | |
1091 | | ProfileSSA2 => "ProfileSSA2" | |
1092 | end | |
1093 | ||
1094 | datatype profileIL = datatype ProfileIL.t | |
1095 | ||
1096 | val profileIL = control {name = "profile IL", | |
1097 | default = ProfileSource, | |
1098 | toString = ProfileIL.toString} | |
1099 | ||
1100 | val profileInclExcl = | |
1101 | control {name = "profile include/exclude", | |
1102 | default = [], | |
1103 | toString = List.toString | |
1104 | (Layout.toString o | |
1105 | (Layout.tuple2 (Regexp.Compiled.layout, | |
1106 | Bool.layout)))} | |
1107 | ||
1108 | val profileRaise = control {name = "profile raise", | |
1109 | default = false, | |
1110 | toString = Bool.toString} | |
1111 | ||
1112 | val profileStack = control {name = "profile stack", | |
1113 | default = false, | |
1114 | toString = Bool.toString} | |
1115 | ||
1116 | val profileVal = control {name = "profile val", | |
1117 | default = false, | |
1118 | toString = Bool.toString} | |
1119 | ||
1120 | val showBasis = control {name = "show basis", | |
1121 | default = NONE, | |
1122 | toString = Option.toString File.toString} | |
1123 | ||
1124 | val showBasisCompact = control {name = "show basis compact", | |
1125 | default = false, | |
1126 | toString = Bool.toString} | |
1127 | val showBasisDef = control {name = "show basis def", | |
1128 | default = true, | |
1129 | toString = Bool.toString} | |
1130 | val showBasisFlat = control {name = "show basis flat", | |
1131 | default = true, | |
1132 | toString = Bool.toString} | |
1133 | ||
1134 | val showDefUse = control {name = "show def-use", | |
1135 | default = NONE, | |
1136 | toString = Option.toString File.toString} | |
1137 | ||
1138 | val showTypes = control {name = "show types", | |
1139 | default = true, | |
1140 | toString = Bool.toString} | |
1141 | ||
1142 | structure Target = | |
1143 | struct | |
1144 | datatype t = | |
1145 | Cross of string | |
1146 | | Self | |
1147 | ||
1148 | val toString = | |
1149 | fn Cross s => s | |
1150 | | Self => "self" | |
1151 | end | |
1152 | ||
1153 | datatype target = datatype Target.t | |
1154 | ||
1155 | val target = control {name = "target", | |
1156 | default = Self, | |
1157 | toString = Target.toString} | |
1158 | ||
1159 | structure Target = | |
1160 | struct | |
1161 | open Target | |
1162 | ||
1163 | datatype arch = datatype MLton.Platform.Arch.t | |
1164 | ||
1165 | val arch = control {name = "target arch", | |
1166 | default = X86, | |
1167 | toString = MLton.Platform.Arch.toString} | |
1168 | ||
1169 | datatype os = datatype MLton.Platform.OS.t | |
1170 | ||
1171 | val os = control {name = "target OS", | |
1172 | default = Linux, | |
1173 | toString = MLton.Platform.OS.toString} | |
1174 | ||
1175 | fun make s = | |
1176 | let | |
1177 | val r = ref NONE | |
1178 | fun get () = | |
1179 | case !r of | |
1180 | NONE => Error.bug ("ControlFlags.Target." ^ s ^ ": not set") | |
1181 | | SOME x => x | |
1182 | fun set x = r := SOME x | |
1183 | in | |
1184 | (get, set) | |
1185 | end | |
1186 | val (bigEndian: unit -> bool, setBigEndian) = make "bigEndian" | |
1187 | ||
1188 | structure Size = | |
1189 | struct | |
1190 | val (arrayMetaData: unit -> Bits.t, set_arrayMetaData) = make "Size.arrayMetaData" | |
1191 | val (cint: unit -> Bits.t, set_cint) = make "Size.cint" | |
1192 | val (cpointer: unit -> Bits.t, set_cpointer) = make "Size.cpointer" | |
1193 | val (cptrdiff: unit -> Bits.t, set_cptrdiff) = make "Size.cptrdiff" | |
1194 | val (csize: unit -> Bits.t, set_csize) = make "Size.csize" | |
1195 | val (header: unit -> Bits.t, set_header) = make "Size.header" | |
1196 | val (mplimb: unit -> Bits.t, set_mplimb) = make "Size.mplimb" | |
1197 | val (normalMetaData: unit -> Bits.t, set_normalMetaData) = make "Size.noramlMetaData" | |
1198 | val (objptr: unit -> Bits.t, set_objptr) = make "Size.objptr" | |
1199 | val (seqIndex: unit -> Bits.t, set_seqIndex) = make "Size.seqIndex" | |
1200 | end | |
1201 | fun setSizes {arrayMetaData, cint, cpointer, cptrdiff, csize, | |
1202 | header, mplimb, normalMetaData, objptr, seqIndex} = | |
1203 | (Size.set_arrayMetaData arrayMetaData | |
1204 | ; Size.set_cint cint | |
1205 | ; Size.set_cpointer cpointer | |
1206 | ; Size.set_cptrdiff cptrdiff | |
1207 | ; Size.set_csize csize | |
1208 | ; Size.set_header header | |
1209 | ; Size.set_mplimb mplimb | |
1210 | ; Size.set_normalMetaData normalMetaData | |
1211 | ; Size.set_objptr objptr | |
1212 | ; Size.set_seqIndex seqIndex) | |
1213 | end | |
1214 | ||
1215 | fun mlbPathMap () = | |
1216 | List.rev | |
1217 | (List.concat | |
1218 | [[{var = "LIB_MLTON_DIR", | |
1219 | path = !libDir}, | |
1220 | {var = "TARGET", | |
1221 | path = Target.toString (!target)}, | |
1222 | {var = "TARGET_ARCH", | |
1223 | path = String.toLower (MLton.Platform.Arch.toString | |
1224 | (!Target.arch))}, | |
1225 | {var = "TARGET_OS", | |
1226 | path = String.toLower (MLton.Platform.OS.toString | |
1227 | (!Target.os))}, | |
1228 | {var = "OBJPTR_REP", | |
1229 | path = (case Bits.toInt (Target.Size.objptr ()) of | |
1230 | 32 => "rep32" | |
1231 | | 64 => "rep64" | |
1232 | | _ => Error.bug "Control.mlbPathMap")}, | |
1233 | {var = "ARRAY_METADATA_SIZE", | |
1234 | path = (case Bits.toInt (Target.Size.arrayMetaData ()) of | |
1235 | 96 => "size96" | |
1236 | | 192 => "size192" | |
1237 | | _ => Error.bug "Control.mlbPathMap")}, | |
1238 | {var = "NORMAL_METADATA_SIZE", | |
1239 | path = (case Bits.toInt (Target.Size.normalMetaData ()) of | |
1240 | 32 => "size32" | |
1241 | | 64 => "size64" | |
1242 | | _ => Error.bug "Control.mlbPathMap")}, | |
1243 | {var = "SEQINDEX_INT", | |
1244 | path = (case Bits.toInt (Target.Size.seqIndex ()) of | |
1245 | 32 => "int32" | |
1246 | | 64 => "int64" | |
1247 | | _ => Error.bug "Control.mlbPathMap")}, | |
1248 | {var = "DEFAULT_CHAR", | |
1249 | path = !defaultChar}, | |
1250 | {var = "DEFAULT_WIDECHAR", | |
1251 | path = !defaultWideChar}, | |
1252 | {var = "DEFAULT_INT", | |
1253 | path = !defaultInt}, | |
1254 | {var = "DEFAULT_REAL", | |
1255 | path = !defaultReal}, | |
1256 | {var = "DEFAULT_WORD", | |
1257 | path = !defaultWord}], | |
1258 | !mlbPathVars]) | |
1259 | ||
1260 | val typeCheck = control {name = "type check", | |
1261 | default = false, | |
1262 | toString = Bool.toString} | |
1263 | ||
1264 | structure Verbosity = | |
1265 | struct | |
1266 | datatype t = | |
1267 | Silent | |
1268 | | Top | |
1269 | | Pass | |
1270 | | Detail | |
1271 | ||
1272 | val toString = | |
1273 | fn Silent => "Silent" | |
1274 | | Top => "Top" | |
1275 | | Pass => "Pass" | |
1276 | | Detail => "Detail" | |
1277 | end | |
1278 | ||
1279 | datatype verbosity = datatype Verbosity.t | |
1280 | ||
1281 | val verbosity = control {name = "verbosity", | |
1282 | default = Silent, | |
1283 | toString = Verbosity.toString} | |
1284 | ||
1285 | val warnAnn = control {name = "warn unrecognized annotation", | |
1286 | default = true, | |
1287 | toString = Bool.toString} | |
1288 | ||
1289 | val warnDeprecated = control {name = "warn deprecated features", | |
1290 | default = true, | |
1291 | toString = Bool.toString} | |
1292 | ||
1293 | val zoneCutDepth: int ref = | |
1294 | control {name = "zone cut depth", | |
1295 | default = 100, | |
1296 | toString = Int.toString} | |
1297 | ||
1298 | val defaults = setDefaults | |
1299 | ||
1300 | val _ = defaults () | |
1301 | ||
1302 | end |