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 2719 - (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 : jhr 2082 val genInputsStruct : Properties.props * input_desc list -> CLang.decl
20 : jhr 2041
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 : jhr 2082 val genExecInputFuns : Properties.props * 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 : jhr 2082 val genDefinedInpStruct : Properties.props * input_desc list -> CLang.decl
33 : jhr 2048
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 2082 val genInputFuns : Properties.props * input_desc list -> CLang.decl list
38 : jhr 1820
39 :     end = struct
40 :    
41 :     structure IL = TreeIL
42 :     structure Ty = TreeIL.Ty
43 :     structure CL = CLang
44 :     structure N = CNames
45 : jhr 2051 structure ToC = TreeToC
46 : jhr 1820 structure TrTy = CTyTranslate
47 :    
48 : jhr 2048 type input_desc = (Ty.ty * string * string option * IL.exp option)
49 : jhr 1820
50 :     val nrrdPtrTy = CL.T_Ptr(CL.T_Named "Nrrd")
51 :     val wrldPrefixTy = CL.T_Ptr(CL.T_Named "WorldPrefix_t")
52 :    
53 : jhr 2708 (* world pointer cast to the world prefix type *)
54 :     val wrldPrefix = CL.mkCast(wrldPrefixTy, CL.mkVar "wrld")
55 :    
56 : jhr 2082 type props = Properties.props
57 : jhr 1820
58 :     (* translate a TreeIL type to the C types used to represent it in the external API *)
59 :     val trType = CTyTranslate.toCType
60 :    
61 : jhr 2048 (* an l-value expression for accessing a defined-input flag *)
62 :     fun defined name = CL.mkSelect(CL.mkIndirect(CL.mkVar "wrld", "definedInp"), name)
63 :    
64 : jhr 1820 (* an l-value expression for accessing a global variable *)
65 :     fun global name = CL.mkIndirect(CL.mkIndirect(CL.mkVar "wrld", "globals"), name)
66 :    
67 :     (* gather the input globals from the input initialization block *)
68 :     fun gatherInputs (IL.Block{body, ...}) = let
69 : jhr 2048 fun inputInfo cvt (x, name, desc, NONE) =
70 :     SOME(IL.Var.ty x, name, desc, NONE)
71 :     | inputInfo cvt (x, name, desc, SOME v) =
72 :     SOME(IL.Var.ty x, name, desc, SOME(cvt v))
73 :     fun gather (IL.S_Input inp) = inputInfo (fn e => e) inp
74 :     | gather (IL.S_InputNrrd inp) = inputInfo (fn s => TreeIL.E_Lit(Literal.String s)) inp
75 : jhr 1820 | gather _ = NONE
76 :     in
77 :     List.mapPartial gather body
78 :     end
79 :    
80 : jhr 2041 (* generate the input initialization structure that we use to initialize input
81 :     * globals from command-line arguments in stand-alone executables.
82 :     *)
83 : jhr 2082 fun genInputsStruct (tgt : props, inputs) = let
84 : jhr 2041 fun mkField (Ty.DynSeqTy _, name, _, _) = (CL.charPtr, name)
85 :     | mkField (Ty.ImageTy _, name, _, _) = (CL.charPtr, name)
86 :     | mkField (ty, name, _, _) = (trType ty, name)
87 :     in
88 :     CL.D_StructDef(NONE, List.map mkField inputs, SOME(N.inputsTy tgt))
89 :     end
90 :    
91 : jhr 2118 local
92 :     fun subscript (e, i) = CL.mkSubscript(e, CL.mkInt(IntInf.fromInt i))
93 :    
94 :     (* initialize an external C representation from constant expressions *)
95 :     fun initC {ty, dst, src} = let
96 :     fun cvtExp e = TreeToC.trExp (TreeIL.Var.Map.empty, e)
97 :     fun simpleInit () = [CL.mkAssign(dst, cvtExp src)]
98 :     in
99 :     case (ty, src)
100 :     of (Ty.BoolTy, _) => simpleInit ()
101 :     | (Ty.StringTy, _) => simpleInit ()
102 :     | (Ty.IntTy, _) => simpleInit ()
103 :     | (Ty.TensorTy[], _) => simpleInit ()
104 :     | (Ty.TensorTy[n], TreeIL.E_Cons(_, es)) => let
105 :     fun lp (_, []) = []
106 :     | lp (i, e::es) = CL.mkAssign(subscript(dst, i), cvtExp e) :: lp(i+1, es)
107 :     in
108 :     lp(0, es)
109 :     end
110 : jhr 2708 | (Ty.DynSeqTy _, _) => simpleInit ()
111 : jhr 2719 | (Ty.ImageTy _, _) => simpleInit ()
112 : jhr 2118 | _ => raise Fail(concat["CTyTranslate.initC(", Ty.toString ty, ") not supported yet"])
113 :     (* end case *)
114 :     end
115 :     in
116 : jhr 2048 (* generate code to initialize the default input values *)
117 :     fun genInitDefaults (tgt, inputs) = let
118 :     (* the inputs pointer type *)
119 :     val inputPtrTy = CL.T_Ptr(CL.T_Named(N.inputsTy tgt))
120 :     (* some common variables *)
121 :     val inpV = CL.mkVar "inp"
122 :     (* initialize a given input *)
123 : jhr 2118 fun initInput ((ty, name, _, SOME dflt), stms) = let
124 : jhr 2048 val lhs = CL.mkIndirect(inpV, name)
125 :     in
126 : jhr 2118 initC {ty=ty, dst=lhs, src=dflt} @ stms
127 : jhr 2048 end
128 : jhr 2118 | initInput (_, stms) = stms
129 : jhr 2048 in
130 :     CL.D_Func(
131 :     ["static"], CL.voidTy, N.initDefaults,
132 :     [CL.PARAM([], inputPtrTy, "inp")],
133 : jhr 2118 CL.mkBlock(List.foldr initInput [] inputs))
134 : jhr 2048 end
135 : jhr 2118 end (* local *)
136 : jhr 2048
137 : jhr 1845 (* generate code to register command-line options for setting the input variables *)
138 : jhr 1820 fun genRegisterInputs (tgt, inputs) = let
139 : jhr 2041 (* the inputs pointer type *)
140 :     val inputPtrTy = CL.T_Ptr(CL.T_Named(N.inputsTy tgt))
141 :     (* some common variables *)
142 :     val inpV = CL.mkVar "inp"
143 :     val optsV = CL.mkVar "opts"
144 :     (* register a given input *)
145 : jhr 2048 fun registerInput (ty, name, desc, optDflt) = CL.mkCall(N.input ty, [
146 : jhr 2041 optsV, CL.mkStr name, CL.mkStr(Option.getOpt(desc, "")),
147 : jhr 2118 if TrTy.isCArrayTy ty
148 :     then CL.mkIndirect(inpV, name)
149 :     else CL.mkUnOp(CL.%&, CL.mkIndirect(inpV, name)),
150 : jhr 2048 CL.mkBool(Option.isSome optDflt)
151 : jhr 2041 ])
152 :     in
153 :     CL.D_Func(
154 :     ["static"], CL.voidTy, N.registerOpts,
155 :     [CL.PARAM([], inputPtrTy, "inp"), CL.PARAM([], CL.T_Ptr(CL.T_Named N.optionsTy), "opts")],
156 :     CL.mkBlock(List.map registerInput inputs))
157 :     end
158 :    
159 :     (* generate code to initialize the global input variables from the command-line inputs *)
160 :     fun genInitInputs (tgt, inputs) = let
161 : jhr 1820 (* the world pointer type *)
162 :     val worldPtrTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
163 : jhr 1845 (* the global state pointer type *)
164 :     val globPtrTy = CL.T_Ptr(CL.T_Named(N.globalTy tgt))
165 : jhr 2041 (* the inputs pointer type *)
166 :     val inputPtrTy = CL.T_Ptr(CL.T_Named(N.inputsTy tgt))
167 : jhr 1845 (* some common variables *)
168 : jhr 2041 val inpV = CL.mkVar "inp"
169 : jhr 1845 val optsV = CL.mkVar "opts"
170 : jhr 2041 (* initialize a given input global; for sequences and images, this requires
171 :     * loading the value from the specified nrrd file, while for other types
172 :     * we just copy the values.
173 :     *)
174 : jhr 2708 fun initInput ((Ty.DynSeqTy elemTy, name, desc, optDflt), stms) = let
175 :     val (loadFn, nDims, dims) = (case elemTy
176 :     of Ty.BoolTy => ("Diderot_DynSeqLoadBoolFromFile", CL.mkInt 0, CL.mkInt 0)
177 :     | Ty.IntTy => ("Diderot_DynSeqLoadIntFromFile", CL.mkInt 0, CL.mkInt 0)
178 :     | Ty.TensorTy[] => ("Diderot_DynSeqLoadRealFromFile", CL.mkInt 0, CL.mkInt 0)
179 :     | Ty.TensorTy _ => raise Fail "TODO: sequences of tensors"
180 :     | Ty.SeqTy elemTy => raise Fail "TODO: sequences of sequences"
181 :     | _ => raise Fail "unsupported dynamic sequence type"
182 :     (* end case *))
183 :     in
184 :     CL.mkAssign(global name,
185 : jhr 2709 CL.mkApply(loadFn, [wrldPrefix, CL.mkIndirect(inpV, name), nDims, dims])) ::
186 :     CL.mkIfThen(CL.mkBinOp(global name, CL.#==, CL.mkInt 0),
187 :     CL.mkReturn(SOME(CL.mkVar "true"))) :: stms
188 : jhr 2708 end
189 :     | initInput ((Ty.ImageTy info, name, desc, optDflt), stms) = let
190 :     val loadFn = (case ImageInfo.dim info
191 :     of 1 => "Diderot_LoadImage1D"
192 :     | 2 => "Diderot_LoadImage2D"
193 :     | 3 => "Diderot_LoadImage3D"
194 :     | _ => raise Fail "image with dimension > 3"
195 :     (* end case *))
196 :     in
197 : jhr 2709 CL.mkIfThen(
198 :     CL.mkApply(loadFn, [wrldPrefix, CL.mkIndirect(inpV, name), CL.mkAddrOf(global name)]),
199 :     CL.mkReturn(SOME(CL.mkVar "true"))) :: stms
200 : jhr 2708 end
201 : jhr 2048 | initInput ((ty, name, _, _), stms) =
202 :     TrTy.copyFromC{ty=ty, dst=global name, src=CL.mkIndirect(inpV, name)} @ stms
203 : jhr 1820 in
204 :     CL.D_Func(
205 : jhr 2709 ["static"], CL.boolTy, N.initInputs,
206 : jhr 2041 [CL.PARAM([], worldPtrTy, "wrld"), CL.PARAM([], inputPtrTy, "inp")],
207 : jhr 1845 CL.mkBlock(
208 :     CL.mkDeclInit(globPtrTy, "glob", CL.mkIndirect(CL.mkVar "wrld", "globals")) ::
209 : jhr 2709 List.foldr initInput [CL.mkReturn(SOME(CL.mkVar "false"))] inputs))
210 : jhr 1820 end
211 :    
212 : jhr 2048 (* generate the functions that handle inputs for standalone executables. These are:
213 :     * InitDefaults -- called to initialize the default input values
214 :     * RegisterInputs -- called to register the command-line options for the input globals
215 :     * InitInptus -- called to initialize the input globals from the values specified
216 :     * on the command line.
217 :     *)
218 :     fun genExecInputFuns arg = [
219 :     genInitDefaults arg,
220 :     genRegisterInputs arg,
221 :     genInitInputs arg
222 :     ]
223 :    
224 :     (* generate the typedef for the defined-input flag struct. *)
225 : jhr 2082 fun genDefinedInpStruct (tgt : props, inputs) = let
226 : jhr 2048 fun mkField (_, name, _, _) = (CL.boolTy, name)
227 :     in
228 :     CL.D_StructDef(NONE, List.map mkField inputs, SOME(N.definedInpTy tgt))
229 :     end
230 :    
231 :     fun genDefineInp (tgt, inputs) = let
232 :     (* the world pointer type *)
233 :     val worldPtrTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
234 :     val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
235 : jhr 2049 fun initFlag (_, name, _, _) = CL.mkAssign(defined name, CL.mkBool false)
236 : jhr 2048 in
237 :     CL.D_Func(
238 :     ["static"], CL.voidTy, N.initDefined tgt,
239 :     [wrldParam],
240 :     CL.mkBlock(List.map initFlag inputs))
241 :     end
242 :    
243 : jhr 2049 fun genCheckInputs (tgt, inputs) = let
244 :     (* the world pointer type *)
245 :     val worldPtrTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
246 :     val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
247 :     (* the inputs pointer type *)
248 :     fun check (ty, name, _, optDflt) = let
249 :     val dfltStm = (case optDflt
250 : jhr 2054 of SOME v => let
251 :     (* get default file name for images and sequences *)
252 :     fun getName () = (case v
253 :     of IL.E_Lit(Literal.String s) => CL.mkStr s
254 :     | _ => raise Fail "expected string for default nrrd"
255 :     (* end case *))
256 :     in
257 :     case ty
258 :     of Ty.DynSeqTy elemTy =>
259 :     GenLoadNrrd.loadSeqFromFile (global name, elemTy, getName())
260 :     | Ty.ImageTy info =>
261 :     GenLoadNrrd.loadImage (global name, info, getName())
262 :     | _ => CL.mkBlock(ToC.trAssign(ToC.empty, global name, v))
263 :     (* end case *)
264 :     end
265 : jhr 2049 | NONE => CL.mkBlock[
266 :     World.errorMsgAdd(CL.mkStr(concat["undefined input \"", name, "\"\n"])),
267 :     CL.mkReturn(SOME(CL.mkBool true))
268 :     ]
269 :     (* end case *))
270 :     in
271 :     CL.mkIfThen(CL.mkUnOp(CL.%!, defined name), dfltStm)
272 :     end
273 :     in
274 :     CL.D_Func(
275 :     ["static"], CL.boolTy, N.checkDefined tgt,
276 :     [wrldParam],
277 :     CL.mkBlock(List.map check inputs @ [CL.mkReturn(SOME(CL.mkBool false))]))
278 :     end
279 :    
280 : jhr 2041 (* for each input variable we generate two or three top-level declarations in the
281 :     * exported API.
282 :     *)
283 : jhr 1820 fun genInputFuns (tgt, inputs) = let
284 :     (* the world pointer type *)
285 :     val worldPtrTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
286 :     val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
287 :     (* create decls for an input variable *)
288 : jhr 2048 fun mkInputDecls (ty, name, desc, optDflt) = let
289 : jhr 1820 (* create a description declaration for the input variable *)
290 : jhr 2012 val descDcl = (case desc
291 :     of SOME desc => [
292 :     CL.D_Var([], CL.T_Ptr(CL.T_Named "const char"),
293 :     N.inputDesc(tgt, name),
294 :     SOME(CL.I_Exp(CL.mkStr desc)))
295 :     ]
296 :     | NONE => []
297 :     (* end case *))
298 : jhr 2048 val getDcl = if (Option.isSome optDflt)
299 : jhr 1820 then let
300 :     val getName = N.inputGet(tgt, name)
301 : jhr 2054 (* generate code for a function that returns the current value of
302 :     * an input global.
303 :     *)
304 :     fun mkFunc outTy = CL.D_Func([], CL.voidTy, getName,
305 :     [wrldParam, CL.PARAM([], outTy, "v")],
306 :     CL.mkBlock(TrTy.copyToC{
307 :     ty=ty, dst=CL.mkUnOp(CL.%*, CL.mkVar "v"),
308 :     src=global name
309 :     }))
310 :     (* FIXME: for images and sequences, it is not clear what the get function should return.
311 :     * For now, we just return 0
312 :     *)
313 :     (* for images and sequences, we currently return 0 *)
314 :     fun nrrdFunc () = CL.D_Func([], CL.voidTy, getName,
315 :     [wrldParam, CL.PARAM([], CL.T_Ptr CL.voidPtr, "v")],
316 :     CL.mkAssign(CL.mkUnOp(CL.%*, CL.mkVar "v"), CL.mkInt 0))
317 :     val func = (case ty
318 :     of Ty.BoolTy => mkFunc(CL.T_Ptr(trType ty))
319 :     | Ty.StringTy => mkFunc(CL.T_Ptr(trType ty))
320 :     | Ty.IntTy => mkFunc(CL.T_Ptr(trType ty))
321 :     | Ty.TensorTy[] => mkFunc(CL.T_Ptr(trType ty))
322 :     | Ty.TensorTy _ => mkFunc(trType ty)
323 :     | Ty.SeqTy _ => mkFunc(trType ty)
324 :     | Ty.DynSeqTy _ => nrrdFunc ()
325 :     | Ty.ImageTy _ => nrrdFunc ()
326 : jhr 1820 | _ => raise Fail(concat["bogus input type ", Ty.toString ty])
327 :     (* end case *))
328 : jhr 2054 in
329 :     [func]
330 :     end
331 : jhr 1820 else []
332 :     val setDcl = (case ty
333 : jhr 2054 of Ty.ImageTy info => [
334 : jhr 1820 CL.D_Func(
335 :     [], CL.boolTy, N.inputSetByName(tgt, name),
336 :     [wrldParam, CL.PARAM(["const"], CL.charPtr, "s")],
337 : jhr 2051 CL.appendStm(
338 :     GenLoadNrrd.loadImage (global name, info, CL.mkVar "s"),
339 :     CL.mkReturn(SOME(CL.mkBool false)))),
340 : jhr 1820 CL.D_Func(
341 :     [], CL.boolTy, N.inputSet(tgt, name),
342 :     [wrldParam, CL.PARAM([], nrrdPtrTy, "nin")],
343 : jhr 2051 CL.appendStm(
344 :     GenLoadNrrd.setImage (global name, info, CL.mkVar "nin"),
345 :     CL.mkReturn(SOME(CL.mkBool false))))
346 : jhr 2054 ]
347 :     | Ty.DynSeqTy elemTy => [
348 : jhr 1999 CL.D_Func(
349 :     [], CL.boolTy, N.inputSetByName(tgt, name),
350 :     [wrldParam, CL.PARAM(["const"], CL.charPtr, "s")],
351 : jhr 2054 CL.appendStm(
352 :     GenLoadNrrd.loadSeqFromFile (global name, elemTy, CL.mkVar "s"),
353 :     CL.mkReturn(SOME(CL.mkBool false)))),
354 : jhr 1999 CL.D_Func(
355 :     [], CL.boolTy, N.inputSet(tgt, name),
356 :     [wrldParam, CL.PARAM([], nrrdPtrTy, "nin")],
357 : jhr 2054 CL.appendStm(
358 :     GenLoadNrrd.loadSeq (global name, elemTy, CL.mkVar "nin"),
359 :     CL.mkReturn(SOME(CL.mkBool false))))
360 :     ]
361 : jhr 1820 | _ => [
362 :     CL.D_Func(
363 :     [], CL.boolTy, N.inputSet(tgt, name),
364 :     [wrldParam, CL.PARAM([], trType ty, "v")],
365 :     CL.mkBlock(
366 : jhr 2048 CL.mkAssign(defined name, CL.mkBool true) ::
367 : jhr 1820 TrTy.copyFromC{ty=ty, dst=global name, src=CL.mkVar "v"} @
368 :     [CL.mkReturn(SOME(CL.mkVar "false"))]))
369 :     ]
370 :     (* end case *))
371 :     in
372 : jhr 2049 (descDcl @ getDcl @ setDcl)
373 : jhr 1820 end
374 : jhr 2049 val extras = [
375 :     genCheckInputs (tgt, inputs),
376 :     genDefineInp (tgt, inputs)
377 :     ]
378 : jhr 1820 in
379 : jhr 2049 List.foldr (fn (input, dcls) => mkInputDecls input @ dcls) extras inputs
380 : jhr 1820 end
381 :    
382 :     end

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