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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2719 - (view) (download)

1 : jhr 2708 (* output-util.sml
2 :     *
3 :     * COPYRIGHT (c) 2014 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *
6 :     * Common code for output.
7 :     *)
8 :    
9 :     structure OutputUtil : sig
10 :    
11 : jhr 2719 (* return information about the output type. This is a tuple
12 :     *
13 :     * (c-type, nrrd-type, nrrd-axis-kind, # elements)
14 :     *)
15 :     val infoOf : Properties.props * TreeIL.Ty.ty -> (CLang.ty * NrrdEnums.ty * NrrdEnums.axis_kind * int)
16 :    
17 :     (* code fragment to allocate nrrd data and check for errors
18 :     if (nrrdMaybeAlloc_nva(<nrrdVar>, <nrrdType>, <nDims>, sizes) != 0) {
19 :     char *msg = biffGetDone(NRRD);
20 :     biffMsgAdd (wrld->errors, msg);
21 :     FREE (msg);
22 :     return true;
23 :     }
24 :     *)
25 :     val maybeAlloc : CLang.exp * CLang.var * int -> CLang.stm
26 :    
27 : jhr 2708 val genOutput : Properties.props * (TreeIL.Ty.ty * string) list -> CLang.decl list
28 :    
29 :     end = struct
30 :    
31 :     structure Ty = TreeIL.Ty
32 :     structure CL = CLang
33 :     structure N = CNames
34 : jhr 2719 structure Nrrd = NrrdEnums
35 : jhr 2708
36 :     val nrrdPtrTy = CL.T_Ptr(CL.T_Named "Nrrd")
37 :     val filePtrTy = CL.T_Ptr(CL.T_Named "FILE")
38 :    
39 :     (* variables in the generated code *)
40 :     val wrldV = CL.mkVar "wrld"
41 : jhr 2719 val sizesV = CL.mkVar "sizes"
42 : jhr 2708 val nDataV = CL.mkVar "nData"
43 :     val nLengthsV = CL.mkVar "nLengths"
44 :     val NRRD = CL.mkVar "NRRD"
45 : jhr 2719 val msgV = CL.mkVar "msg"
46 : jhr 2708
47 :     fun wrldPtr tgt = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
48 :    
49 : jhr 2719 fun infoOf (tgt : Properties.props, ty) = (case ty
50 :     of Ty.IntTy => if #longint tgt
51 :     then (CL.int64, Nrrd.TypeLLong, Nrrd.KindScalar, 1)
52 :     else (CL.int32, Nrrd.TypeInt, Nrrd.KindScalar, 1)
53 :     | Ty.TensorTy [] => if #double tgt
54 :     then (CL.double, Nrrd.TypeDouble, Nrrd.KindScalar, 1)
55 :     else (CL.float, Nrrd.TypeFloat, Nrrd.KindScalar, 1)
56 :     | Ty.TensorTy dims => let
57 :     val (axisKind, nElems) = (case dims
58 :     of [2] => (Nrrd.Kind2Vector, 2)
59 :     | [3] => (Nrrd.Kind3Vector, 3)
60 :     | [4] => (Nrrd.Kind4Vector, 4)
61 :     | [2,2] => (Nrrd.Kind2DMatrix, 4)
62 :     | [3,3] => (Nrrd.Kind3DMatrix, 9)
63 :     | _ => (Nrrd.KindList, List.foldl Int.* 1 dims)
64 :     (* end case *))
65 :     in
66 :     if #double tgt
67 :     then (CL.double, Nrrd.TypeDouble, axisKind, nElems)
68 :     else (CL.float, Nrrd.TypeFloat, axisKind, nElems)
69 :     end
70 :     | Ty.SeqTy(ty, n) => raise Fail "FIXME" (*let
71 :     val (elemTy, nrrdTy, dims) = infoOf (tgt, ty)
72 :     in
73 :     (elemTy, nrrdTy, n::dims)
74 :     end*)
75 :     | _ => raise Fail(concat["GetOutput.infoOf(", Ty.toString ty, ")"])
76 :     (* end case *))
77 :    
78 :     (* code fragment to allocate nrrd data and check for errors
79 :     if (nrrdMaybeAlloc_nva(<nrrdVar>, <nrrdType>, <nDims>, sizes) != 0) {
80 :     char *msg = biffGetDone(NRRD);
81 :     biffMsgAdd (wrld->errors, msg);
82 :     FREE (msg);
83 :     return true;
84 :     }
85 :     *)
86 :     fun maybeAlloc (nrrdVar, nrrdType, nDims) =
87 :     CL.mkIfThen(
88 :     CL.mkBinOp(
89 :     CL.mkApply("nrrdMaybeAlloc_nva", [
90 :     nrrdVar, CL.mkVar nrrdType, CL.mkInt(IntInf.fromInt nDims), sizesV
91 :     ]),
92 :     CL.#!=,
93 :     CL.mkInt 0),
94 :     (* then *)
95 :     CL.mkBlock[
96 :     CL.mkDeclInit(CL.charPtr, "msg", CL.mkApply("biffGetDone", [NRRD])),
97 :     World.errorMsgAdd msgV,
98 :     CL.mkCall("FREE", [msgV]),
99 :     CL.mkReturn(SOME(CL.mkVar "true"))
100 :     ]
101 :     (* endif*))
102 :    
103 : jhr 2708 (* generate the nrrd-file output and print functions used by standalone executables *)
104 :     fun genOutput (tgt : Properties.props, outputs) = let
105 :     fun isDyn ty = (case ty of Ty.DynSeqTy _ => true | _ => false)
106 :     (* FIXME: use biffMsgAddF and return error status *)
107 :     fun error (fmt, msg) = CL.mkBlock[
108 :     CL.mkCall("fprintf", [CL.mkVar "stderr", CL.mkStr fmt, msg]),
109 :     CL.mkCall("exit", [CL.mkInt 1])
110 :     ]
111 :     val outDecls = if List.exists (isDyn o #1) outputs
112 :     then [CL.mkDecl(nrrdPtrTy, "nLengths", NONE), CL.mkDecl(nrrdPtrTy, "nData", NONE)]
113 :     else [CL.mkDecl(nrrdPtrTy, "nData", NONE)]
114 :     val prDecls = outDecls @ [CL.mkDecl(filePtrTy, "outS", NONE)]
115 :     fun nrrdNew v = CL.mkAssign(v, CL.mkApply("nrrdNew", []))
116 :     fun nrrdNuke v = CL.mkCall("nrrdNuke", [v])
117 :     fun writeNrrd (ty, name) =
118 :     if isDyn ty
119 :     then [
120 :     nrrdNew (nLengthsV),
121 :     nrrdNew (nDataV),
122 :     CL.mkIfThenElse(
123 :     CL.mkApply(N.outputGet(tgt, name), [wrldV, nLengthsV, nDataV]),
124 :     (* then *)
125 :     error ("Error getting nrrd data:\n%s\n",
126 :     CL.mkApply("biffMsgStrGet", [CL.mkIndirect(wrldV, "errors")])),
127 :     (* else *)
128 :     CL.mkIfThen(
129 :     CL.mkBinOp(
130 :     CL.mkApply("nrrdSave", [
131 :     CL.mkStr(OS.Path.joinBaseExt{base=name^"-len", ext=SOME "nrrd"}),
132 :     nLengthsV, CL.mkVar "NULL"
133 :     ]),
134 :     CL.#||,
135 :     CL.mkApply("nrrdSave", [
136 :     CL.mkStr(OS.Path.joinBaseExt{base=name^"-data", ext=SOME "nrrd"}),
137 :     nDataV, CL.mkVar "NULL"
138 :     ])),
139 :     (* then *)
140 :     error ("Error saving nrrd:\n%s\n", CL.mkApply("biffGetDone", [NRRD]))
141 :     (* endif *))
142 :     (* endif *)),
143 :     nrrdNuke nLengthsV,
144 :     nrrdNuke nDataV
145 :     ]
146 :     else [
147 :     nrrdNew (nDataV),
148 :     CL.mkIfThenElse(
149 :     CL.mkApply(N.outputGet(tgt, name), [wrldV, nDataV]),
150 :     (* then *)
151 :     error ("Error getting nrrd data:\n%s\n",
152 :     CL.mkApply("biffMsgStrGet", [CL.mkIndirect(wrldV, "errors")])),
153 :     (* else *)
154 :     CL.mkIfThen(
155 :     CL.mkApply("nrrdSave", [
156 :     CL.mkStr(OS.Path.joinBaseExt{base=name, ext=SOME "nrrd"}),
157 :     nDataV, CL.mkVar "NULL"
158 :     ]),
159 :     (* then *)
160 :     error ("Error saving nrrd:\n%s\n", CL.mkApply("biffGetDone", [NRRD]))
161 :     (* endif *))
162 :     (* endif *)),
163 :     nrrdNuke nDataV
164 :     ]
165 :     fun printNrrd (ty, name) = [] (* FIXME *)
166 :     in [
167 :     CL.D_Func(["static"], CL.voidTy, "WriteOutput", [CL.PARAM([], wrldPtr tgt, "wrld")],
168 :     CL.mkBlock(outDecls @ List.foldr (fn (output, l) => writeNrrd output @ l) [] outputs)),
169 :     CL.D_Func(["static"], CL.voidTy, "PrintOutput", [CL.PARAM([], wrldPtr tgt, "wrld")],
170 :     CL.mkBlock(prDecls @ List.foldr (fn (output, l) => printNrrd output @ l) [] outputs))
171 :     ] end
172 : jhr 2719
173 : jhr 2708 end

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