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

Parent Directory | 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