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

SCM Repository

[diderot] Annotation of /branches/vis12/src/compiler/c-util/gen-inputs.sml
ViewVC logotype

Annotation of /branches/vis12/src/compiler/c-util/gen-inputs.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2049 - (view) (download)

1 : jhr 1820 (* gen-inputs.sml
2 :     *
3 :     * COPYRIGHT (c) 2012 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *)
6 :    
7 :     structure GenInputs : sig
8 :    
9 : jhr 1845 (* input variable descriptor: type, name, description, has default *)
10 : jhr 2048 type input_desc = (TreeIL.Ty.ty * string * string option * TreeIL.exp option)
11 : jhr 1820
12 :     val gatherInputs : TreeIL.block -> input_desc list
13 :    
14 : jhr 2048 (*** Support for standalone executables ***)
15 :    
16 : jhr 2041 (* generate the input initialization structure that we use to initialize input
17 :     * globals from command-line arguments in stand-alone executables.
18 :     *)
19 :     val genInputsStruct : TargetUtil.target_desc * input_desc list -> CLang.decl
20 :    
21 : jhr 2048 (* generate the functions that handle inputs for standalone executables. These are:
22 :     * InitDefaults -- called to initialize the default input values
23 :     * RegisterInputs -- called to register the command-line options for the input globals
24 :     * InitInptus -- called to initialize the input globals from the values specified
25 :     * on the command line.
26 :     *)
27 :     val genExecInputFuns : TargetUtil.target_desc * input_desc list -> CLang.decl list
28 : jhr 1820
29 : jhr 2048 (*** Support for libraries ***)
30 : jhr 2041
31 : jhr 2048 (* generate the typedef for the defined-input flag struct. *)
32 :     val genDefinedInpStruct : TargetUtil.target_desc * input_desc list -> CLang.decl
33 :    
34 :     (* generated the functions to initialize inputs for the library API. This function also
35 :     * generates the function to initialize the defined input flags struct.
36 :     *)
37 : jhr 1820 val genInputFuns : TargetUtil.target_desc * input_desc list -> CLang.decl list
38 :    
39 :     end = struct
40 :    
41 :     structure IL = TreeIL
42 :     structure Ty = TreeIL.Ty
43 :     structure CL = CLang
44 :     structure N = CNames
45 :     structure TrTy = CTyTranslate
46 :    
47 : jhr 2048 type input_desc = (Ty.ty * string * string option * IL.exp option)
48 : jhr 1820
49 :     val nrrdPtrTy = CL.T_Ptr(CL.T_Named "Nrrd")
50 :     val wrldPrefixTy = CL.T_Ptr(CL.T_Named "WorldPrefix_t")
51 :    
52 :     type target_desc = TargetUtil.target_desc
53 :    
54 :     (* translate a TreeIL type to the C types used to represent it in the external API *)
55 :     val trType = CTyTranslate.toCType
56 :    
57 : jhr 2048 (* an l-value expression for accessing a defined-input flag *)
58 :     fun defined name = CL.mkSelect(CL.mkIndirect(CL.mkVar "wrld", "definedInp"), name)
59 :    
60 : jhr 1820 (* an l-value expression for accessing a global variable *)
61 :     fun global name = CL.mkIndirect(CL.mkIndirect(CL.mkVar "wrld", "globals"), name)
62 :    
63 :     (* gather the input globals from the input initialization block *)
64 :     fun gatherInputs (IL.Block{body, ...}) = let
65 : jhr 2048 fun inputInfo cvt (x, name, desc, NONE) =
66 :     SOME(IL.Var.ty x, name, desc, NONE)
67 :     | inputInfo cvt (x, name, desc, SOME v) =
68 :     SOME(IL.Var.ty x, name, desc, SOME(cvt v))
69 :     fun gather (IL.S_Input inp) = inputInfo (fn e => e) inp
70 :     | gather (IL.S_InputNrrd inp) = inputInfo (fn s => TreeIL.E_Lit(Literal.String s)) inp
71 : jhr 1820 | gather _ = NONE
72 :     in
73 :     List.mapPartial gather body
74 :     end
75 :    
76 : jhr 2041 (* generate the input initialization structure that we use to initialize input
77 :     * globals from command-line arguments in stand-alone executables.
78 :     *)
79 :     fun genInputsStruct (tgt : target_desc, inputs) = let
80 :     fun mkField (Ty.DynSeqTy _, name, _, _) = (CL.charPtr, name)
81 :     | mkField (Ty.ImageTy _, name, _, _) = (CL.charPtr, name)
82 :     | mkField (ty, name, _, _) = (trType ty, name)
83 :     in
84 :     CL.D_StructDef(NONE, List.map mkField inputs, SOME(N.inputsTy tgt))
85 :     end
86 :    
87 : jhr 2048 (* generate code to initialize the default input values *)
88 :     fun genInitDefaults (tgt, inputs) = let
89 :     (* the inputs pointer type *)
90 :     val inputPtrTy = CL.T_Ptr(CL.T_Named(N.inputsTy tgt))
91 :     (* some common variables *)
92 :     val inpV = CL.mkVar "inp"
93 :     (* initialize a given input *)
94 :     fun initInput (ty, name, _, SOME dflt) = let
95 :     val lhs = CL.mkIndirect(inpV, name)
96 :     val rhs = TreeToC.trExp (TreeIL.Var.Map.empty, dflt)
97 :     in
98 :     SOME(CL.mkAssign(lhs, rhs))
99 :     end
100 :     | initInput _ = NONE
101 :     in
102 :     CL.D_Func(
103 :     ["static"], CL.voidTy, N.initDefaults,
104 :     [CL.PARAM([], inputPtrTy, "inp")],
105 :     CL.mkBlock(List.mapPartial initInput inputs))
106 :     end
107 :    
108 : jhr 1845 (* generate code to register command-line options for setting the input variables *)
109 : jhr 1820 fun genRegisterInputs (tgt, inputs) = let
110 : jhr 2041 (* the inputs pointer type *)
111 :     val inputPtrTy = CL.T_Ptr(CL.T_Named(N.inputsTy tgt))
112 :     (* some common variables *)
113 :     val inpV = CL.mkVar "inp"
114 :     val optsV = CL.mkVar "opts"
115 :     (* register a given input *)
116 : jhr 2048 fun registerInput (ty, name, desc, optDflt) = CL.mkCall(N.input ty, [
117 : jhr 2041 optsV, CL.mkStr name, CL.mkStr(Option.getOpt(desc, "")),
118 :     CL.mkUnOp(CL.%&, CL.mkIndirect(inpV, name)),
119 : jhr 2048 CL.mkBool(Option.isSome optDflt)
120 : jhr 2041 ])
121 :     in
122 :     CL.D_Func(
123 :     ["static"], CL.voidTy, N.registerOpts,
124 :     [CL.PARAM([], inputPtrTy, "inp"), CL.PARAM([], CL.T_Ptr(CL.T_Named N.optionsTy), "opts")],
125 :     CL.mkBlock(List.map registerInput inputs))
126 :     end
127 :    
128 :     (* generate code to initialize the global input variables from the command-line inputs *)
129 :     fun genInitInputs (tgt, inputs) = let
130 : jhr 1820 (* the world pointer type *)
131 :     val worldPtrTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
132 : jhr 1845 (* the global state pointer type *)
133 :     val globPtrTy = CL.T_Ptr(CL.T_Named(N.globalTy tgt))
134 : jhr 2041 (* the inputs pointer type *)
135 :     val inputPtrTy = CL.T_Ptr(CL.T_Named(N.inputsTy tgt))
136 : jhr 1845 (* some common variables *)
137 : jhr 2041 val inpV = CL.mkVar "inp"
138 : jhr 1845 val optsV = CL.mkVar "opts"
139 : jhr 2041 (* initialize a given input global; for sequences and images, this requires
140 :     * loading the value from the specified nrrd file, while for other types
141 :     * we just copy the values.
142 :     *)
143 : jhr 2048 fun initInput ((Ty.DynSeqTy elemTy, name, desc, optDflt), stms) = CL.mkCall("dummy", [
144 : jhr 2012 optsV, CL.mkStr name, CL.mkStr(Option.getOpt(desc, "")),
145 : jhr 2048 CL.mkUnOp(CL.%&, global name),
146 :     CL.mkBool(Option.isSome optDflt)
147 :     ]) :: stms
148 :     | initInput ((Ty.ImageTy info, name, desc, optDflt), stms) = CL.mkCall("dummy", [
149 : jhr 2033 optsV, CL.mkStr name, CL.mkStr(Option.getOpt(desc, "")),
150 : jhr 2048 CL.mkUnOp(CL.%&, global name),
151 :     CL.mkBool(Option.isSome optDflt)
152 :     ]) :: stms
153 :     | initInput ((ty, name, _, _), stms) =
154 :     TrTy.copyFromC{ty=ty, dst=global name, src=CL.mkIndirect(inpV, name)} @ stms
155 : jhr 1820 in
156 :     CL.D_Func(
157 : jhr 2041 ["static"], CL.voidTy, N.initInputs,
158 :     [CL.PARAM([], worldPtrTy, "wrld"), CL.PARAM([], inputPtrTy, "inp")],
159 : jhr 1845 CL.mkBlock(
160 :     CL.mkDeclInit(globPtrTy, "glob", CL.mkIndirect(CL.mkVar "wrld", "globals")) ::
161 : jhr 2048 List.foldr initInput [] inputs))
162 : jhr 1820 end
163 :    
164 : jhr 2048 (* generate the functions that handle inputs for standalone executables. These are:
165 :     * InitDefaults -- called to initialize the default input values
166 :     * RegisterInputs -- called to register the command-line options for the input globals
167 :     * InitInptus -- called to initialize the input globals from the values specified
168 :     * on the command line.
169 :     *)
170 :     fun genExecInputFuns arg = [
171 :     genInitDefaults arg,
172 :     genRegisterInputs arg,
173 :     genInitInputs arg
174 :     ]
175 :    
176 :     (* generate the typedef for the defined-input flag struct. *)
177 :     fun genDefinedInpStruct (tgt : target_desc, inputs) = let
178 :     fun mkField (_, name, _, _) = (CL.boolTy, name)
179 :     in
180 :     CL.D_StructDef(NONE, List.map mkField inputs, SOME(N.definedInpTy tgt))
181 :     end
182 :    
183 :     fun genDefineInp (tgt, inputs) = let
184 :     (* the world pointer type *)
185 :     val worldPtrTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
186 :     val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
187 : jhr 2049 fun initFlag (_, name, _, _) = CL.mkAssign(defined name, CL.mkBool false)
188 : jhr 2048 in
189 :     CL.D_Func(
190 :     ["static"], CL.voidTy, N.initDefined tgt,
191 :     [wrldParam],
192 :     CL.mkBlock(List.map initFlag inputs))
193 :     end
194 :    
195 : jhr 2049 fun genCheckInputs (tgt, inputs) = let
196 :     (* the world pointer type *)
197 :     val worldPtrTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
198 :     val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
199 :     (* the inputs pointer type *)
200 :     fun check (ty, name, _, optDflt) = let
201 :     val dfltStm = (case optDflt
202 :     of SOME v => CL.mkBlock[] (* FIXME: set global to default value *)
203 :     | NONE => CL.mkBlock[
204 :     World.errorMsgAdd(CL.mkStr(concat["undefined input \"", name, "\"\n"])),
205 :     CL.mkReturn(SOME(CL.mkBool true))
206 :     ]
207 :     (* end case *))
208 :     in
209 :     CL.mkIfThen(CL.mkUnOp(CL.%!, defined name), dfltStm)
210 :     end
211 :     in
212 :     CL.D_Func(
213 :     ["static"], CL.boolTy, N.checkDefined tgt,
214 :     [wrldParam],
215 :     CL.mkBlock(List.map check inputs @ [CL.mkReturn(SOME(CL.mkBool false))]))
216 :     end
217 :    
218 : jhr 2041 (* for each input variable we generate two or three top-level declarations in the
219 :     * exported API.
220 :     *)
221 : jhr 1820 fun genInputFuns (tgt, inputs) = let
222 :     (* the world pointer type *)
223 :     val worldPtrTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
224 :     val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
225 :     (* create decls for an input variable *)
226 : jhr 2048 fun mkInputDecls (ty, name, desc, optDflt) = let
227 : jhr 1820 (* create a description declaration for the input variable *)
228 : jhr 2012 val descDcl = (case desc
229 :     of SOME desc => [
230 :     CL.D_Var([], CL.T_Ptr(CL.T_Named "const char"),
231 :     N.inputDesc(tgt, name),
232 :     SOME(CL.I_Exp(CL.mkStr desc)))
233 :     ]
234 :     | NONE => []
235 :     (* end case *))
236 : jhr 2048 val getDcl = if (Option.isSome optDflt)
237 : jhr 1820 then let
238 :     val getName = N.inputGet(tgt, name)
239 :     (* convert the input type to a by-reference C type *)
240 :     val outTy = (case ty
241 :     of Ty.BoolTy => CL.T_Ptr(trType ty)
242 :     | Ty.StringTy => CL.T_Ptr(trType ty)
243 :     | Ty.IntTy => CL.T_Ptr(trType ty)
244 :     | Ty.TensorTy[] => CL.T_Ptr(trType ty)
245 :     | Ty.TensorTy _ => trType ty
246 :     | Ty.SeqTy _ => trType ty
247 :     | Ty.DynSeqTy _ => CL.T_Ptr(trType ty)
248 :     | Ty.ImageTy _ => CL.T_Ptr CL.charPtr
249 :     | _ => raise Fail(concat["bogus input type ", Ty.toString ty])
250 :     (* end case *))
251 :     in [
252 :     CL.D_Func([], CL.voidTy, getName, [wrldParam, CL.PARAM([], outTy, "v")],
253 :     CL.mkBlock(
254 :     TrTy.copyToC{ty=ty, dst=CL.mkUnOp(CL.%*, CL.mkVar "v"), src=global name}))
255 :     ] end
256 :     else []
257 :     val setDcl = (case ty
258 :     of Ty.ImageTy info => let
259 :     val dim = ImageInfo.dim info
260 :     in [
261 :     CL.D_Func(
262 :     [], CL.boolTy, N.inputSetByName(tgt, name),
263 :     [wrldParam, CL.PARAM(["const"], CL.charPtr, "s")],
264 :     CL.mkBlock[
265 :     (* FIXME: we should also generate code to check that the loaded image has the right type, etc. *)
266 :     CL.mkReturn(SOME(
267 :     CL.mkBinOp(CL.mkVar "DIDEROT_FAIL", CL.#==,
268 :     CL.mkApply(N.loadImage dim, [
269 :     CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
270 :     CL.mkVar "s", CL.mkUnOp(CL.%&, global name)
271 :     ]))))
272 :     ]),
273 :     CL.D_Func(
274 :     [], CL.boolTy, N.inputSet(tgt, name),
275 :     [wrldParam, CL.PARAM([], nrrdPtrTy, "nin")],
276 :     CL.mkBlock[
277 :     (* FIXME: we should also generate code to check that the loaded image has the right type, etc. *)
278 :     CL.mkReturn(SOME(
279 :     CL.mkBinOp(CL.mkVar "DIDEROT_FAIL", CL.#==,
280 :     CL.mkApply(N.setImage dim, [
281 :     CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
282 :     CL.mkVar "nin", CL.mkUnOp(CL.%&, global name)
283 :     ]))))
284 :     ])
285 :     ] end
286 : jhr 1999 (* dynamic sequence loader prototype:
287 :     Diderot_DynSeq_t *Diderot_DynSeqLoadTY (
288 :     WorldPrefix_t *wrld,
289 :     Nrrd *nin,
290 :     unsigned int nDims,
291 :     unsigned int *dims);
292 :     *)
293 :     (*
294 :     | Ty.DynSeqTy elemTy => [
295 :     CL.D_Func(
296 :     [], CL.boolTy, N.inputSetByName(tgt, name),
297 :     [wrldParam, CL.PARAM(["const"], CL.charPtr, "s")],
298 :     CL.mkBlock[
299 :     CL.mkReturn(SOME(
300 :     CL.mkBinOp(CL.mkVar "DIDEROT_FAIL", CL.#==,
301 :     CL.mkApply(N.loadSeq elemTy, [
302 :     CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
303 :     CL.mkVar "s", CL.mkUnOp(CL.%&, global name)
304 :     ]))))
305 :     ]),
306 :     CL.D_Func(
307 :     [], CL.boolTy, N.inputSet(tgt, name),
308 :     [wrldParam, CL.PARAM([], nrrdPtrTy, "nin")],
309 :     CL.mkBlock[
310 :     CL.mkReturn(SOME(
311 :     CL.mkBinOp(CL.mkVar "DIDEROT_FAIL", CL.#==,
312 :     CL.mkApply(N.loadSeq elemTy, [
313 :     CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
314 :     CL.mkVar "nin", CL.mkUnOp(CL.%&, global name)
315 :     ]))))
316 :     ])
317 :     ]
318 :     *)
319 :     | Ty.DynSeqTy elemTy => raise Fail "dynamic input not supported yet"
320 : jhr 1820 | _ => [
321 :     CL.D_Func(
322 :     [], CL.boolTy, N.inputSet(tgt, name),
323 :     [wrldParam, CL.PARAM([], trType ty, "v")],
324 :     CL.mkBlock(
325 : jhr 2048 CL.mkAssign(defined name, CL.mkBool true) ::
326 : jhr 1820 TrTy.copyFromC{ty=ty, dst=global name, src=CL.mkVar "v"} @
327 :     [CL.mkReturn(SOME(CL.mkVar "false"))]))
328 :     ]
329 :     (* end case *))
330 :     in
331 : jhr 2049 (descDcl @ getDcl @ setDcl)
332 : jhr 1820 end
333 : jhr 2049 val extras = [
334 :     genCheckInputs (tgt, inputs),
335 :     genDefineInp (tgt, inputs)
336 :     ]
337 : jhr 1820 in
338 : jhr 2049 List.foldr (fn (input, dcls) => mkInputDecls input @ dcls) extras inputs
339 : jhr 1820 end
340 :    
341 :     end

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