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

SCM Repository

[diderot] Annotation of /branches/vis15/src/compiler/cxx-util/output-util.sml
ViewVC logotype

Annotation of /branches/vis15/src/compiler/cxx-util/output-util.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3937 - (view) (download)

1 : jhr 3810 (* output-util.sml
2 :     *
3 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2015 The University of Chicago
6 :     * All rights reserved.
7 :     *
8 :     * Common code for output.
9 :     *)
10 :    
11 :     structure OutputUtil : sig
12 :    
13 : jhr 3912 type output_info = {
14 :     name : string, (* the variable's name *)
15 :     ty : APITypes.t, (* the variables API type *)
16 :     isGlobal : bool (* is the output a global variable? (always false for now) *)
17 :     }
18 :    
19 : jhr 3810 (* return information about the output type. This is a tuple
20 :     *
21 :     * (c-type, nrrd-type, nrrd-axis-kind, # elements)
22 :     *)
23 : jhr 3900 val infoOf : CodeGenEnv.t * APITypes.t -> (CLang.ty * NrrdEnums.ty * NrrdEnums.axis_kind * int)
24 : jhr 3810
25 : jhr 3900 (* code fragment to allocate nrrd data and check for errors *)
26 : jhr 3927 val maybeAlloc : CodeGenEnv.t * CLang.exp * CLang.var * int -> CLang.stm
27 : jhr 3810
28 : jhr 3912 (* gather the outputs of a program *)
29 :     val gatherOutputs : TreeIR.program -> output_info list
30 :    
31 : jhr 3810 (* generate code to register command-line options for redirecting the output in standalone
32 :     * executables. This function returns a list consisting of the global C variables that hold
33 :     * the option values and the registration function.
34 :     *)
35 : jhr 3912 val genRegisterOutputOpts : CodeGenEnv.t * output_info list -> CLang.decl list
36 : jhr 3810
37 : jhr 3917 (* generate the nrrd-file output and print functions used by standalone executables *)
38 : jhr 3912 val genOutput : CodeGenEnv.t * output_info list -> CLang.decl list
39 : jhr 3810
40 :     end = struct
41 :    
42 : jhr 3912 structure IR = TreeIR
43 : jhr 3900 structure Ty = APITypes
44 : jhr 3810 structure CL = CLang
45 : jhr 3900 structure Nrrd = NrrdEnums
46 :     structure Env = CodeGenEnv
47 : jhr 3906 structure RN = CxxNames
48 : jhr 3810
49 : jhr 3912 type output_info = {
50 :     name : string, (* the variable's name *)
51 :     ty : Ty.t, (* the variables API type *)
52 :     isGlobal : bool (* is the output a global variable? (always false for now) *)
53 :     }
54 :    
55 : jhr 3810 val nrrdPtrTy = CL.T_Ptr(CL.T_Named "Nrrd")
56 :     val filePtrTy = CL.T_Ptr(CL.T_Named "FILE")
57 :    
58 : jhr 3900 val outputGet = GenLibraryInterface.outputGet
59 :    
60 : jhr 3810 (* variables in the generated code *)
61 :     val wrldV = CL.mkVar "wrld"
62 :     val sizesV = CL.mkVar "sizes"
63 :     val nDataV = CL.mkVar "nData"
64 :     val nLengthsV = CL.mkVar "nLengths"
65 :     val NRRD = CL.mkVar "NRRD"
66 :     val msgV = CL.mkVar "msg"
67 :    
68 : jhr 3900 fun infoOf (env, ty) = (case ty
69 :     of Ty.IntTy => if #longint(Env.target env)
70 : jhr 3810 then (CL.int64, Nrrd.TypeLLong, Nrrd.KindScalar, 1)
71 :     else (CL.int32, Nrrd.TypeInt, Nrrd.KindScalar, 1)
72 : jhr 3900 | Ty.TensorTy [] => if #double(Env.target env)
73 : jhr 3810 then (CL.double, Nrrd.TypeDouble, Nrrd.KindScalar, 1)
74 :     else (CL.float, Nrrd.TypeFloat, Nrrd.KindScalar, 1)
75 :     | Ty.TensorTy dims => let
76 :     val (axisKind, nElems) = (case dims
77 :     of [2] => (Nrrd.Kind2Vector, 2)
78 :     | [3] => (Nrrd.Kind3Vector, 3)
79 :     | [4] => (Nrrd.Kind4Vector, 4)
80 :     | [2,2] => (Nrrd.Kind2DMatrix, 4)
81 :     | [3,3] => (Nrrd.Kind3DMatrix, 9)
82 :     | _ => (Nrrd.KindList, List.foldl Int.* 1 dims)
83 :     (* end case *))
84 :     in
85 : jhr 3900 if #double(Env.target env)
86 : jhr 3810 then (CL.double, Nrrd.TypeDouble, axisKind, nElems)
87 :     else (CL.float, Nrrd.TypeFloat, axisKind, nElems)
88 :     end
89 : jhr 3937 | Ty.SeqTy(ty, SOME n) => raise Fail "FIXME" (*let
90 : jhr 3810 val (elemTy, nrrdTy, dims) = infoOf (tgt, ty)
91 :     in
92 :     (elemTy, nrrdTy, n::dims)
93 :     end*)
94 :     | _ => raise Fail(concat["GetOutput.infoOf(", Ty.toString ty, ")"])
95 :     (* end case *))
96 :    
97 :     (* code fragment to allocate nrrd data and check for errors
98 :     if (nrrdMaybeAlloc_nva(<nrrdVar>, <nrrdType>, <nDims>, sizes) != 0) {
99 :     char *msg = biffGetDone(NRRD);
100 : jhr 3908 biffMsgAdd (wrld->_errors, msg);
101 : jhr 3900 std::free (msg);
102 : jhr 3810 return true;
103 :     }
104 :     *)
105 : jhr 3927 fun maybeAlloc (env, nrrdVar, nrrdType, nDims) =
106 : jhr 3810 CL.mkIfThen(
107 :     CL.mkBinOp(
108 :     CL.mkApply("nrrdMaybeAlloc_nva", [
109 :     nrrdVar, CL.mkVar nrrdType, CL.mkInt(IntInf.fromInt nDims), sizesV
110 :     ]),
111 :     CL.#!=,
112 :     CL.mkInt 0),
113 :     (* then *)
114 :     CL.mkBlock[
115 :     CL.mkDeclInit(CL.charPtr, "msg", CL.mkApply("biffGetDone", [NRRD])),
116 : jhr 3927 TreeToCxx.errorMsgAdd (env, msgV),
117 : jhr 3900 CL.mkCall("std::free", [msgV]),
118 : jhr 3810 CL.mkReturn(SOME(CL.mkVar "true"))
119 :     ]
120 :     (* endif*))
121 :    
122 : jhr 3912 fun gatherOutputs (IR.Program{strand=IR.Strand{state, ...}, ...}) = let
123 :     fun getOutput x = if TreeStateVar.isOutput x
124 :     then SOME{name = TreeStateVar.name x, ty = TreeStateVar.apiTy x, isGlobal = false}
125 :     else NONE
126 :     in
127 :     List.mapPartial getOutput state
128 :     end
129 :    
130 : jhr 3810 (* global variable names for output file/stems *)
131 :     val outfile = "Outfile"
132 :     fun outstem name = "OutStem_" ^ name
133 :    
134 :     (* generate code to register command-line options for redirecting the output in standalone
135 :     * executables.
136 :     *)
137 : jhr 3912 fun genRegisterOutputOpts (env, outputs : output_info list) = let
138 : jhr 3810 (* some common variables *)
139 :     val optsV = CL.mkVar "opts"
140 :     (* make a global variable declaration *)
141 : jhr 3917 fun mkDecl (name, value) =
142 :     CL.D_Var(["static"], CL.T_Named "std::string", name, SOME(CL.I_Exp(CL.mkStr value)))
143 : jhr 3810 (* register a flag for a given output *)
144 : jhr 3912 fun registerOutput {name, ty, isGlobal} = let
145 : jhr 3810 val optName = "redirect-" ^ name
146 :     in
147 : jhr 3917 CL.mkExpStm(CL.mkIndirectDispatch(optsV, "add", [
148 :     CL.mkStr(concat["o-", name, ",", "output-", name]),
149 : jhr 3810 CL.mkStr("specify output-file stem for " ^ name),
150 :     CL.mkUnOp(CL.%&, CL.mkVar(outstem name)),
151 :     CL.mkBool true
152 : jhr 3917 ]))
153 : jhr 3810 end
154 : jhr 3912 fun multi () = let
155 :     val stms = List.map registerOutput outputs
156 :     val dcls = List.map (fn {name, ...} => mkDecl (outstem name, name)) outputs
157 :     in
158 :     (stms, dcls)
159 :     end
160 : jhr 3810 val (stms, dcls) = (case outputs
161 : jhr 3912 of [{ty = Ty.SeqTy(_, NONE), ...}] => multi () (* two ouput files *)
162 :     | [{name, ...}] => let (* one output file, so use "-o" redirect option *)
163 : jhr 3917 val stm = CL.mkExpStm(CL.mkIndirectDispatch(optsV, "add", [
164 :     CL.mkStr "o,output", CL.mkStr("specify output-file file"),
165 : jhr 3810 CL.mkUnOp(CL.%&, CL.mkVar outfile),
166 :     CL.mkBool true
167 : jhr 3917 ]))
168 : jhr 3810 val dcl = mkDecl (outfile, name ^ ".nrrd")
169 :     in
170 :     ([stm], [dcl])
171 :     end
172 :     | _ => multi ()
173 :     (* end case *))
174 :     val registerFn = CL.D_Func(
175 : jhr 3900 ["static"], CL.voidTy, "register_outputs",
176 :     [CL.PARAM([], RN.optionsPtrTy env, "opts")],
177 : jhr 3810 CL.mkBlock stms)
178 :     in
179 :     dcls @ [registerFn]
180 :     end
181 :    
182 :     (* generate the nrrd-file output and print functions used by standalone executables *)
183 : jhr 3912 fun genOutput (env, outputs : output_info list) = let
184 : jhr 3900 val spec = Env.target env
185 :     fun isDyn ty = (case ty of Ty.SeqTy(_, NONE) => true | _ => false)
186 : jhr 3810 (* FIXME: use biffMsgAddF and return error status *)
187 : jhr 3900 fun error msg = CL.mkBlock[
188 :     CL.mkExpStm(List.foldl
189 :     (fn (e, lhs) => CL.mkBinOp(lhs, CL.#<<, e))
190 :     (CL.mkVar "std::cerr")
191 :     (msg @ [CL.mkVar "std::endl"])),
192 :     CL.mkCall("exit", [CL.mkInt 1])
193 :     ]
194 : jhr 3912 val outDecls = if List.exists (isDyn o #ty) outputs
195 : jhr 3810 then [CL.mkDecl(nrrdPtrTy, "nLengths", NONE), CL.mkDecl(nrrdPtrTy, "nData", NONE)]
196 :     else [CL.mkDecl(nrrdPtrTy, "nData", NONE)]
197 :     val prDecls = outDecls @ [CL.mkDecl(filePtrTy, "outS", NONE)]
198 :     fun nrrdNew v = CL.mkAssign(v, CL.mkApply("nrrdNew", []))
199 :     fun nrrdNuke v = CL.mkCall("nrrdNuke", [v])
200 :     val isMultiOutput = (case outputs
201 : jhr 3912 of [{ty, ...}] => isDyn ty
202 : jhr 3810 | _ => true
203 :     (* end case *))
204 : jhr 3912 fun writeNrrd {name, ty, isGlobal} = if isDyn ty
205 : jhr 3810 then [
206 :     nrrdNew (nLengthsV),
207 :     nrrdNew (nDataV),
208 :     CL.mkIfThenElse(
209 : jhr 3900 CL.mkApply(outputGet(spec, name), [wrldV, nLengthsV, nDataV]),
210 : jhr 3810 (* then *)
211 : jhr 3900 error [
212 :     CL.mkStr "Error getting nrrd data:\n",
213 : jhr 3917 CL.mkApply("biffMsgStrGet", [CL.mkIndirect(wrldV, "_errors")])
214 : jhr 3900 ],
215 : jhr 3810 (* else *)
216 :     CL.mkIfThen(
217 :     CL.mkBinOp(
218 :     CL.mkApply("NrrdSaveHelper", [
219 :     CL.mkVar(outstem name), CL.mkStr "-len", CL.mkStr "nrrd", nLengthsV
220 :     ]),
221 :     CL.#||,
222 :     CL.mkApply("NrrdSaveHelper", [
223 :     CL.mkVar(outstem name), CL.mkStr "-data", CL.mkStr "nrrd", nDataV
224 :     ])),
225 :     (* then *)
226 : jhr 3900 error [
227 :     CL.mkStr "Error saving nrrd:\n",
228 :     CL.mkApply("biffGetDone", [NRRD])
229 :     ]
230 : jhr 3810 (* endif *))
231 :     (* endif *)),
232 :     nrrdNuke nLengthsV,
233 :     nrrdNuke nDataV
234 :     ]
235 :     else if isMultiOutput
236 :     then [
237 :     nrrdNew (nDataV),
238 :     CL.mkIfThenElse(
239 : jhr 3900 CL.mkApply(outputGet(spec, name), [wrldV, nDataV]),
240 : jhr 3810 (* then *)
241 : jhr 3900 error [
242 :     CL.mkStr "Error getting nrrd data:\n",
243 : jhr 3917 CL.mkApply("biffMsgStrGet", [CL.mkIndirect(wrldV, "_errors")])
244 : jhr 3900 ],
245 : jhr 3810 (* else *)
246 :     CL.mkIfThen(
247 :     CL.mkApply("NrrdSaveHelper", [
248 :     CL.mkVar(outstem name), CL.mkStr "", CL.mkStr "nrrd", nDataV
249 :     ]),
250 :     (* then *)
251 : jhr 3900 error [
252 :     CL.mkStr "Error saving nrrd:\n",
253 :     CL.mkApply("biffGetDone", [NRRD])
254 :     ]
255 : jhr 3810 (* endif *))
256 :     (* endif *)),
257 :     nrrdNuke nDataV
258 :     ]
259 :     else [
260 :     nrrdNew (nDataV),
261 :     CL.mkIfThenElse(
262 : jhr 3900 CL.mkApply(outputGet(spec, name), [wrldV, nDataV]),
263 : jhr 3810 (* then *)
264 : jhr 3900 error [
265 :     CL.mkStr "Error getting nrrd data:\n",
266 : jhr 3917 CL.mkApply("biffMsgStrGet", [CL.mkIndirect(wrldV, "_errors")])
267 : jhr 3900 ],
268 : jhr 3810 (* else *)
269 :     CL.mkIfThen(
270 :     CL.mkApply("nrrdSave", [
271 : jhr 3917 CL.mkDispatch(CL.mkVar outfile, "c_str", []), nDataV, CL.mkVar "NULL"
272 : jhr 3810 ]),
273 :     (* then *)
274 : jhr 3900 error [
275 :     CL.mkStr "Error saving nrrd:\n%s\n",
276 :     CL.mkApply("biffGetDone", [NRRD])
277 :     ]
278 : jhr 3810 (* endif *))
279 :     (* endif *)),
280 :     nrrdNuke nDataV
281 :     ]
282 :     in [
283 : jhr 3900 CL.D_Func(
284 :     ["static"], CL.voidTy, "write_output",
285 :     [CL.PARAM([], RN.worldPtrTy, "wrld")],
286 : jhr 3810 CL.mkBlock(outDecls @ List.foldr (fn (output, l) => writeNrrd output @ l) [] outputs))
287 :     ] end
288 :    
289 :     end

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