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
.
6 * MLton is released under a BSD
-style license
.
7 * See the file MLton
-LICENSE for details
.
10 structure ControlFlags
: CONTROL_FLAGS
=
13 structure C
= Control ()
18 datatype t
= Align4 | Align8
25 datatype align
= datatype Align
.t
27 val align
= control
{name
= "align",
29 toString
= Align
.toString
}
31 val atMLtons
= control
{name
= "atMLtons",
32 default
= Vector.new0 (),
33 toString
= fn v
=> Layout
.toString (Vector.layout
41 | Coalesce
of {limit
: int}
44 fn OneChunk
=> "one chunk"
45 | ChunkPerFunc
=> "chunk per function"
46 | Coalesce
{limit
} => concat
["coalesce ", Int.toString limit
]
49 datatype chunk
= datatype Chunk
.t
51 val chunk
= control
{name
= "chunk",
52 default
= Coalesce
{limit
= 4096},
53 toString
= Chunk
.toString
}
55 val closureConvertGlobalize
= control
{name
= "closureConvertGlobalize",
57 toString
= Bool.toString
}
59 val closureConvertShrink
= control
{name
= "closureConvertShrink",
61 toString
= Bool.toString
}
71 val all
= [X86Codegen
,AMD64Codegen
,CCodegen
,LLVMCodegen
]
73 val toString
: t
-> string =
74 fn AMD64Codegen
=> "amd64"
76 | LLVMCodegen
=> "llvm"
80 datatype codegen
= datatype Codegen
.t
82 val codegen
= control
{name
= "codegen",
83 default
= Codegen
.X86Codegen
,
84 toString
= Codegen
.toString
}
86 val contifyIntoMain
= control
{name
= "contifyIntoMain",
88 toString
= Bool.toString
}
90 val debug
= control
{name
= "debug",
92 toString
= Bool.toString
}
94 val defaultChar
= control
{name
= "defaultChar",
97 val defaultWideChar
= control
{name
= "defaultWideChar",
98 default
= "widechar32",
100 val defaultInt
= control
{name
= "defaultInt",
102 toString
= fn s
=> s
}
103 val defaultReal
= control
{name
= "defaultReal",
105 toString
= fn s
=> s
}
106 val defaultWord
= control
{name
= "defaultWord",
108 toString
= fn s
=> s
}
111 control
{name
= "diag passes",
113 toString
= List.toString
115 Regexp
.Compiled
.layout
)}
118 control
{name
= "execute passes",
120 toString
= List.toString
123 (Regexp
.Compiled
.layout
, Bool.layout
)))}
125 structure Elaborate
=
134 val fromString
: string -> t option
=
135 fn "error" => SOME Error
136 |
"ignore" => SOME Ignore
137 |
"warn" => SOME Warn
140 val toString
: t
-> string =
152 val fromString
: string -> t option
=
153 fn "default" => SOME Default
154 |
"ignore" => SOME Ignore
157 val toString
: t
-> string =
158 fn Default
=> "default"
162 structure ResolveScope
=
170 val fromString
: string -> t option
=
172 |
"strdec" => SOME Strdec
173 |
"topdec" => SOME Topdec
174 |
"program" => SOME Program
177 val toString
: t
-> string =
181 | Program
=> "program"
186 datatype t
= T
of {enabled
: bool ref
,
189 fun equals (T
{enabled
= enabled1
, ...},
190 T
{enabled
= enabled2
, ...}) =
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
200 datatype t
= T
of {fillArgs
: unit
-> (unit
-> unit
),
201 processAnn
: unit
-> (unit
-> unit
),
202 processDef
: unit
-> bool}
204 fun make
sel (T r
) = sel r
206 fun processAnn args
= (make #processAnn args
) ()
207 fun processDef args
= (make #processDef args
) ()
210 datatype ('args
, 'st
) t
= T
of {args
: 'args option ref
,
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
')
222 datatype 'a parseResult
=
223 Bad | Good
of 'a | Other | Proxy
of 'a list
* {deprecated
: bool}
226 | _
=> Error
.bug
"Control.Elaborate.deGood"
228 val documentation
: {choices
: string list option
,
230 name
: string} list ref
= ref
[]
232 fun document
{expert
} =
234 val all
= !documentation
237 else List.keepAll (all
, not
o #expert
)
240 (all
, fn ({name
= n
, ...}, {name
= n
', ...}) => n
<= n
')
245 (all
, fn {choices
, name
, ...} =>
251 concat (List.separate (cs
, "|")),
256 fun make ({choices
: 'st list option
,
259 toString
: 'st
-> 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
)}) =
272 {choices
= Option
.map (choices
, fn cs
=>
273 List.map (cs
, toString
)),
276 val ctrl
as T
{args
= argsRef
, cur
, def
,
277 id
as Id
.T
{enabled
, ...}, ...} =
280 def
= control
{name
= concat
["elaborate ", name
,
283 toString
= toString
},
284 id
= Id
.T
{enabled
= control
{name
= concat
["elaborate ", name
,
287 toString
= Bool.toString
},
290 val parseId
= fn name
' =>
291 if String.equals (name
', name
)
294 val parseIdAndArgs
= fn ss
=>
297 if String.equals (name
', name
)
299 case parseArgs args
' of
304 ; fn () => argsRef
:= NONE
)
309 val new
= newCur (old
, v
)
312 ; fn () => cur
:= old
318 val new
= newDef (old
, v
)
324 Args
.T
{fillArgs
= fillArgs
,
325 processAnn
= processAnn
,
326 processDef
= processDef
}
331 else parseIdAndArgs ss
333 val withDef
: unit
-> (unit
-> unit
) =
336 val restore
= withDef ()
340 ; fn () => (cur
:= old
343 val snapshot
: unit
-> unit
-> (unit
-> unit
) =
346 val withSaved
= snapshot ()
351 val restore
= withSaved ()
355 ; fn () => (cur
:= old
362 parseIdAndArgs
= parseIdAndArgs
,
364 snapshot
= snapshot
})
367 fun makeBool ({default
: bool,
370 make ({choices
= SOME (if default
then [true, false]
374 toString
= Bool.toString
,
376 newCur
= fn (_
,b
) => b
,
377 newDef
= fn (_
,b
) => b
,
378 parseArgs
= fn args
' =>
380 [arg
'] => Bool.fromString arg
'
384 fun makeDiagnostic ({choices
,
390 make ({choices
= choices
,
393 toString
= diagToString
,
395 newCur
= fn (_
,d
) => d
,
396 newDef
= fn (_
,d
) => d
,
397 parseArgs
= fn args
' =>
399 [arg
'] => diagFromString arg
'
402 fun makeDiagEIW ({default
: DiagEIW
.t
,
405 makeDiagnostic ({choices
= (SOME
407 datatype z
= datatype DiagEIW
.t
410 Error
=> [Error
, Ignore
, Warn
]
411 | Ignore
=> [Ignore
, Error
, Warn
]
412 | Warn
=> [Warn
, Ignore
, Error
]
415 diagToString
= DiagEIW
.toString
,
416 diagFromString
= DiagEIW
.fromString
,
419 fun makeDiagDI ({default
: DiagDI
.t
,
422 makeDiagnostic ({choices
= (SOME
424 datatype z
= datatype DiagDI
.t
427 Default
=> [Default
, Ignore
]
428 | Ignore
=> [Ignore
, Default
]
431 diagToString
= DiagDI
.toString
,
432 diagFromString
= DiagDI
.fromString
,
437 {parseId
= fn _
=> Bad
,
438 parseIdAndArgs
= fn _
=> Bad
,
439 withDef
= fn () => (fn () => ()),
440 snapshot
= fn () => fn () => (fn () => ())}
443 val (allowConstant
, ac
) =
444 makeBool ({name
= "allowConstant",
445 default
= false, expert
= true}, 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
)
462 makeBool ({name
= "deadCode",
463 default
= false, expert
= true}, ac
)
464 val (forceUsed
, ac
) =
465 make ({choices
= NONE
,
468 toString
= Bool.toString
,
470 newCur
= fn (b
,()) => b
,
471 newDef
= fn (_
,()) => true,
472 parseArgs
= fn args
' =>
478 make ({choices
= SOME
[SOME
"<longstrid>"],
481 toString
= fn NONE
=> "" | SOME s
=> s
,
483 newCur
= fn (_
,s
) => SOME s
,
484 newDef
= fn _
=> NONE
,
485 parseArgs
= fn args
' =>
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
,
521 toString
= ResolveScope
.toString
,
522 name
= "resolveScope",
523 newCur
= fn (_
,rs
) => rs
,
524 newDef
= fn (_
,rs
) => rs
,
525 parseArgs
= fn args
' =>
527 [arg
'] => ResolveScope
.fromString arg
'
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
)
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
]
577 [allowVectorExps
, allowVectorPats
]
578 val successorMLCtrls
=
579 [allowDoDecls
, allowExtendedNumConsts
,
580 allowExtendedTextConsts
, allowLineComments
, allowOptBar
,
581 allowOptSemicolon
, allowOrPats
, allowRecordPunExps
,
582 allowSigWithtype
, allowVectorExps
, allowVectorPats
]
585 val {parseId
, parseIdAndArgs
, withDef
, snapshot
} = ac
589 fun makeProxy ({alts
: (Id
.t
* ('args
-> string list option
)) list
,
590 choices
: 'args list option
,
593 toString
: 'args
-> string,
595 parseArgs
: string list
-> 'args option
},
596 {parseId
: string -> Id
.t parseResult
,
597 parseIdAndArgs
: string list
-> (Id
.t
* Args
.t
) parseResult
}) =
600 if deprecated
then () else
603 {choices
= Option
.map (choices
, fn cs
=>
604 List.map (cs
, toString
)),
607 val parseId
= fn name
' =>
608 if String.equals (name
', name
)
609 then Proxy (List.map (alts
, fn (id
, _
) => id
), {deprecated
= deprecated
})
611 val parseIdAndArgs
= fn ss
=>
614 if String.equals (name
', name
)
616 case parseArgs args
' of
620 (alts
, fn (id
, mkArgs
) =>
623 deGood (parseIdAndArgs ((Id
.name id
)::ss
))))
625 Proxy (alts
, {deprecated
= deprecated
})
628 else parseIdAndArgs ss
632 parseIdAndArgs
= parseIdAndArgs
}
635 fun makeProxyBoolSimple ({alts
: Id
.t list
,
640 makeProxy ({alts
= List.map (alts
, fn id
=> (id
, fn b
=> SOME
[Bool.toString b
])),
641 choices
= SOME (if default
then [true, false]
643 deprecated
= deprecated
,
645 toString
= Bool.toString
,
647 parseArgs
= fn args
' =>
649 [arg
'] => Bool.fromString arg
'
653 val ac
= {parseId
= parseId
, parseIdAndArgs
= parseIdAndArgs
}
657 makeProxyBoolSimple ({alts
= List.map (extendedConstsCtrls
, id
),
661 name
= "allowExtendedConsts"}, ac
)
663 makeProxyBoolSimple ({alts
= List.map (vectorCtrls
, id
),
667 name
= "allowVectorExpsAndPats"}, ac
)
669 makeProxyBoolSimple ({alts
= List.map (successorMLCtrls
, id
),
673 name
= "allowSuccessorML"}, ac
)
675 val {parseId
, parseIdAndArgs
} = ac
679 fun checkPrefix (s
, f
) =
680 case String.peeki (s
, fn (_
, c
) => c
= #
":") of
684 val comp
= String.prefix (s
, i
)
685 val comp
= String.deleteSurroundingWhitespace comp
686 val s
= String.dropPrefix (s
, i
+ 1)
688 if String.equals (comp
, "mlton")
693 val parseId
= fn s
=> checkPrefix (s
, parseId
)
694 val parseIdAndArgs
= fn s
=> checkPrefix (s
, fn s
=> parseIdAndArgs (String.tokens (s
, Char.isSpace
)))
697 val processDefault
= fn s
=>
698 case parseIdAndArgs s
of
700 |
Good (id
, args
) => if Args
.processDef args
then Good id
else Bad
701 |
Proxy (alts
, {deprecated
}) =>
703 (alts
, Proxy (List.map (alts
, #
1), {deprecated
= deprecated
}),
705 if Args
.processDef args
then res
else Bad
)
708 val processEnabled
= fn (s
, b
) =>
711 |
Proxy (alts
, {deprecated
}) =>
713 (alts
, Proxy (alts
, {deprecated
= deprecated
}),
715 if Id
.setEnabled (id
, b
) then res
else Bad
)
716 | Good id
=> if Id
.setEnabled (id
, b
) then Good id
else Bad
719 val withDef
: (unit
-> 'a
) -> 'a
= fn f
=>
721 val restore
= withDef ()
723 Exn
.finally (f
, restore
)
726 val snapshot
: unit
-> (unit
-> 'a
) -> 'a
= fn () =>
728 val withSaved
= snapshot ()
732 val restore
= withSaved ()
734 Exn
.finally (f
, restore
)
741 control
{name
= "elaborate only",
743 toString
= Bool.toString
}
746 control
{name
= "emit main",
748 toString
= Bool.toString
}
751 control
{name
= "export header",
753 toString
= Option
.toString File
.toString
}
755 val exnHistory
= control
{name
= "exn history",
757 toString
= Bool.toString
}
767 (* Default option first for usage message
. *)
768 val all
= [Executable
, Archive
, LibArchive
, Library
]
770 val toString
: t
-> string =
771 fn Archive
=> "archive"
772 | Executable
=> "executable"
773 | LibArchive
=> "libarchive"
774 | Library
=> "library"
777 datatype format
= datatype Format
.t
779 val format
= control
{name
= "generated output format",
780 default
= Format
.Executable
,
781 toString
= Format
.toString
}
793 fn Limit
=> str
"Limit"
794 | First
=> str
"First"
795 | Every
=> str
"Every"
797 val toString
= Layout
.toString
o layout
800 datatype gcCheck
= datatype GcCheck
.t
802 val gcCheck
= control
{name
= "gc check",
804 toString
= GcCheck
.toString
}
806 val indentation
= control
{name
= "indentation",
808 toString
= Int.toString
}
810 val inlineIntoMain
= control
{name
= "inlineIntoMain",
812 toString
= Bool.toString
}
815 control
{name
= "inlineLeafA",
816 default
= {loops
= true,
820 fn {loops
, repeat
, size
} =>
822 (Layout
.record
[("loops", Bool.layout loops
),
823 ("repeat", Bool.layout repeat
),
824 ("size", Option
.layout
Int.layout size
)])}
826 control
{name
= "inlineLeafB",
827 default
= {loops
= true,
831 fn {loops
, repeat
, size
} =>
833 (Layout
.record
[("loops", Bool.layout loops
),
834 ("repeat", Bool.layout repeat
),
835 ("size", Option
.layout
Int.layout size
)])}
838 control
{name
= "inlineNonRec",
839 default
= {small
= 60,
842 fn {small
, product
} =>
844 (Layout
.record
[("small", Int.layout small
),
845 ("product", Int.layout product
)])}
847 val inputFile
= control
{name
= "input file",
849 toString
= File
.toString
}
851 val keepAST
= control
{name
= "keep AST",
853 toString
= Bool.toString
}
855 val keepCoreML
= control
{name
= "keep CoreML",
857 toString
= Bool.toString
}
859 val keepDefUse
= control
{name
= "keep def use",
861 toString
= Bool.toString
}
863 val keepDot
= control
{name
= "keep dot",
865 toString
= Bool.toString
}
867 val keepMachine
= control
{name
= "keep Machine",
869 toString
= Bool.toString
}
871 val keepPasses
= control
{name
= "keep passes",
873 toString
= List.toString
875 Regexp
.Compiled
.layout
)}
877 val keepRSSA
= control
{name
= "keep RSSA",
879 toString
= Bool.toString
}
881 val keepSSA
= control
{name
= "keep SSA",
883 toString
= Bool.toString
}
885 val keepSSA2
= control
{name
= "keep SSA2",
887 toString
= Bool.toString
}
889 val keepSXML
= control
{name
= "keep SXML",
891 toString
= Bool.toString
}
894 val keepXML
= control
{name
= "keep XML",
896 toString
= Bool.toString
}
898 val labelsHaveExtra_
= control
{name
= "extra_",
900 toString
= Bool.toString
}
902 val libDir
= control
{name
= "lib dir",
903 default
= "<libDir unset>",
904 toString
= fn s
=> s
}
906 val libTargetDir
= control
{name
= "lib target dir",
907 default
= "<libTargetDir unset>",
908 toString
= fn s
=> s
}
912 val loopSsaPasses
= control
{name
= "loop ssa passes",
914 toString
= Int.toString
}
916 val loopSsa2Passes
= control
{name
= "loop ssa2 passes",
918 toString
= Int.toString
}
920 val loopUnrollLimit
= control
{name
= "loop unrolling limit",
922 toString
= Int.toString
}
923 val loopUnswitchLimit
= control
{name
= "loop unswitching limit",
925 toString
= Int.toString
}
927 val markCards
= control
{name
= "mark cards",
929 toString
= Bool.toString
}
931 val maxFunctionSize
= control
{name
= "max function size",
933 toString
= Int.toString
}
937 {name
= "mlb path vars",
939 toString
= List.toString
941 concat
["{var = ", var
, ", path = ", path
, "}"])}
945 val commented
= control
{name
= "native commented",
947 toString
= Int.toString
}
949 val liveStack
= control
{name
= "native live stack",
951 toString
= Bool.toString
}
953 val optimize
= control
{name
= "native optimize",
955 toString
= Int.toString
}
957 val moveHoist
= control
{name
= "native move hoist",
959 toString
= Bool.toString
}
961 val copyProp
= control
{name
= "native copy prop",
963 toString
= Bool.toString
}
965 val copyPropCutoff
= control
{name
= "native copy prop cutoff",
967 toString
= Int.toString
}
969 val cutoff
= control
{name
= "native cutoff",
971 toString
= Int.toString
}
973 val liveTransfer
= control
{name
= "native live transfer",
975 toString
= Int.toString
}
977 val shuffle
= control
{name
= "native shuffle",
979 toString
= Bool.toString
}
981 val IEEEFP
= control
{name
= "native ieee fp",
983 toString
= Bool.toString
}
985 val split
= control
{name
= "native split",
986 default
= SOME
20000,
987 toString
= Option
.toString
Int.toString
}
991 control
{name
= "optFuel",
993 toString
= Option
.toString
Int.toString
}
995 fun optFuelAvailAndUse () =
999 then (optFuel
:= SOME (i
- 1); true)
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
.
1006 val _
= optFuelAvailAndUse
1008 val optimizationPasses
:
1009 {il
: string, set
: string -> unit Result
.t
, get
: unit
-> string} list ref
=
1010 control
{name
= "optimizationPasses",
1012 toString
= List.toString
1013 (fn {il
,get
,...} => concat
["<",il
,"::",get (),">"])}
1016 control
{name
= "polyvariance",
1017 default
= SOME
{hofo
= true,
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
)])
1032 val positionIndependent
= ref
false
1034 val preferAbsPaths
= control
{name
= "prefer abs paths",
1036 toString
= Bool.toString
}
1039 control
{name
= "prof passes",
1041 toString
= List.toString
1043 Regexp
.Compiled
.layout
)}
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"
1068 datatype profile
= datatype Profile
.t
1070 val profile
= control
{name
= "profile",
1071 default
= ProfileNone
,
1072 toString
= Profile
.toString
}
1074 val profileBranch
= control
{name
= "profile branch",
1076 toString
= Bool.toString
}
1078 val profileC
= control
{name
= "profile C",
1080 toString
= List.toString
1082 Regexp
.Compiled
.layout
)}
1084 structure ProfileIL
=
1086 datatype t
= ProfileSource | ProfileSSA | ProfileSSA2
1089 fn ProfileSource
=> "ProfileSource"
1090 | ProfileSSA
=> "ProfileSSA"
1091 | ProfileSSA2
=> "ProfileSSA2"
1094 datatype profileIL
= datatype ProfileIL
.t
1096 val profileIL
= control
{name
= "profile IL",
1097 default
= ProfileSource
,
1098 toString
= ProfileIL
.toString
}
1100 val profileInclExcl
=
1101 control
{name
= "profile include/exclude",
1103 toString
= List.toString
1105 (Layout
.tuple2 (Regexp
.Compiled
.layout
,
1108 val profileRaise
= control
{name
= "profile raise",
1110 toString
= Bool.toString
}
1112 val profileStack
= control
{name
= "profile stack",
1114 toString
= Bool.toString
}
1116 val profileVal
= control
{name
= "profile val",
1118 toString
= Bool.toString
}
1120 val showBasis
= control
{name
= "show basis",
1122 toString
= Option
.toString File
.toString
}
1124 val showBasisCompact
= control
{name
= "show basis compact",
1126 toString
= Bool.toString
}
1127 val showBasisDef
= control
{name
= "show basis def",
1129 toString
= Bool.toString
}
1130 val showBasisFlat
= control
{name
= "show basis flat",
1132 toString
= Bool.toString
}
1134 val showDefUse
= control
{name
= "show def-use",
1136 toString
= Option
.toString File
.toString
}
1138 val showTypes
= control
{name
= "show types",
1140 toString
= Bool.toString
}
1153 datatype target
= datatype Target
.t
1155 val target
= control
{name
= "target",
1157 toString
= Target
.toString
}
1163 datatype arch
= datatype MLton
.Platform
.Arch
.t
1165 val arch
= control
{name
= "target arch",
1167 toString
= MLton
.Platform
.Arch
.toString
}
1169 datatype os
= datatype MLton
.Platform
.OS
.t
1171 val os
= control
{name
= "target OS",
1173 toString
= MLton
.Platform
.OS
.toString
}
1180 NONE
=> Error
.bug ("ControlFlags.Target." ^ s ^
": not set")
1182 fun set x
= r
:= SOME x
1186 val (bigEndian
: unit
-> bool, setBigEndian
) = make
"bigEndian"
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"
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
)
1218 [[{var
= "LIB_MLTON_DIR",
1221 path
= Target
.toString (!target
)},
1222 {var
= "TARGET_ARCH",
1223 path
= String.toLower (MLton
.Platform
.Arch
.toString
1226 path
= String.toLower (MLton
.Platform
.OS
.toString
1228 {var
= "OBJPTR_REP",
1229 path
= (case Bits
.toInt (Target
.Size
.objptr ()) of
1232 | _
=> Error
.bug
"Control.mlbPathMap")},
1233 {var
= "ARRAY_METADATA_SIZE",
1234 path
= (case Bits
.toInt (Target
.Size
.arrayMetaData ()) of
1237 | _
=> Error
.bug
"Control.mlbPathMap")},
1238 {var
= "NORMAL_METADATA_SIZE",
1239 path
= (case Bits
.toInt (Target
.Size
.normalMetaData ()) of
1242 | _
=> Error
.bug
"Control.mlbPathMap")},
1243 {var
= "SEQINDEX_INT",
1244 path
= (case Bits
.toInt (Target
.Size
.seqIndex ()) of
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
}],
1260 val typeCheck
= control
{name
= "type check",
1262 toString
= Bool.toString
}
1264 structure Verbosity
=
1273 fn Silent
=> "Silent"
1276 | Detail
=> "Detail"
1279 datatype verbosity
= datatype Verbosity
.t
1281 val verbosity
= control
{name
= "verbosity",
1283 toString
= Verbosity
.toString
}
1285 val warnAnn
= control
{name
= "warn unrecognized annotation",
1287 toString
= Bool.toString
}
1289 val warnDeprecated
= control
{name
= "warn deprecated features",
1291 toString
= Bool.toString
}
1293 val zoneCutDepth
: int ref
=
1294 control
{name
= "zone cut depth",
1296 toString
= Int.toString
}
1298 val defaults
= setDefaults