Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /branches/vis15/src/compiler/options/options.sml
ViewVC logotype

Annotation of /branches/vis15/src/compiler/options/options.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5547 - (view) (download)

1 : jhr 3351 (* options.sml
2 :     *
3 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 : jhr 5081 * COPYRIGHT (c) 2017 The University of Chicago
6 : jhr 3351 * All rights reserved.
7 :     *)
8 :    
9 :     structure Options : sig
10 :    
11 :     (* raised if parsing command-line args hits an error (e.g., missing option, syntax, ...).
12 :     * The string is an error message.
13 :     *)
14 :     exception Usage of string
15 :    
16 :     (* parse the command-line args *)
17 :     val parseCmdLine : string list -> {
18 : jhr 4317 help : bool option, (* "-h" and "--help" ==> SOME false; "-H" ==> SOME true. *)
19 :     version : bool, (* "--version" specified? *)
20 :     about : bool, (* "--about" specified? *)
21 : jhr 5547 dumpBasis : bool, (* "--dump-basis" specified? *)
22 : jhr 5074 defs : CmdLineConstants.t, (* constant & preprocessor command-line definitions *)
23 : jhr 4317 target : TargetOptions.t, (* collected infromation about the target *)
24 :     file : string (* source file *)
25 : jhr 3351 }
26 :    
27 :     (* return a usage message. The boolean controls whether all options should be
28 :     * included (true ==> long; false ==> short).
29 :     *)
30 :     val usage : string * bool -> string
31 :    
32 :     end = struct
33 :    
34 :     structure G = GetOpt
35 :     structure P = OS.Path
36 : jhr 3812 structure Tgt = TargetOptions
37 : jhr 3351
38 :     exception Usage of string
39 :    
40 :     (* option flags that are set by getOpt *)
41 : jhr 4317 val helpFlg = ref(NONE : bool option) (* SOME false -- short help; SOME true -- long help *)
42 : jhr 4116 val aboutFlg = ref false
43 : jhr 5547 val dumpBasisFlg = ref false
44 : jhr 3351 val longHelp = ref false
45 :     val versionFlg = ref false
46 : jhr 4842 val runtimeLogFlg = ref false
47 : jhr 3351 val debugFlg = ref false
48 :     val doubleFlg = ref false
49 : jhr 3863 val longIntFlg = ref false
50 :     val scalarFlg = ref false
51 : jhr 3351 val outputOpt : string option ref = ref NONE
52 : jhr 5500 val execFlg = ref false
53 :     val staticFlg = ref false
54 : jhr 4965 val jsonFlg = ref false
55 : jhr 3351 val snapshotFlg = ref false
56 :     val prefix : string option ref = ref NONE
57 : jhr 3812 val platform = ref Tgt.SEQUENTIAL
58 : jhr 3351 val bspFlg = ref false
59 : jhr 4589 val noSpacePartFlg = ref false
60 : jhr 3351
61 :     fun mkOpt ctl = let
62 : jhr 4317 val name = if Controls.get ctl
63 :     then "disable-" ^ Controls.name ctl
64 : jhr 4445 else Controls.name ctl
65 : jhr 4317 in
66 : jhr 4445 Controls.mkOptionFlag {ctl = ctl, short = "", long = SOME name}
67 : jhr 4317 end
68 : jhr 3351
69 :     (* create the target option descriptor. *)
70 :     local
71 : jhr 4116 val desc = if Paths.cudaEnabled then [" cuda -- generate CUDA code"] else []
72 :     val desc = if Paths.clEnabled then " opencl -- generate OpenCL code" :: desc else desc
73 : jhr 5009 val desc = if Paths.debuggerEnabled
74 :     then " debugger -- generate code that can be run under the debugger" :: desc
75 :     else desc
76 : jhr 3351 val desc = " parallel -- generate parallel code" :: desc
77 :     val desc = " sequential -- generate sequential code (default)" :: desc
78 :     val desc = "specify the target platform:" :: desc
79 : jhr 3812 fun parseTargetOpt "c" = (platform := Tgt.SEQUENTIAL)
80 : jhr 4317 | parseTargetOpt "sequential" = (platform := Tgt.SEQUENTIAL)
81 : jhr 3812 | parseTargetOpt "parallel" = (platform := Tgt.PARALLEL)
82 :     | parseTargetOpt "pthread" = (platform := Tgt.PARALLEL)
83 : jhr 3351 | parseTargetOpt "cl" = if Paths.clEnabled
84 : jhr 3812 then (platform := Tgt.OPENCL)
85 : jhr 3351 else raise Usage "cl target not supported by this version"
86 :     | parseTargetOpt "opencl" = if Paths.clEnabled
87 : jhr 3812 then (platform := Tgt.OPENCL)
88 : jhr 3351 else raise Usage "cl target not supported by this version"
89 :     | parseTargetOpt "cuda" = if Paths.cudaEnabled
90 : jhr 3812 then (platform := Tgt.CUDA)
91 : jhr 3351 else raise Usage "cuda target not supported by this version"
92 : jhr 5009 | parseTargetOpt "debugger" = if Paths.debuggerEnabled
93 :     then (platform := Tgt.DEBUGGER)
94 :     else raise Usage "debugger target not supported by this version"
95 : jhr 3351 | parseTargetOpt opt = raise Usage(concat["unrecognized target \"", opt, "\""])
96 :     in
97 :     val targetOptDesc = {
98 :     short = "",
99 :     long = ["target"],
100 :     desc = G.ReqArg(parseTargetOpt, "target"),
101 :     help = String.concatWith "\n" desc
102 :     }
103 :     end
104 :    
105 :     fun setFlag (flg, value) = G.NoArg(fn () => (flg := value))
106 :    
107 :     (* the short list of options, which does not include the compiler controls *)
108 :     val optionList = [
109 :     { short = "h", long = ["help"],
110 :     desc = setFlag (helpFlg, SOME false),
111 :     help = "print command-line options"
112 :     },
113 :     { short = "H", long = [],
114 :     desc = setFlag (helpFlg, SOME true),
115 :     help = "print all command-line options (including compiler controls)"
116 :     },
117 :     { short = "", long = ["version"],
118 :     desc = setFlag (versionFlg, true),
119 :     help = "show the compiler version"
120 :     },
121 : jhr 4317 { short = "", long = ["about"],
122 : jhr 4116 desc = setFlag (aboutFlg, true),
123 :     help = "information about the Diderot language and compiler"
124 :     },
125 : jhr 3351 { short = "", long = ["exec"],
126 : jhr 5500 desc = setFlag (execFlg, true),
127 : jhr 3351 help = "generate a standalone executable"
128 :     },
129 : jhr 5500 { short = "", long = ["static"],
130 :     desc = setFlag (staticFlg, true),
131 :     help = "generate a statically linked library"
132 :     },
133 : jhr 4965 { short = "", long = ["json"],
134 :     desc = setFlag (jsonFlg, true),
135 :     help = "generate a JSON description of library API (incompatible with --exec)"
136 :     },
137 : jhr 3351 { short = "o", long = ["output"],
138 :     desc = G.ReqArg(fn s => outputOpt := SOME s, "file"),
139 :     help = "specify the executable file name"
140 :     },
141 :     { short = "", long = ["namespace"],
142 :     desc = G.ReqArg(fn s => prefix := SOME s, "prefix"),
143 :     help = "specify namespace prefix for generated code"
144 :     },
145 :     { short = "", long = ["snapshot"],
146 :     desc = setFlag (snapshotFlg, true),
147 :     help = "generate code to get a snapshot of strand states"
148 :     },
149 :     { short = "g", long = ["debug"],
150 :     desc = setFlag (debugFlg, true),
151 :     help = "enable debugging information in executable"
152 :     },
153 :     { short = "", long = ["double"],
154 :     desc = setFlag (doubleFlg, true),
155 :     help = "use double-precision floats for reals"
156 :     },
157 : jhr 3863 { short = "", long = ["long-int"],
158 :     desc = setFlag (longIntFlg, true),
159 :     help = "use 64-bits for ints"
160 :     },
161 : jhr 4732 (* QUESTION: perhaps --scalar should not be part of the short option list? *)
162 : jhr 3863 { short = "", long = ["scalar"],
163 :     desc = setFlag (scalarFlg, true),
164 :     help = "do not generate vectorized code"
165 :     },
166 : jhr 4732 (* QUESTION: perhaps --log should not be part of the short option list? *)
167 : jhr 4445 Controls.mkOptionFlag {ctl = Ctl.enableLog, short = "", long = SOME "log"},
168 : jhr 4732 (* QUESTION: perhaps --stats should not be part of the short option list? *)
169 : jhr 4445 Controls.mkOptionFlag {ctl = Ctl.collectStats, short = "", long = SOME "stats"},
170 : jhr 4732 (* QUESTION: perhaps --verbose should not be part of the short option list? *)
171 : jhr 4445 Controls.mkOptionFlag {ctl = Ctl.verbose, short = "", long = SOME "verbose"},
172 : jhr 3351 targetOptDesc
173 :     ]
174 :    
175 :     (* create the list of options that control compiler internals *)
176 : jhr 3507 val ctlOptions = let
177 : jhr 4317 val optimizeFlags = List.map mkOpt Ctl.optimizeControls
178 :     val dumpFlags = List.map mkOpt Ctl.dumpControls @ [
179 : jhr 5547 { short = "", long = ["dump-basis"],
180 :     desc = setFlag (dumpBasisFlg, true),
181 :     help = "dump the Diderot basis to 'basis.tex'"
182 :     },
183 : jhr 4317 { short = "", long = ["dump-cfg"],
184 :     desc = setFlag (Ctl.dumpCFG, true),
185 :     help = "dump out all CFG representations to the log file"
186 :     },
187 :     { short = "", long = ["dump-all"],
188 :     desc = setFlag (Ctl.dumpAll, true),
189 :     help = "dump out all intermediate representations to the log file"
190 :     },
191 :     { short = "", long = ["show-cfg-labels"],
192 :     desc = setFlag (Ctl.compactCFG, false),
193 :     help = "show the labels of all CFG nodes"
194 :     },
195 : jhr 4445 { short = "", long = ["log-ticks"],
196 : jhr 4317 desc = setFlag (Stats.logTicks, false),
197 :     help = "log each optimization tick as it is recorded"
198 :     }
199 :     ]
200 :     val checkFlags = List.map mkOpt Ctl.checkControls @ [
201 :     { short = "", long = ["check-all"],
202 :     desc = setFlag (Ctl.checkAll, true),
203 :     help = "always check intermediate representations"
204 :     }]
205 : jhr 4842 val otherOpts = [
206 :     {
207 :     short = "", long = ["force-bsp"],
208 :     desc = setFlag (bspFlg, true),
209 :     help = "execute strands in BSP mode"
210 :     },
211 :     {
212 :     short = "", long = ["no-space-partition"],
213 :     desc = setFlag (noSpacePartFlg, true),
214 :     help = "implement spatial queries without acceleration"
215 :     }
216 :     ]
217 : jhr 4843 val otherOpts = if Paths.runtimeLogging
218 :     then { short = "", long = ["runtime-logging"],
219 :     desc = setFlag (runtimeLogFlg, true),
220 :     help = "enable runtime event logging (parallel target only)"
221 :     } :: otherOpts
222 :     else otherOpts
223 : jhr 4317 in
224 : jhr 4842 otherOpts @ optimizeFlags @ dumpFlags @ checkFlags
225 : jhr 4317 end
226 : jhr 3351
227 : jhr 4116 fun mkTargetDesc (srcFile) : Tgt.t = let
228 : jhr 3351 val (outDir, outBase) = (case !outputOpt
229 :     of NONE => let
230 :     val {dir, file} = P.splitDirFile srcFile
231 :     in
232 :     case P.splitBaseExt file
233 :     of {base, ext=SOME "diderot"} => (dir, base)
234 : jhr 4116 | {base, ext=SOME "ddro"} => (dir, base)
235 : jhr 4317 | _ => (dir, file)
236 : jhr 3351 (* end case *)
237 :     end
238 :     | SOME outFile => let
239 :     val {dir, file} = P.splitDirFile outFile
240 :     in
241 : jhr 5500 if !execFlg
242 : jhr 3351 then (dir, file)
243 :     else (case P.splitBaseExt file
244 :     of {base, ext=SOME "o"} => (dir, base)
245 :     | {base, ext=SOME "obj"} => (dir, base)
246 :     | _ => (dir, file)
247 :     (* end case *))
248 :     end
249 :     (* end case *))
250 : jhr 4317 (* get the namespace and check that it is legal *)
251 :     val namespace = (case !prefix
252 :     of NONE => "Diderot"
253 :     | SOME "diderot" => raise Usage "namespace \"diderot\" is reserved"
254 :     | SOME ns => (case String.explode ns
255 :     of [] => raise Usage "invalid empty namespace specifier"
256 :     | c::cs => let
257 :     fun isAlpha #"_" = true | isAlpha c = Char.isAlpha c
258 :     fun isAlphaNum #"_" = true | isAlphaNum c = Char.isAlphaNum c
259 :     in
260 :     if isAlpha c andalso List.all isAlphaNum cs
261 :     then ns
262 :     else raise Usage "invalid namespace specifier"
263 :     end
264 :     (* end case *))
265 :     (* end case *))
266 : jhr 4589 (* if necessary, set the Diderot integer size to long *)
267 :     val () = if !longIntFlg then IntLit.setDiderotLongInt() else ()
268 : jhr 5009 (* if the target is the Diderot Debugger, then enable the JSON API too *)
269 :     val () = if !platform = TargetOptions.DEBUGGER then jsonFlg := true else ()
270 : jhr 4317 in {
271 :     srcFile = srcFile,
272 :     outDir = outDir,
273 :     outBase = outBase,
274 : jhr 5500 exec = !execFlg,
275 :     staticLib = !staticFlg,
276 : jhr 4965 jsonAPI = !jsonFlg,
277 : jhr 4661 snapshot = !snapshotFlg,
278 : jhr 4317 platform = !platform,
279 :     namespace = namespace,
280 :     double = !doubleFlg,
281 :     longint = !longIntFlg,
282 :     scalar = !scalarFlg,
283 : jhr 4842 runtimeLog = !runtimeLogFlg,
284 : jhr 4317 debug = !debugFlg,
285 : jhr 4589 bsp = !bspFlg,
286 :     kdtree = not(!noSpacePartFlg)
287 : jhr 4317 } end
288 : jhr 4116
289 : jhr 4842 fun parse [] = {
290 : jhr 4116 help = SOME false,
291 :     version = false,
292 : jhr 4317 about = false,
293 : jhr 5547 dumpBasis = false,
294 : jhr 5074 defs = CmdLineConstants.empty,
295 : jhr 4116 target = mkTargetDesc "",
296 :     file = ""
297 :     }
298 : jhr 5074 | parse args = (case CmdLineConstants.initFromArgs args
299 : jhr 5081 of SOME(defs, rest) => let
300 :     val (opts, files) = G.getOpt {
301 :     argOrder = G.RequireOrder,
302 :     options = optionList @ ctlOptions,
303 :     errFn = fn s => raise Usage s
304 :     } rest
305 :     (* figure out filename pieces *)
306 : jhr 5547 val srcFile =
307 :     if isSome(!helpFlg) orelse !versionFlg orelse !aboutFlg
308 :     orelse !dumpBasisFlg
309 :     then ""
310 :     else (case files
311 :     of [] => raise Usage "missing file argument"
312 :     | [f] => f
313 :     | _ => raise Usage "too many files"
314 :     (* end case *))
315 : jhr 5081 in {
316 :     help = !helpFlg,
317 :     version = !versionFlg,
318 :     about = !aboutFlg,
319 : jhr 5547 dumpBasis = !dumpBasisFlg,
320 : jhr 5081 defs = defs,
321 :     target = mkTargetDesc srcFile,
322 :     file = srcFile
323 :     } end
324 : jhr 5074 | NONE => raise Usage "badly-formed constant definition"
325 : jhr 5081 (* end case *))
326 : jhr 3351
327 : jhr 5500 (* check for inconsistent command-line options. The conflicts are:
328 :     *
329 :     * --runtime-logging and non-parallel target
330 :     * ## runtime logging is only supported for the
331 :     * the parallel target
332 :     * --exec and --static ## the --static option implies a library
333 :     * --exec and --jason ## the --json option implies a library
334 :     * --exec and --target=debugger ## the debugger requires a library
335 :     *)
336 : jhr 4842 fun checkOptions (arg as {help=SOME _, ...}) = arg
337 : jhr 5547 | checkOptions (arg as {help, version, about, dumpBasis, defs, target : TargetOptions.t, file}) = (
338 : jhr 4843 if (#runtimeLog target andalso (#platform target <> TargetOptions.PARALLEL))
339 : jhr 5500 orelse (#exec target andalso (#jsonAPI target orelse #staticLib target))
340 : jhr 5009 orelse ((#platform target = TargetOptions.DEBUGGER) andalso #exec target)
341 : jhr 4843 then raise Usage "inconsistent options"
342 :     else arg)
343 : jhr 4842
344 :     fun parseCmdLine args = checkOptions (parse args)
345 :    
346 : jhr 5074 val fakeConstOpt = {
347 :     desc = G.NoArg(fn _ => ()),
348 :     help = "specify value for a constant variable",
349 :     long = ["C<var>=<value>"],
350 :     short = ""
351 :     }
352 :     val fakeDefOpt = {
353 :     desc = G.NoArg(fn _ => ()),
354 :     help = "specify preprocessor symbol (for runtime debugging)",
355 :     long = ["D<var>=<value>"],
356 :     short = ""
357 :     }
358 :    
359 : jhr 4116 fun usage (cmd, long) = let
360 : jhr 4317 val hdr = concat[
361 :     "usage: ", cmd, " [options] file.diderot\n",
362 :     " Version: ", Version.message, "\n",
363 :     " Options:"
364 :     ]
365 : jhr 5081 (* add item for "-C" and "-D" options*)
366 :     val options = if long
367 :     then optionList @ [fakeConstOpt, fakeDefOpt]
368 :     else optionList @ [fakeConstOpt]
369 : jhr 4317 in
370 :     if long
371 : jhr 5074 then G.usageInfo {header = hdr, options = options @ ctlOptions}
372 :     else G.usageInfo {header = hdr, options = options}
373 : jhr 4317 end
374 : jhr 3351
375 :     end

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