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

SCM Repository

[diderot] Annotation of /trunk/src/compiler/cl-target/print-as-cl.sml
ViewVC logotype

Annotation of /trunk/src/compiler/cl-target/print-as-cl.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1444 - (view) (download)

1 : jhr 1117 (* print-as-cl.sml
2 :     *
3 :     * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *
6 :     * Print the CLang representation using OpenCL syntax.
7 :     *)
8 :    
9 :     structure PrintAsCL : sig
10 :    
11 :     type strm
12 :    
13 :     val new : TextIO.outstream -> strm
14 :    
15 :     val close : strm -> unit
16 :    
17 :     val output : strm * CLang.decl -> unit
18 :    
19 :     end = struct
20 :    
21 :     structure CL = CLang
22 :     structure PP = TextIOPP
23 :    
24 :     type strm = PP.stream
25 :    
26 : jhr 1380 val indent = (PP.Abs 4) (* standard indentation amount *)
27 : jhr 1117
28 :     fun new outs = PP.openOut {dst = outs, wid = 90}
29 :    
30 :     val close = PP.closeStream
31 :    
32 :     fun output (strm, decl) = let
33 : jhr 1380 val str = PP.string strm
34 :     fun sp () = PP.space strm 1
35 :     fun inHBox f = (PP.openHBox strm; f(); PP.closeBox strm)
36 :     fun ppComLn s = (
37 :     inHBox (fn () => (str "// "; str s));
38 :     PP.newline strm)
39 :     fun ppList {pp, sep, l} = let
40 :     fun ppList' [] = ()
41 :     | ppList' [x] = pp x
42 :     | ppList' (x::xs) = (pp x; sep(); ppList' xs)
43 :     in
44 :     ppList' l
45 :     end
46 :     fun ppTy (ty, optVar) = let
47 :     fun getBaseTy (CL.T_Ptr ty) = getBaseTy ty
48 :     | getBaseTy (CL.T_Array(ty, _)) = getBaseTy ty
49 :     | getBaseTy (CL.T_Num rty) = (case rty
50 :     of RawTypes.RT_Int8 => "char"
51 :     | RawTypes.RT_UInt8 => "uchar"
52 :     | RawTypes.RT_Int16 => "short"
53 :     | RawTypes.RT_UInt16 => "ushort"
54 :     | RawTypes.RT_Int32 => "int"
55 :     | RawTypes.RT_UInt32 => "uint"
56 :     | RawTypes.RT_Int64 => "long"
57 :     | RawTypes.RT_UInt64 => "ulong"
58 :     | RawTypes.RT_Float => "float"
59 :     | RawTypes.RT_Double => "double" (* only if 64-bitFP extension is supported *)
60 :     (* end case *))
61 :     | getBaseTy (CL.T_Named ty) = ty
62 : jhr 1444 | getBaseTy (CL.T_Qual(attr, ty)) =
63 :     concat[attr, " ", getBaseTy ty]
64 : jhr 1380 fun pp (isFirst, CL.T_Ptr ty, optVar) = (
65 :     if isFirst then sp() else ();
66 :     case ty
67 :     of CL.T_Array _ => (
68 :     str "(*"; pp(false, ty, optVar); str ")")
69 :     | _ => (str "*"; pp(false, ty, optVar))
70 :     (* end case *))
71 :     | pp (isFirst, CL.T_Array(ty, optN), optVar) = (
72 :     pp (isFirst, ty, optVar);
73 :     case optN
74 :     of NONE => str "[]"
75 :     | SOME n => (str "["; str(Int.toString n); str "]")
76 :     (* end case *))
77 : jhr 1444 | pp (isFirst, CL.T_Qual(_, ty), optVar) =
78 :     pp (isFirst, ty, optVar)
79 : jhr 1380 | pp (isFirst, _, SOME x) = (
80 :     if isFirst then sp() else ();
81 :     str x)
82 :     | pp (_, _, NONE) = ()
83 :     in
84 :     str (getBaseTy ty);
85 :     pp (true, ty, optVar)
86 :     end
87 :     fun ppAttrs [] = ()
88 :     | ppAttrs attrs = (
89 :     ppList {pp=str, sep=sp, l = attrs};
90 :     sp())
91 :     fun ppDecl dcl = (case dcl
92 :     of CL.D_Comment l => List.app ppComLn l
93 :     | CL.D_Verbatim l =>
94 :     List.app (fn s => (str s; PP.newline strm)) l
95 :     | CL.D_Var(attrs, ty, x, optInit) => (
96 :     inHBox (fn () => (
97 :     ppAttrs attrs;
98 :     ppTy (ty, SOME x);
99 :     case optInit
100 :     of SOME init => (sp(); str "="; sp(); ppInit init)
101 :     | NONE => ()
102 :     (* end case *);
103 :     str ";"));
104 :     PP.newline strm)
105 :     | CL.D_Func(attrs, ty, f, params, body) => (
106 :     inHBox (fn () => (
107 :     ppAttrs attrs;
108 :     ppTy(ty, SOME f);
109 :     sp(); str "(";
110 :     ppList {pp=ppParam, sep=fn () => (str ","; sp()), l=params};
111 :     str ")"));
112 :     PP.newline strm;
113 :     ppBlock (case body of CL.S_Block stms => stms | stm => [stm]))
114 :     | CL.D_StructDef(fields, tyName) => (
115 :     str "typedef struct {";
116 :     PP.openVBox strm indent;
117 :     List.app (fn (ty, x) => (
118 :     PP.newline strm;
119 :     inHBox (fn () => (ppTy(ty, SOME x); str ";"))))
120 :     fields;
121 :     PP.closeBox strm;
122 :     PP.newline strm;
123 :     inHBox (fn () => (str "}"; sp(); str tyName; str ";"));
124 :     PP.newline strm)
125 :     (* end case *))
126 :     and ppParam (CL.PARAM(attrs, ty, x)) = (
127 :     ppAttrs attrs;
128 :     ppTy(ty, SOME(CL.varToString x)))
129 :     and ppInit init = (case init
130 :     of CL.I_Exp e => ppExp e
131 :     | CL.I_Struct fields => (
132 :     str "{";
133 :     PP.openHVBox strm indent;
134 :     List.app (fn (lab, init) => (
135 :     PP.break strm;
136 :     inHBox (fn () => (
137 :     str("." ^ lab); sp(); str "="; sp(); ppInit init; str ","))))
138 :     fields;
139 :     PP.closeBox strm;
140 :     str "}")
141 :     | CL.I_Array elems => (
142 :     str "{";
143 :     PP.openHVBox strm indent;
144 :     List.app (fn (i, init) => (
145 :     PP.break strm;
146 :     inHBox (fn () => (
147 :     str(concat["[", Int.toString i, "]"]); sp(); str "="; sp();
148 :     ppInit init; str ","))))
149 :     elems;
150 :     PP.closeBox strm;
151 :     str "}")
152 :     (* end case *))
153 :     and ppBlock stms = (
154 :     str "{";
155 :     PP.openVBox strm indent;
156 :     PP.newline strm;
157 :     List.app ppStm stms;
158 :     PP.closeBox strm;
159 :     str "}"; PP.newline strm)
160 :     and ppStm stm = (case stm
161 :     of CL.S_Block stms => ppBlock stms
162 :     | CL.S_Comment l => List.app ppComLn l
163 :     | CL.S_Decl(attrs, ty, x, NONE) => (
164 :     inHBox (fn () => (
165 :     ppAttrs attrs;
166 :     ppTy(ty, SOME x); str ";"));
167 :     PP.newline strm)
168 :     | CL.S_Decl(attrs,ty, x, SOME e) => (
169 :     inHBox (fn () => (
170 :     ppAttrs attrs;
171 :     ppTy(ty, SOME x); sp(); str "="; sp(); ppInit e; str ";"));
172 :     PP.newline strm)
173 :     | CL.S_Exp e => (
174 :     inHBox (fn () => (ppExp e; str ";"));
175 :     PP.newline strm)
176 :     | CL.S_If(e, blk, CL.S_Block[]) =>
177 :     inHBox (fn () => (str "if"; sp(); ppExp e; ppStms blk))
178 :     | CL.S_If(e, blk1, blk2) => (
179 :     inHBox (fn () => (str "if"; sp(); ppExp e)); ppStms blk1;
180 :     str "else"; ppStms blk2)
181 :     | CL.S_While(e, blk) => (
182 :     inHBox (fn () => (str "while"; sp(); ppExp e)); ppStms blk)
183 : jhr 1444 | CL.S_DoWhile(blk, e) => (
184 :     str "do"; sp(); ppStms blk;
185 :     inHBox (fn () => (str "while"; sp(); ppExp e)))
186 : jhr 1380 | CL.S_For(inits, cond, incrs, blk) => let
187 :     fun ppInit (ty, x, e) = inHBox (fn () => (
188 :     ppTy(ty, SOME x);
189 :     sp(); str "="; sp();
190 :     ppExp e))
191 :     in
192 :     inHBox (fn () => (
193 :     str "for"; sp(); str "(";
194 :     ppList {pp = ppInit, sep = fn () => str ",", l = inits};
195 :     str ";"; sp();
196 :     ppExp cond; str ";"; sp();
197 :     ppList {pp = ppExp, sep = fn () => str ",", l = incrs}));
198 :     str ")";
199 :     ppStms blk
200 :     end
201 :     | CL.S_Call(f, args) => (
202 :     inHBox (fn () => (str f; ppArgs args; str ";"));
203 :     PP.newline strm)
204 :     | CL.S_Return(SOME e) => (
205 :     inHBox (fn () => (str "return"; sp(); ppExp e; str ";"));
206 :     PP.newline strm)
207 :     | CL.S_Return _ => (str "return;"; PP.newline strm)
208 :     | CL.S_Break => (str "break;"; PP.newline strm)
209 :     | CL.S_Continue => (str "continue;"; PP.newline strm)
210 :     (* end case *))
211 :     and ppStms (CL.S_Block stms) = (sp(); ppBlock stms)
212 :     | ppStms stm = (
213 :     PP.openVBox strm indent;
214 :     PP.newline strm;
215 :     ppStm stm;
216 :     PP.closeBox strm)
217 :     and ppExp e = (case e
218 :     of CL.E_Grp e => (str "("; ppExp e; str ")")
219 :     | CL.E_AssignOp(lhs, rator, rhs) => (
220 :     ppExp lhs; sp(); str(CL.assignopToString rator); sp(); ppExp rhs)
221 :     | CL.E_BinOp(e1, rator, e2) => (ppExp e1; str(CL.binopToString rator); ppExp e2)
222 :     | CL.E_UnOp(rator, e) => (str(CL.unopToString rator); ppExp e)
223 :     | CL.E_PostOp(e, rator) => (ppExp e; str(CL.postopToString rator))
224 :     | CL.E_Apply(f, args) => (str f; ppArgs args)
225 :     | CL.E_Subscript(e1, e2) => (ppExp e1; str "["; ppExp e2; str "]")
226 :     | CL.E_Select(e, f) => (ppExp e; str "."; str f)
227 :     | CL.E_Indirect(e, f) => (ppExp e; str "->"; str f)
228 :     | CL.E_Cast(ty, e) => (
229 :     str "("; ppTy(ty, NONE); str ")"; ppExp e)
230 :     | CL.E_Var x => str(CL.varToString x)
231 :     | CL.E_Int(n, CL.T_Num(RawTypes.RT_Int64)) =>
232 :     str(IntegerLit.toString n ^ "l")
233 :     | CL.E_Int(n, _) => str(IntegerLit.toString n)
234 :     | CL.E_Flt(f, ty) => let
235 :     val isDouble = (case ty
236 :     of CL.T_Num(RawTypes.RT_Float) => false
237 :     | _ => true
238 :     (* end case *))
239 :     (* NOTE: the CLang.mkFlt function guarantees that f is non-negative *)
240 :     val f = if FloatLit.same(FloatLit.posInf, f)
241 :     then if isDouble
242 :     then "HUGE_VAL"
243 :     else "HUGE_VALF"
244 :     else if FloatLit.same(FloatLit.nan, f)
245 : jhr 1444 then "nan((uint)0)"
246 : jhr 1380 else if isDouble
247 :     then FloatLit.toString f
248 :     else FloatLit.toString f ^ "f"
249 :     in
250 :     str f
251 :     end
252 :     | CL.E_Bool b => str(Bool.toString b)
253 :     | CL.E_Str s => str(concat["\"", String.toCString s, "\""])
254 :     | CL.E_Sizeof ty => (str "sizeof("; ppTy(ty, NONE); str ")")
255 :     (* end case *))
256 :     and ppArgs args = (
257 :     str "(";
258 :     PP.openHOVBox strm indent;
259 :     PP.cut strm;
260 :     ppList {
261 :     pp = fn e => (PP.openHBox strm; ppExp e; PP.closeBox strm),
262 :     sep = fn () => (str ","; sp()),
263 :     l = args
264 :     };
265 :     str ")";
266 :     PP.closeBox strm)
267 :     in
268 :     ppDecl decl
269 :     end
270 : jhr 1117
271 :     end

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