Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/compiler/TopLevel/main/control.sml
ViewVC logotype

Annotation of /sml/trunk/compiler/TopLevel/main/control.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 7383 - (view) (download)

1 : jhr 5727 (* control.sml
2 :     *
3 :     * COPYRIGHT (c) 2019 The Fellowship of SML/NJ (http://www.smlnj.org)
4 :     * All rights reserved.
5 :     *)
6 : blume 879
7 : dbm 2492 (* Code generation controls (including some used in FLINT?) *)
8 : blume 879 structure Control_CG : CGCONTROL =
9 : jhr 5727 struct
10 :     val priority = [10, 11, 2]
11 :     val obscurity = 6
12 :     val prefix = "cg"
13 : blume 1126
14 : jhr 5727 val registry = ControlRegistry.new { help = "code generator settings" }
15 : blume 1126
16 : jhr 5727 val _ = BasicControl.nest (prefix, registry, priority)
17 : blume 1126
18 : jhr 5727 val b = ControlUtil.Cvt.bool
19 :     val i = ControlUtil.Cvt.int
20 :     val r = ControlUtil.Cvt.real
21 :     val sl = ControlUtil.Cvt.stringList
22 : blume 1126
23 : jhr 5727 val nextpri = ref 0
24 : blume 1208
25 : jhr 5727 fun new (c, n, h, d) = let
26 :     val r = ref d
27 :     val p = !nextpri
28 :     val ctl = Controls.control {
29 :     name = n,
30 :     pri = [p],
31 :     obscurity = obscurity,
32 :     help = h,
33 :     ctl = r }
34 :     in
35 :     nextpri := p + 1;
36 :     ControlRegistry.register
37 :     registry
38 :     { ctl = Controls.stringControl c ctl,
39 :     envName = SOME (ControlUtil.EnvName.toUpper "CG_" n) };
40 :     r
41 :     end
42 : blume 1126
43 : jhr 5727 val closureStrategy = new (i, "closure-strategy", "?", 0) (* see CPS/clos/closure.sml *)
44 :     val cpsopt = new (sl, "cpsopt", "cps optimizer phases", [
45 :     "first_contract", "eta", "zeroexpand", "last_contract"
46 :     ])
47 :     (* ["first_contract", "eta", "uncurry", "etasplit",
48 :     "cycle_expand", "eta", "last_contract" ] *)
49 :     val rounds = new (i, "rounds", "max # of cpsopt rounds", 10)
50 :     val path = new (b, "path", "?", false)
51 :     val betacontract = new (b, "betacontract", "?", true)
52 :     val eta = new (b, "eta", "?", true)
53 :     val selectopt = new (b, "selectopt", "enable contraction of record select", true)
54 :     val dropargs = new (b, "dropargs", "?", true)
55 :     val deadvars = new (b, "deadvars", "?", true)
56 :     val flattenargs = new (b, "flattenargs", "?", false)
57 :     val extraflatten = new (b, "extraflatten", "?", false)
58 :     val switchopt = new (b, "switchopt", "?", true)
59 :     val handlerfold = new (b, "handlerfold", "?", true)
60 :     val branchfold = new (b, "branchfold", "?", false)
61 :     val arithopt = new (b, "arithopt", "?", true)
62 :     val betaexpand = new (b, "betaexpand", "?", true)
63 :     val unroll = new (b, "unroll", "?", true)
64 :     val invariant = new (b, "invariant", "?", true)
65 :     val lambdaprop = new (b, "lambdaprop", "?", false)
66 :     val newconreps = new (b, "newconreps", "?", true)
67 : dbm 6454 val boxedconstconreps = ElabDataControl.boxedconstconreps
68 : jhr 5727 val unroll_recur = new (b, "unroll-recur", "?", true)
69 :     val sharepath = new (b, "sharepath", "?", true)
70 :     val staticprof = new (b, "staticprof", "?", false)
71 :     val verbose = new (b, "verbose", "?", false)
72 :     val debugcps = new (b, "debugcps", "?", false)
73 :     val bodysize = new (i, "bodysize", "?", 20)
74 :     val reducemore = new (i, "reducemore", "?", 15)
75 :     val comment = new (b, "comment", "?", false)
76 :     val knownGen = new (i, "known-gen", "?", 0)
77 :     val knownClGen = new (i, "known-cl-gen", "?", 0)
78 :     val escapeGen = new (i, "escape-gen", "?", 0)
79 :     val calleeGen = new (i, "callee-gen", "?", 0)
80 :     val spillGen = new (i, "spill-gen", "?", 0)
81 :     val etasplit = new (b, "etasplit", "?", true)
82 :     val uncurry = new (b, "uncurry", "enable uncurrying optimization", true)
83 :     val ifidiom = new (b, "if-idiom", "enable if-idiom optimization", true)
84 :     val comparefold = new (b, "comparefold", "enable optimization of conditional tests", true)
85 : jhr 5739 val debugLits = new (b, "debug-lits", "print results of literal lifting", false)
86 :     val newLiterals = new (b, "new-literals", "use new literal representation", false)
87 : jhr 5727 val debugRep = new (b, "debug-rep", "?", false)
88 :     val deadup = new (b, "deadup", "?", true)
89 :     val memDisambiguate = new (b, "mem-disambiguate", "?", false)
90 : jhr 6420 val printit = new (b, "printit", "whether to show CPS", false)
91 : jhr 6428 val printClusters = new (b, "print-clusters", "whether to print clusters prior to codegen", false)
92 : jhr 5727 end (* structure Control_CG *)
93 : blume 879
94 : dbm 2603
95 : blume 879 structure Control : CONTROL =
96 : jhr 5727 struct
97 : blume 1126
98 : jhr 5727 local
99 : dbm 2603 val priority = [10, 10, 9]
100 :     val obscurity = 4
101 :     val prefix = "control"
102 : blume 1126
103 : dbm 2603 val registry = ControlRegistry.new
104 :     { help = "miscellaneous control settings" }
105 : blume 1126
106 : dbm 2603 val _ = BasicControl.nest (prefix, registry, priority)
107 : blume 1201
108 : dbm 2603 val bool_cvt = ControlUtil.Cvt.bool
109 : dbm 7352 val string_cvt = ControlUtil.Cvt.string
110 : blume 1201
111 : dbm 2603 val nextpri = ref 0
112 : blume 1208
113 : jhr 7380 fun register (cvtFn, name, help, defaultRef) = let
114 :     val p = !nextpri
115 :     val ctl = Controls.control {
116 :     name = name,
117 :     pri = [p],
118 :     obscurity = obscurity,
119 :     help = help,
120 :     ctl = defaultRef
121 :     }
122 :     in
123 :     nextpri := p + 1;
124 :     ControlRegistry.register registry {
125 :     ctl = Controls.stringControl cvtFn ctl,
126 :     envName = SOME (ControlUtil.EnvName.toUpper "CONTROL_" name)
127 :     };
128 : dbm 7352 defaultRef
129 : jhr 7380 end
130 : jhr 4304
131 : jhr 7380 (* `new (n, h, d)` defines new control reference with default value `d`
132 :     * and registers it with name `n` and help message `h`.
133 :     *)
134 : dbm 7352 fun new (n, h, d) = register (bool_cvt, n, h, ref d)
135 : jhr 4304
136 : jhr 5727 in
137 : blume 1126
138 : dbm 7352 structure Print : PRINTCONTROL = Control_Print (* Basics/print/printcontrol.sml *)
139 : blume 879
140 : dbm 7352 (* ElabData controls *)
141 :     structure ElabData : ELABDATA_CONTROL = ElabDataControl (* ElabData/main/edcontrol.{sml,sig} *)
142 : dbm 2492
143 : dbm 7352 (* elaborator controls *)
144 :     structure Elab : ELAB_CONTROL = ElabControl (* Elaborator/control/elabcontrol.{sml,sig} *)
145 : dbm 2492
146 : dbm 7352 (* MatchComp (match compiler) controls *)
147 :     structure MC : MC_CONTROL = MCControl (* Elaborator/control/mccontrol.{sml,sig} *)
148 : blume 879
149 : dbm 7352 (* FLINT controls *)
150 :     structure FLINT = FLINT_Control (* FLINT/main/control.{sml,sig} *)
151 : dbm 2603
152 : blume 879 structure MLRISC = MLRiscControl
153 :    
154 :     structure CG : CGCONTROL = Control_CG
155 :    
156 : blume 902 open BasicControl
157 : dbm 7352 (* provides: val printWarnings = ref true *)
158 :    
159 : blume 902 open ParserControl
160 :     (* provides: val primaryPrompt = ref "- "
161 :     val secondaryPrompt = ref "= "
162 :     val overloadKW = ref false
163 :     val lazysml = ref false
164 :     val quotation = ref false
165 : jhr 7380 val setSuccML : bool -> unit
166 :     *)
167 : blume 903
168 : blume 1208 val debugging = new ("debugging", "?", false)
169 : dbm 7352 val eldebugging = new ("eldebugging", "evalloop debugging", false)
170 :     val pddebugging = new ("pddebugging", "PPDec debugging", false)
171 : jhr 4304 val printAst = new ("printAst", "whether to print Ast representation", false)
172 : dbm 7352 val printAbsyn = ElabControl.printAbsyn
173 : jhr 7380
174 : blume 1208 val interp = new ("interp", "?", false)
175 : dbm 2492
176 : dbm 7352 val progressMsgs =
177 :     new ("progressMsgs", "whether to print a message after each phase is completed", false)
178 : blume 1126 val trackExn =
179 : dbm 7352 new ("track-exn", "whether to generate code that tracks exceptions", true)
180 : blume 1126 (* warning message when call of polyEqual compiled: *)
181 :     val polyEqWarn =
182 : mblume 1642 new ("poly-eq-warn", "whether to warn about calls of polyEqual", true)
183 : blume 879
184 : blume 1208 val preserveLvarNames = new ("preserve-names", "?", false)
185 : blume 902 (* these are really all the same ref cell: *)
186 : dbm 2492 val saveit : bool ref = ElabData.saveLvarNames
187 : blume 879 val saveAbsyn : bool ref = saveit
188 :     val saveLambda : bool ref = saveit
189 :     val saveConvert : bool ref = saveit
190 :     val saveCPSopt : bool ref = saveit
191 :     val saveClosure : bool ref = saveit
192 :    
193 : mblume 1650 val tdp_instrument = TDPInstrument.enabled
194 : blume 1126
195 :     end (* local *)
196 : dbm 2603
197 : jhr 5727 end (* structure Control *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0