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/gen-outputs-util.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4028 - (view) (download)

1 : jhr 3990 (* gen-outputs-util.sml
2 : jhr 3810 *
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 : jhr 3990 * Target-independent code for generating the output code.
9 : jhr 3810 *)
10 :    
11 : jhr 3990 structure GenOutputsUtil : sig
12 : jhr 3810
13 : jhr 3990 type output_info = OutputUtil.output_info
14 : jhr 3912
15 : jhr 3900 (* code fragment to allocate nrrd data and check for errors *)
16 : jhr 3927 val maybeAlloc : CodeGenEnv.t * CLang.exp * CLang.var * int -> CLang.stm
17 : jhr 3810
18 :     (* generate code to register command-line options for redirecting the output in standalone
19 :     * executables. This function returns a list consisting of the global C variables that hold
20 :     * the option values and the registration function.
21 :     *)
22 : jhr 3912 val genRegisterOutputOpts : CodeGenEnv.t * output_info list -> CLang.decl list
23 : jhr 3810
24 : jhr 3917 (* generate the nrrd-file output and print functions used by standalone executables *)
25 : jhr 3912 val genOutput : CodeGenEnv.t * output_info list -> CLang.decl list
26 : jhr 3810
27 :     end = struct
28 :    
29 : jhr 3900 structure Ty = APITypes
30 : jhr 3810 structure CL = CLang
31 : jhr 3900 structure Env = CodeGenEnv
32 : jhr 3906 structure RN = CxxNames
33 : jhr 3810
34 : jhr 3990 type output_info = OutputUtil.output_info
35 : jhr 3912
36 : jhr 3810 val nrrdPtrTy = CL.T_Ptr(CL.T_Named "Nrrd")
37 :     val filePtrTy = CL.T_Ptr(CL.T_Named "FILE")
38 :    
39 : jhr 3900 val outputGet = GenLibraryInterface.outputGet
40 :    
41 : jhr 3810 (* variables in the generated code *)
42 :     val wrldV = CL.mkVar "wrld"
43 :     val sizesV = CL.mkVar "sizes"
44 :     val nDataV = CL.mkVar "nData"
45 :     val nLengthsV = CL.mkVar "nLengths"
46 :     val NRRD = CL.mkVar "NRRD"
47 :     val msgV = CL.mkVar "msg"
48 :    
49 :     (* code fragment to allocate nrrd data and check for errors
50 :     if (nrrdMaybeAlloc_nva(<nrrdVar>, <nrrdType>, <nDims>, sizes) != 0) {
51 :     char *msg = biffGetDone(NRRD);
52 : jhr 3908 biffMsgAdd (wrld->_errors, msg);
53 : jhr 3900 std::free (msg);
54 : jhr 3810 return true;
55 :     }
56 :     *)
57 : jhr 3927 fun maybeAlloc (env, nrrdVar, nrrdType, nDims) =
58 : jhr 3810 CL.mkIfThen(
59 :     CL.mkBinOp(
60 :     CL.mkApply("nrrdMaybeAlloc_nva", [
61 :     nrrdVar, CL.mkVar nrrdType, CL.mkInt(IntInf.fromInt nDims), sizesV
62 :     ]),
63 :     CL.#!=,
64 :     CL.mkInt 0),
65 :     (* then *)
66 :     CL.mkBlock[
67 :     CL.mkDeclInit(CL.charPtr, "msg", CL.mkApply("biffGetDone", [NRRD])),
68 : jhr 3927 TreeToCxx.errorMsgAdd (env, msgV),
69 : jhr 3900 CL.mkCall("std::free", [msgV]),
70 : jhr 3810 CL.mkReturn(SOME(CL.mkVar "true"))
71 :     ]
72 :     (* endif*))
73 :    
74 :     (* global variable names for output file/stems *)
75 :     val outfile = "Outfile"
76 :     fun outstem name = "OutStem_" ^ name
77 :    
78 :     (* generate code to register command-line options for redirecting the output in standalone
79 :     * executables.
80 :     *)
81 : jhr 3912 fun genRegisterOutputOpts (env, outputs : output_info list) = let
82 : jhr 3810 (* some common variables *)
83 :     val optsV = CL.mkVar "opts"
84 :     (* make a global variable declaration *)
85 : jhr 3917 fun mkDecl (name, value) =
86 : jhr 4028 CL.D_Var(["static"], CL.T_Named "std::string", [], name,
87 :     SOME(CL.I_Exp(CL.mkStr value)))
88 : jhr 3810 (* register a flag for a given output *)
89 : jhr 3912 fun registerOutput {name, ty, isGlobal} = let
90 : jhr 3810 val optName = "redirect-" ^ name
91 :     in
92 : jhr 3917 CL.mkExpStm(CL.mkIndirectDispatch(optsV, "add", [
93 :     CL.mkStr(concat["o-", name, ",", "output-", name]),
94 : jhr 3810 CL.mkStr("specify output-file stem for " ^ name),
95 :     CL.mkUnOp(CL.%&, CL.mkVar(outstem name)),
96 :     CL.mkBool true
97 : jhr 3917 ]))
98 : jhr 3810 end
99 : jhr 3912 fun multi () = let
100 :     val stms = List.map registerOutput outputs
101 :     val dcls = List.map (fn {name, ...} => mkDecl (outstem name, name)) outputs
102 :     in
103 :     (stms, dcls)
104 :     end
105 : jhr 3810 val (stms, dcls) = (case outputs
106 : jhr 3912 of [{ty = Ty.SeqTy(_, NONE), ...}] => multi () (* two ouput files *)
107 :     | [{name, ...}] => let (* one output file, so use "-o" redirect option *)
108 : jhr 3917 val stm = CL.mkExpStm(CL.mkIndirectDispatch(optsV, "add", [
109 :     CL.mkStr "o,output", CL.mkStr("specify output-file file"),
110 : jhr 3810 CL.mkUnOp(CL.%&, CL.mkVar outfile),
111 :     CL.mkBool true
112 : jhr 3917 ]))
113 : jhr 3810 val dcl = mkDecl (outfile, name ^ ".nrrd")
114 :     in
115 :     ([stm], [dcl])
116 :     end
117 :     | _ => multi ()
118 :     (* end case *))
119 :     val registerFn = CL.D_Func(
120 : jhr 4028 ["static"], CL.voidTy, [], "register_outputs",
121 : jhr 3900 [CL.PARAM([], RN.optionsPtrTy env, "opts")],
122 : jhr 3810 CL.mkBlock stms)
123 :     in
124 :     dcls @ [registerFn]
125 :     end
126 :    
127 :     (* generate the nrrd-file output and print functions used by standalone executables *)
128 : jhr 3912 fun genOutput (env, outputs : output_info list) = let
129 : jhr 3900 val spec = Env.target env
130 :     fun isDyn ty = (case ty of Ty.SeqTy(_, NONE) => true | _ => false)
131 : jhr 3810 (* FIXME: use biffMsgAddF and return error status *)
132 : jhr 3900 fun error msg = CL.mkBlock[
133 :     CL.mkExpStm(List.foldl
134 :     (fn (e, lhs) => CL.mkBinOp(lhs, CL.#<<, e))
135 :     (CL.mkVar "std::cerr")
136 :     (msg @ [CL.mkVar "std::endl"])),
137 :     CL.mkCall("exit", [CL.mkInt 1])
138 :     ]
139 : jhr 3912 val outDecls = if List.exists (isDyn o #ty) outputs
140 : jhr 3810 then [CL.mkDecl(nrrdPtrTy, "nLengths", NONE), CL.mkDecl(nrrdPtrTy, "nData", NONE)]
141 :     else [CL.mkDecl(nrrdPtrTy, "nData", NONE)]
142 :     val prDecls = outDecls @ [CL.mkDecl(filePtrTy, "outS", NONE)]
143 :     fun nrrdNew v = CL.mkAssign(v, CL.mkApply("nrrdNew", []))
144 :     fun nrrdNuke v = CL.mkCall("nrrdNuke", [v])
145 :     val isMultiOutput = (case outputs
146 : jhr 3912 of [{ty, ...}] => isDyn ty
147 : jhr 3810 | _ => true
148 :     (* end case *))
149 : jhr 3912 fun writeNrrd {name, ty, isGlobal} = if isDyn ty
150 : jhr 3810 then [
151 :     nrrdNew (nLengthsV),
152 :     nrrdNew (nDataV),
153 :     CL.mkIfThenElse(
154 : jhr 3900 CL.mkApply(outputGet(spec, name), [wrldV, nLengthsV, nDataV]),
155 : jhr 3810 (* then *)
156 : jhr 3900 error [
157 :     CL.mkStr "Error getting nrrd data:\n",
158 : jhr 3917 CL.mkApply("biffMsgStrGet", [CL.mkIndirect(wrldV, "_errors")])
159 : jhr 3900 ],
160 : jhr 3810 (* else *)
161 :     CL.mkIfThen(
162 :     CL.mkBinOp(
163 :     CL.mkApply("NrrdSaveHelper", [
164 :     CL.mkVar(outstem name), CL.mkStr "-len", CL.mkStr "nrrd", nLengthsV
165 :     ]),
166 :     CL.#||,
167 :     CL.mkApply("NrrdSaveHelper", [
168 :     CL.mkVar(outstem name), CL.mkStr "-data", CL.mkStr "nrrd", nDataV
169 :     ])),
170 :     (* then *)
171 : jhr 3900 error [
172 :     CL.mkStr "Error saving nrrd:\n",
173 :     CL.mkApply("biffGetDone", [NRRD])
174 :     ]
175 : jhr 3810 (* endif *))
176 :     (* endif *)),
177 :     nrrdNuke nLengthsV,
178 :     nrrdNuke nDataV
179 :     ]
180 :     else if isMultiOutput
181 :     then [
182 :     nrrdNew (nDataV),
183 :     CL.mkIfThenElse(
184 : jhr 3900 CL.mkApply(outputGet(spec, name), [wrldV, nDataV]),
185 : jhr 3810 (* then *)
186 : jhr 3900 error [
187 :     CL.mkStr "Error getting nrrd data:\n",
188 : jhr 3917 CL.mkApply("biffMsgStrGet", [CL.mkIndirect(wrldV, "_errors")])
189 : jhr 3900 ],
190 : jhr 3810 (* else *)
191 :     CL.mkIfThen(
192 :     CL.mkApply("NrrdSaveHelper", [
193 :     CL.mkVar(outstem name), CL.mkStr "", CL.mkStr "nrrd", nDataV
194 :     ]),
195 :     (* then *)
196 : jhr 3900 error [
197 :     CL.mkStr "Error saving nrrd:\n",
198 :     CL.mkApply("biffGetDone", [NRRD])
199 :     ]
200 : jhr 3810 (* endif *))
201 :     (* endif *)),
202 :     nrrdNuke nDataV
203 :     ]
204 :     else [
205 :     nrrdNew (nDataV),
206 :     CL.mkIfThenElse(
207 : jhr 3900 CL.mkApply(outputGet(spec, name), [wrldV, nDataV]),
208 : jhr 3810 (* then *)
209 : jhr 3900 error [
210 :     CL.mkStr "Error getting nrrd data:\n",
211 : jhr 3917 CL.mkApply("biffMsgStrGet", [CL.mkIndirect(wrldV, "_errors")])
212 : jhr 3900 ],
213 : jhr 3810 (* else *)
214 :     CL.mkIfThen(
215 :     CL.mkApply("nrrdSave", [
216 : jhr 3917 CL.mkDispatch(CL.mkVar outfile, "c_str", []), nDataV, CL.mkVar "NULL"
217 : jhr 3810 ]),
218 :     (* then *)
219 : jhr 3900 error [
220 : jhr 3956 CL.mkStr "Error saving nrrd:\n",
221 : jhr 3900 CL.mkApply("biffGetDone", [NRRD])
222 :     ]
223 : jhr 3810 (* endif *))
224 :     (* endif *)),
225 :     nrrdNuke nDataV
226 :     ]
227 :     in [
228 : jhr 3900 CL.D_Func(
229 : jhr 4028 ["static"], CL.voidTy, [], "write_output",
230 : jhr 3900 [CL.PARAM([], RN.worldPtrTy, "wrld")],
231 : jhr 3810 CL.mkBlock(outDecls @ List.foldr (fn (output, l) => writeNrrd output @ l) [] outputs))
232 :     ] end
233 :    
234 :     end

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