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 2012 - (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 2012 type input_desc = (TreeIL.Ty.ty * string * string option * bool)
11 : jhr 1820
12 :     val gatherInputs : TreeIL.block -> input_desc list
13 :    
14 :     val genRegisterInputs : TargetUtil.target_desc * input_desc list -> CLang.decl
15 :    
16 :     val genInputFuns : TargetUtil.target_desc * input_desc list -> CLang.decl list
17 :    
18 :     end = struct
19 :    
20 :     structure IL = TreeIL
21 :     structure Ty = TreeIL.Ty
22 :     structure CL = CLang
23 :     structure N = CNames
24 :     structure TrTy = CTyTranslate
25 :    
26 : jhr 2012 type input_desc = (Ty.ty * string * string option * bool)
27 : jhr 1820
28 :     val nrrdPtrTy = CL.T_Ptr(CL.T_Named "Nrrd")
29 :     val wrldPrefixTy = CL.T_Ptr(CL.T_Named "WorldPrefix_t")
30 :    
31 :     type target_desc = TargetUtil.target_desc
32 :    
33 :     (* translate a TreeIL type to the C types used to represent it in the external API *)
34 :     val trType = CTyTranslate.toCType
35 :    
36 :     (* an l-value expression for accessing a global variable *)
37 :     fun global name = CL.mkIndirect(CL.mkIndirect(CL.mkVar "wrld", "globals"), name)
38 :    
39 :     (* gather the input globals from the input initialization block *)
40 :     fun gatherInputs (IL.Block{body, ...}) = let
41 :     fun gather (IL.S_Input(x, name, desc, NONE)) = SOME(IL.Var.ty x, name, desc, false)
42 :     | gather (IL.S_Input(x, name, desc, SOME _)) = SOME(IL.Var.ty x, name, desc, true)
43 :     | gather _ = NONE
44 :     in
45 :     List.mapPartial gather body
46 :     end
47 :    
48 : jhr 1845 (* generate code to register command-line options for setting the input variables *)
49 : jhr 1820 fun genRegisterInputs (tgt, inputs) = let
50 :     (* the world pointer type *)
51 :     val worldPtrTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
52 : jhr 1845 (* the global state pointer type *)
53 :     val globPtrTy = CL.T_Ptr(CL.T_Named(N.globalTy tgt))
54 :     (* some common variables *)
55 :     val globV = CL.mkVar "glob"
56 :     val optsV = CL.mkVar "opts"
57 :     (* register a given input *)
58 :     fun registerInput (ty, name, desc, hasDflt) = CL.mkCall(N.input ty, [
59 : jhr 2012 optsV, CL.mkStr name, CL.mkStr(Option.getOpt(desc, "")),
60 : jhr 1845 CL.mkUnOp(CL.%&, CL.mkIndirect(globV, name)),
61 :     CL.mkBool hasDflt
62 :     ])
63 : jhr 1820 in
64 :     CL.D_Func(
65 : jhr 1845 ["static"], CL.voidTy, N.registerOpts,
66 : jhr 1820 [CL.PARAM([], worldPtrTy, "wrld"), CL.PARAM([], CL.T_Ptr(CL.T_Named N.optionsTy), "opts")],
67 : jhr 1845 CL.mkBlock(
68 :     CL.mkDeclInit(globPtrTy, "glob", CL.mkIndirect(CL.mkVar "wrld", "globals")) ::
69 :     List.map registerInput inputs))
70 : jhr 1820 end
71 :    
72 :     (* for each input variable we generate two or three top-level declaraions *)
73 :     fun genInputFuns (tgt, inputs) = let
74 :     (* the world pointer type *)
75 :     val worldPtrTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
76 :     val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
77 :     (* create decls for an input variable *)
78 :     fun mkInputDecls (ty, name, desc, hasDflt) = let
79 :     (* create a description declaration for the input variable *)
80 : jhr 2012 val descDcl = (case desc
81 :     of SOME desc => [
82 :     CL.D_Var([], CL.T_Ptr(CL.T_Named "const char"),
83 :     N.inputDesc(tgt, name),
84 :     SOME(CL.I_Exp(CL.mkStr desc)))
85 :     ]
86 :     | NONE => []
87 :     (* end case *))
88 : jhr 1820 val getDcl = if hasDflt
89 :     then let
90 :     val getName = N.inputGet(tgt, name)
91 :     (* convert the input type to a by-reference C type *)
92 :     val outTy = (case ty
93 :     of Ty.BoolTy => CL.T_Ptr(trType ty)
94 :     | Ty.StringTy => CL.T_Ptr(trType ty)
95 :     | Ty.IntTy => CL.T_Ptr(trType ty)
96 :     | Ty.TensorTy[] => CL.T_Ptr(trType ty)
97 :     | Ty.TensorTy _ => trType ty
98 :     | Ty.SeqTy _ => trType ty
99 :     | Ty.DynSeqTy _ => CL.T_Ptr(trType ty)
100 :     | Ty.ImageTy _ => CL.T_Ptr CL.charPtr
101 :     | _ => raise Fail(concat["bogus input type ", Ty.toString ty])
102 :     (* end case *))
103 :     in [
104 :     CL.D_Func([], CL.voidTy, getName, [wrldParam, CL.PARAM([], outTy, "v")],
105 :     CL.mkBlock(
106 :     TrTy.copyToC{ty=ty, dst=CL.mkUnOp(CL.%*, CL.mkVar "v"), src=global name}))
107 :     ] end
108 :     else []
109 :     val setDcl = (case ty
110 :     of Ty.ImageTy info => let
111 :     val dim = ImageInfo.dim info
112 :     in [
113 :     CL.D_Func(
114 :     [], CL.boolTy, N.inputSetByName(tgt, name),
115 :     [wrldParam, CL.PARAM(["const"], CL.charPtr, "s")],
116 :     CL.mkBlock[
117 :     (* FIXME: we should also generate code to check that the loaded image has the right type, etc. *)
118 :     CL.mkReturn(SOME(
119 :     CL.mkBinOp(CL.mkVar "DIDEROT_FAIL", CL.#==,
120 :     CL.mkApply(N.loadImage dim, [
121 :     CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
122 :     CL.mkVar "s", CL.mkUnOp(CL.%&, global name)
123 :     ]))))
124 :     ]),
125 :     CL.D_Func(
126 :     [], CL.boolTy, N.inputSet(tgt, name),
127 :     [wrldParam, CL.PARAM([], nrrdPtrTy, "nin")],
128 :     CL.mkBlock[
129 :     (* FIXME: we should also generate code to check that the loaded image has the right type, etc. *)
130 :     CL.mkReturn(SOME(
131 :     CL.mkBinOp(CL.mkVar "DIDEROT_FAIL", CL.#==,
132 :     CL.mkApply(N.setImage dim, [
133 :     CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
134 :     CL.mkVar "nin", CL.mkUnOp(CL.%&, global name)
135 :     ]))))
136 :     ])
137 :     ] end
138 : jhr 1999 (* dynamic sequence loader prototype:
139 :     Diderot_DynSeq_t *Diderot_DynSeqLoadTY (
140 :     WorldPrefix_t *wrld,
141 :     Nrrd *nin,
142 :     unsigned int nDims,
143 :     unsigned int *dims);
144 :     *)
145 :     (*
146 :     | Ty.DynSeqTy elemTy => [
147 :     CL.D_Func(
148 :     [], CL.boolTy, N.inputSetByName(tgt, name),
149 :     [wrldParam, CL.PARAM(["const"], CL.charPtr, "s")],
150 :     CL.mkBlock[
151 :     CL.mkReturn(SOME(
152 :     CL.mkBinOp(CL.mkVar "DIDEROT_FAIL", CL.#==,
153 :     CL.mkApply(N.loadSeq elemTy, [
154 :     CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
155 :     CL.mkVar "s", CL.mkUnOp(CL.%&, global name)
156 :     ]))))
157 :     ]),
158 :     CL.D_Func(
159 :     [], CL.boolTy, N.inputSet(tgt, name),
160 :     [wrldParam, CL.PARAM([], nrrdPtrTy, "nin")],
161 :     CL.mkBlock[
162 :     CL.mkReturn(SOME(
163 :     CL.mkBinOp(CL.mkVar "DIDEROT_FAIL", CL.#==,
164 :     CL.mkApply(N.loadSeq elemTy, [
165 :     CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
166 :     CL.mkVar "nin", CL.mkUnOp(CL.%&, global name)
167 :     ]))))
168 :     ])
169 :     ]
170 :     *)
171 :     | Ty.DynSeqTy elemTy => raise Fail "dynamic input not supported yet"
172 : jhr 1820 | _ => [
173 :     CL.D_Func(
174 :     [], CL.boolTy, N.inputSet(tgt, name),
175 :     [wrldParam, CL.PARAM([], trType ty, "v")],
176 :     CL.mkBlock(
177 :     TrTy.copyFromC{ty=ty, dst=global name, src=CL.mkVar "v"} @
178 :     [CL.mkReturn(SOME(CL.mkVar "false"))]))
179 :     ]
180 :     (* end case *))
181 :     in
182 :     descDcl @ getDcl @ setDcl
183 :     end
184 :     in
185 :     List.foldr (fn (input, dcls) => mkInputDecls input @ dcls) [] inputs
186 :     end
187 :    
188 :     end

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