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/print-as-cxx.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3989 - (view) (download)

1 : jhr 3871 (* print-as-cxx.sml
2 :     *
3 :     * Print CLang syntax trees using C++ syntax.
4 :     *
5 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
6 :     *
7 :     * COPYRIGHT (c) 2016 The University of Chicago
8 :     * All rights reserved.
9 :     *)
10 :    
11 :     structure PrintAsCxx : sig
12 :    
13 : jhr 3905 val output : TextIOPP.stream * CLang.decl -> unit
14 : jhr 3871
15 :     end = struct
16 :    
17 :     structure CL = CLang
18 :     structure PP = TextIOPP
19 :    
20 :     val indent0 = (PP.Abs 0)
21 :     val indent = (PP.Abs 4) (* standard indentation amount *)
22 :    
23 :     fun output (strm, decl) = let
24 :     val str = PP.string strm
25 :     fun sp () = PP.space strm 1
26 :     fun inHBox f = (PP.openHBox strm; f(); PP.closeBox strm)
27 :     fun ppCom s = inHBox (fn () => (str "// "; str s))
28 :     fun ppComLn s = (ppCom s; PP.newline strm)
29 :     fun ppList {pp, sep, l} = let
30 :     fun ppList' [] = ()
31 :     | ppList' [x] = pp x
32 :     | ppList' (x::xs) = (pp x; sep(); ppList' xs)
33 :     in
34 :     ppList' l
35 :     end
36 :     fun ppTy (ty, optVar) = let
37 : jhr 3955 fun rawTy rty = (case rty
38 : jhr 3871 of RawTypes.RT_Int8 => "int8_t"
39 :     | RawTypes.RT_UInt8 => "uint8_t"
40 :     | RawTypes.RT_Int16 => "int16_t"
41 :     | RawTypes.RT_UInt16 => "uint16_t"
42 :     | RawTypes.RT_Int32 => "int32_t"
43 :     | RawTypes.RT_UInt32 => "uint32_t"
44 :     | RawTypes.RT_Int64 => "int64_t"
45 :     | RawTypes.RT_UInt64 => "uint64_t"
46 :     | RawTypes.RT_Float => "float"
47 :     | RawTypes.RT_Double => "double"
48 :     (* end case *))
49 : jhr 3955 fun getBaseTy (CL.T_Num rty) = rawTy rty
50 :     | getBaseTy (CL.T_Const(CL.T_Num rty)) = "const " ^ rawTy rty
51 :     | getBaseTy (CL.T_Const(CL.T_Named ty)) = "const " ^ ty
52 :     | getBaseTy (CL.T_Const ty) = getBaseTy ty
53 : jhr 3871 | getBaseTy (CL.T_Ptr ty) = getBaseTy ty
54 :     | getBaseTy (CL.T_RestrictPtr ty) = getBaseTy ty
55 :     | getBaseTy (CL.T_Array(ty, _)) = getBaseTy ty
56 :     | getBaseTy (CL.T_Named ty) = ty
57 :     (* FIXME: this isn't right *)
58 :     | getBaseTy (CL.T_Template(name, tys)) = concat[
59 :     name, "< ", String.concatWith ", " (List.map getBaseTy tys), " >"
60 :     ]
61 :     | getBaseTy (CL.T_Qual(attr, ty)) =
62 :     concat[attr, " ", getBaseTy ty]
63 : jhr 3955 fun ppVar (isFirst, SOME x) = (
64 : jhr 3871 if isFirst then sp() else ();
65 : jhr 3955 str x)
66 :     | ppVar _ = ()
67 :     fun pp (isFirst, CL.T_Const(CL.T_Num _), optVar) = ppVar (isFirst, optVar)
68 :     | pp (isFirst, CL.T_Const(CL.T_Named _), optVar) = ppVar (isFirst, optVar)
69 :     | pp (isFirst, CL.T_Const ty, optVar) = raise Fail "FIXME"
70 :     | pp (isFirst, CL.T_Ptr ty, optVar) = (
71 :     if isFirst then sp() else ();
72 : jhr 3871 case ty
73 :     of CL.T_Array _ => (
74 :     str "(*"; pp(false, ty, optVar); str ")")
75 :     | _ => (str "*"; pp(false, ty, optVar))
76 :     (* end case *))
77 :     | pp (isFirst, CL.T_RestrictPtr ty, optVar) = (
78 :     if isFirst then sp() else ();
79 :     case ty
80 :     of CL.T_Array _ => (
81 :     str "(*"; sp(); str "__restrict__"; sp(); pp(false, ty, optVar); str ")")
82 :     | _ => (str "*"; sp(); str "__restrict__"; sp(); pp(false, ty, optVar))
83 :     (* end case *))
84 :     | pp (isFirst, CL.T_Array(ty, optN), optVar) = (
85 :     pp (isFirst, ty, optVar);
86 :     case optN
87 :     of NONE => str "[]"
88 :     | SOME n => (str "["; str(Int.toString n); str "]")
89 :     (* end case *))
90 :     | pp (isFirst, CL.T_Qual(_, ty), optVar) =
91 :     pp (isFirst, ty, optVar)
92 : jhr 3955 | pp (isFirst, _, optVar) = ppVar (isFirst, optVar)
93 : jhr 3871 in
94 :     str (getBaseTy ty);
95 :     pp (true, ty, optVar)
96 :     end
97 :     fun ppAttrs [] = ()
98 :     | ppAttrs attrs = (
99 :     ppList {pp=str, sep=sp, l = attrs};
100 :     sp())
101 :     fun ppDecl (inClass, dcl) = (case dcl
102 :     of CL.D_Pragma l => (
103 :     inHBox (fn () => (
104 :     str "#pragma";
105 :     List.app (fn s => (sp(); str s)) l));
106 :     PP.newline strm)
107 :     | CL.D_Comment l => List.app ppComLn l
108 :     | CL.D_Verbatim l => List.app str l
109 :     | CL.D_Var(attrs, ty, x, optInit) => (
110 :     inHBox (fn () => (
111 :     ppAttrs attrs;
112 :     ppTy (ty, SOME x);
113 :     case optInit
114 :     of SOME init => (sp(); str "="; sp(); ppInit init)
115 :     | NONE => ()
116 :     (* end case *);
117 :     str ";"));
118 :     PP.newline strm)
119 :     | CL.D_Proto(attrs, ty, f, params) => (
120 :     inHBox (fn () => (
121 :     ppAttrs attrs;
122 :     ppTy(ty, SOME f);
123 :     sp(); str "(";
124 :     ppList {pp=ppParam, sep=fn () => (str ","; sp()), l=params};
125 :     str ");"));
126 :     PP.newline strm)
127 :     | CL.D_Func(attrs, ty, f, params, body) => (
128 :     PP.openVBox strm indent0;
129 :     inHBox (fn () => (
130 :     ppAttrs attrs;
131 :     ppTy(ty, SOME f);
132 :     sp(); str "(";
133 :     ppList {pp=ppParam, sep=fn () => (str ","; sp()), l=params};
134 :     str ")"));
135 :     PP.newline strm;
136 :     ppBlock (case body of CL.S_Block stms => stms | stm => [stm]);
137 :     PP.closeBox strm;
138 :     PP.newline strm)
139 :     | CL.D_Constr(attrs, namespace, cls, params, inits, body) => (
140 :     PP.openVBox strm indent0;
141 :     inHBox (fn () => (
142 :     ppAttrs attrs;
143 :     if inClass
144 :     then str cls
145 :     else (
146 :     Option.app (fn ns => (str ns; str "::")) namespace;
147 :     str cls; str "::"; str cls);
148 :     sp(); str "(";
149 :     ppList {pp=ppParam, sep=fn () => (str ","; sp()), l=params};
150 :     if Option.isNone body then str ");" else str ")"));
151 :     case body
152 :     of SOME body => (
153 : jhr 3931 PP.newline strm;
154 : jhr 3871 (* TODO inits *)
155 :     ppBlock (case body of CL.S_Block stms => stms | stm => [stm]))
156 :     | NONE => ()
157 :     (* end case *);
158 :     PP.closeBox strm;
159 :     PP.newline strm)
160 :     | CL.D_Destr(attrs, namespace, cls, body) => (
161 :     PP.openVBox strm indent0;
162 :     inHBox (fn () => (
163 :     ppAttrs attrs;
164 :     if inClass
165 :     then (str "~"; str cls)
166 :     else (
167 :     Option.app (fn ns => (str ns; str "::")) namespace;
168 :     str "~"; str cls; str "::"; str cls);
169 :     sp();
170 :     if Option.isNone body then str "();" else str "()"));
171 :     case body
172 : jhr 3931 of SOME(CL.S_Block stms) => (PP.newline strm; ppBlock stms)
173 :     | SOME stm => (PP.newline strm; ppBlock [stm])
174 : jhr 3871 | NONE => ()
175 :     (* end case *);
176 :     PP.closeBox strm;
177 :     PP.newline strm)
178 :     | CL.D_StructDef(SOME name, fields, NONE) => (
179 :     PP.openVBox strm indent0;
180 :     inHBox (fn () => (str "struct"; sp(); str name; sp(); str "{"));
181 :     PP.openVBox strm indent;
182 :     List.app (fn (ty, x) => (
183 :     PP.newline strm;
184 :     inHBox (fn () => (ppTy(ty, SOME x); str ";"))))
185 :     fields;
186 :     PP.closeBox strm;
187 :     PP.newline strm;
188 :     str "};";
189 :     PP.closeBox strm;
190 :     PP.newline strm)
191 :     | CL.D_StructDef(optStruct, fields, SOME tyName) => (
192 :     PP.openVBox strm indent0;
193 :     str "typedef struct {";
194 :     PP.openVBox strm indent;
195 :     List.app (fn (ty, x) => (
196 :     PP.newline strm;
197 :     inHBox (fn () => (ppTy(ty, SOME x); str ";"))))
198 :     fields;
199 :     PP.closeBox strm;
200 :     PP.newline strm;
201 :     inHBox (fn () => (str "}"; sp(); str tyName; str ";"));
202 :     PP.closeBox strm;
203 :     PP.newline strm)
204 :     | CL.D_StructDef(NONE, _, NONE) => raise Fail "unamed struct"
205 :     | CL.D_ClassDef{name, from, public, protected=[], private=[]} => (
206 :     PP.openVBox strm indent0;
207 :     inHBox (fn () => (
208 :     str "struct"; sp(); str name;
209 :     Option.map (fn base => (sp(); str ":"; sp(); str base)) from;
210 :     sp(); str "{"));
211 :     PP.openVBox strm indent;
212 :     PP.newline strm;
213 :     List.app (fn dcl => ppDecl (true, dcl)) public;
214 :     PP.closeBox strm;
215 :     PP.newline strm;
216 :     str "};";
217 :     PP.closeBox strm;
218 :     PP.newline strm)
219 :     | CL.D_ClassDef{name, from, public, protected, private} =>
220 :     raise Fail "FIXME: ClassDef"
221 : jhr 3989 | CL.D_Template(params, dcl) => let
222 :     fun ppParam (CL.TypeParam name) = (str "typename"; sp(); str name)
223 :     | ppParam (CL.ConstParam(ty, name)) = (
224 :     str "const"; sp(); ppTy (ty, NONE); sp(); str name)
225 :     in
226 :     PP.openVBox strm indent0;
227 :     inHBox (fn () => (
228 :     str "template"; sp(); str "<";
229 :     ppList {pp = ppParam, sep = fn () => str ",", l = params};
230 :     str ">"));
231 :     PP.newline strm;
232 :     ppDecl (inClass, dcl);
233 :     PP.closeBox strm
234 :     end
235 : jhr 3871 (* end case *))
236 :     and ppParam (CL.PARAM(attrs, ty, x)) = (
237 :     ppAttrs attrs;
238 :     ppTy(ty, SOME(CL.varToString x)))
239 :     and ppInit init = (case init
240 :     of CL.I_Exp e => ppExp e
241 :     | CL.I_Exps fields => (
242 :     str "{";
243 :     PP.openHVBox strm indent;
244 :     List.app (fn init => (
245 :     PP.break strm;
246 :     inHBox (fn () => (ppInit init; str ","))))
247 :     fields;
248 :     PP.closeBox strm;
249 :     str "}")
250 :     | CL.I_Struct fields => (
251 :     str "{";
252 :     PP.openHVBox strm indent;
253 :     List.app (fn (lab, init) => (
254 :     PP.break strm;
255 :     inHBox (fn () => (
256 :     str("." ^ lab); sp(); str "="; sp(); ppInit init; str ","))))
257 :     fields;
258 :     PP.closeBox strm;
259 :     str "}")
260 :     | CL.I_Array elems => (
261 :     str "{";
262 :     PP.openHVBox strm indent;
263 :     List.app (fn (i, init) => (
264 :     PP.break strm;
265 :     inHBox (fn () => (
266 :     str(concat["[", Int.toString i, "]"]); sp(); str "="; sp();
267 :     ppInit init; str ","))))
268 :     elems;
269 :     PP.closeBox strm;
270 :     str "}")
271 :     | CL.I_Cons(ty, args) => (
272 :     PP.openHVBox strm indent;
273 :     ppTy(ty, NONE); ppArgs args; str ";";
274 :     PP.closeBox strm)
275 :     (* end case *))
276 :     and ppBlock stms = (
277 :     str "{";
278 :     PP.openVBox strm indent;
279 :     List.app (fn stm => (PP.newline strm; ppStm stm)) stms;
280 :     PP.closeBox strm;
281 :     PP.newline strm;
282 :     str "}")
283 :     and ppStm stm = (case stm
284 :     of CL.S_Block stms => ppBlock stms
285 :     | CL.S_Comment l => List.app ppCom l
286 :     | CL.S_Verbatim [] => ()
287 :     | CL.S_Verbatim (stm::stms) => (
288 :     str stm;
289 :     List.app (fn stm => (PP.newline strm; str stm)) stms)
290 :     | CL.S_Decl(attrs, ty, x, NONE) => inHBox (fn () => (
291 :     ppAttrs attrs;
292 :     ppTy(ty, SOME x); str ";"))
293 :     | CL.S_Decl(attrs, ty, x, SOME e) => inHBox (fn () => (
294 :     ppAttrs attrs;
295 :     ppTy(ty, SOME x); sp(); str "="; sp(); ppInit e; str ";"))
296 :     | CL.S_Exp e => inHBox (fn () => (ppExp e; str ";"))
297 :     | CL.S_If(e, blk, CL.S_Block[]) =>
298 :     inHBox (fn () => (str "if"; sp(); ppExp e; ppStmAsBlock blk))
299 :     | CL.S_If(e, blk1, stm as CL.S_If _) => (
300 :     PP.openVBox strm indent0;
301 :     inHBox (fn () => (str "if"; sp(); ppExp e; ppStmAsBlock blk1));
302 :     PP.newline strm;
303 :     PP.closeBox strm;
304 :     inHBox (fn () => (str "else"; sp(); ppStm stm)))
305 :     | CL.S_If(e, blk1, blk2) => (
306 :     PP.openVBox strm indent0;
307 :     inHBox (fn () => (str "if"; sp(); ppExp e; ppStmAsBlock blk1));
308 :     PP.newline strm;
309 :     inHBox (fn () => (str "else"; ppStmAsBlock blk2));
310 :     PP.closeBox strm)
311 :     | CL.S_While(e, blk) =>
312 :     inHBox (fn () => (str "while"; sp(); ppExp e; ppStmAsBlock blk))
313 :     | CL.S_DoWhile(blk, e) =>
314 :     inHBox (fn () => (
315 :     str "do"; ppStmAsBlock blk; sp(); str "while"; sp(); ppExp e))
316 :     | CL.S_For(inits, cond, incrs, blk) => let
317 :     fun ppInit (ty, x, e) = inHBox (fn () => (
318 :     ppTy(ty, SOME x);
319 :     sp(); str "="; sp();
320 :     ppExp e))
321 :     in
322 :     inHBox (fn () => (
323 :     str "for"; sp(); str "(";
324 :     ppList {pp = ppInit, sep = fn () => str ",", l = inits};
325 :     str ";"; sp();
326 :     ppExp cond; str ";"; sp();
327 :     ppList {pp = ppExp, sep = fn () => str ",", l = incrs};
328 :     str ")";
329 :     ppStmAsBlock blk))
330 :     end
331 :     | CL.S_Return(SOME e) => inHBox (fn () => (str "return"; sp(); ppExp e; str ";"))
332 :     | CL.S_Return _ => str "return;"
333 :     | CL.S_Break => str "break;"
334 :     | CL.S_Continue => str "continue;"
335 : jhr 3897 | CL.S_KernCall _ => raise Fail "unexpected KernCall in C++ code"
336 : jhr 3871 (* end case *))
337 :     (* force printing "{" "}" around a statement *)
338 :     and ppStmAsBlock (CL.S_Block stms) = (sp(); ppBlock stms)
339 :     | ppStmAsBlock stm = (sp(); ppBlock [stm])
340 :     and ppExp e = (case e
341 :     of CL.E_Grp e => (str "("; ppExp e; str ")")
342 :     | CL.E_AssignOp(lhs, rator, rhs) => (
343 :     ppExp lhs; sp(); str(CL.assignopToString rator); sp(); ppExp rhs)
344 :     | CL.E_Cond(e1, e2, e3) => (
345 :     ppExp e1; sp(); str "?"; sp(); ppExp e2; sp(); str ":"; sp(); ppExp e3)
346 :     | CL.E_BinOp(e1, rator, e2) => (ppExp e1; str(CL.binopToString rator); ppExp e2)
347 :     | CL.E_UnOp(rator, e) => (str(CL.unopToString rator); ppExp e)
348 :     | CL.E_PostOp(e, rator) => (ppExp e; str(CL.postopToString rator))
349 :     | CL.E_Apply(e, args) => (ppExp e; ppArgs args)
350 : jhr 3897 | CL.E_TApply(f, tys, args) => (
351 :     str f; str "<";
352 :     ppList {
353 :     pp = fn ty => (PP.openHBox strm; ppTy(ty, NONE); PP.closeBox strm),
354 :     sep = fn () => (str ","; sp()),
355 :     l = tys
356 :     };
357 :     str ">"; ppArgs args)
358 : jhr 3871 | CL.E_Cons(ty, args) => (ppTy(ty, NONE); ppArgs args)
359 :     | CL.E_New(ty, args) => (
360 :     str "new"; sp(); ppTy(ty, NONE);
361 :     case (ty, args)
362 :     of (CL.T_Named ty, []) => str ty
363 :     | (CL.T_Template _, []) => ppTy(ty, NONE)
364 :     | (CL.T_Named ty, args) => (str ty; ppArgs args)
365 :     | (CL.T_Template _, args) => (ppTy(ty, NONE); ppArgs args)
366 :     | (ty, []) => ppTy(ty, NONE)
367 :     | _ => raise Fail "bogus new"
368 :     (* end case *))
369 :     | CL.E_Subscript(e1, e2) => (ppExp e1; str "["; ppExp e2; str "]")
370 :     | CL.E_Select(e, f) => (ppExp e; str "."; str f)
371 :     | CL.E_Indirect(e, f) => (ppExp e; str "->"; str f)
372 : jhr 3893 | CL.E_Cast(ty, e) => (str "("; ppTy(ty, NONE); str ")"; ppExp e)
373 : jhr 3924 | CL.E_XCast(c, ty, e) => (
374 :     str c; str "<"; ppTy(ty, NONE); str ">("; ppExp e; str ")")
375 : jhr 3871 | CL.E_Vec(ty, args) => (
376 :     (* GCC vector syntax: "__extension__ (ty){a, b, ...}" *)
377 :     str "__extension__"; sp(); str "("; ppTy(ty, NONE); str ")";
378 :     str "{";
379 :     PP.openHOVBox strm indent;
380 :     PP.cut strm;
381 :     ppList {
382 :     pp = fn e => (PP.openHBox strm; ppExp e; PP.closeBox strm),
383 :     sep = fn () => (str ","; sp()),
384 :     l = args
385 :     };
386 :     str "}";
387 :     PP.closeBox strm)
388 :     | CL.E_Var x => str(CL.varToString x)
389 :     | CL.E_Int(n, CL.T_Num(RawTypes.RT_Int64)) =>
390 :     str(IntLit.toString n ^ "l")
391 :     | CL.E_Int(n, _) => str(IntLit.toString n)
392 :     | CL.E_Flt(f, ty) => let
393 :     val isDouble = (case ty
394 :     of CL.T_Num(RawTypes.RT_Float) => false
395 :     | _ => true
396 :     (* end case *))
397 :     (* NOTE: the CLang.mkFlt function guarantees that f is non-negative *)
398 :     val f = if RealLit.same(RealLit.posInf, f)
399 :     then if isDouble
400 :     then "HUGE_VAL"
401 :     else "HUGE_VALF"
402 :     else if RealLit.same(RealLit.nan, f)
403 :     then if isDouble
404 :     then "std::nan(\"\")"
405 :     else "std::nanf(\"\")"
406 :     else if isDouble
407 :     then RealLit.toString f
408 :     else RealLit.toString f ^ "f"
409 :     in
410 :     str f
411 :     end
412 :     | CL.E_Bool b => str(Bool.toString b)
413 :     | CL.E_Str s => str(concat["\"", String.toCString s, "\""])
414 :     | CL.E_Char c => str(concat["'", Char.toCString c, "'"])
415 :     | CL.E_Sizeof ty => (str "sizeof("; ppTy(ty, NONE); str ")")
416 :     (* end case *))
417 :     and ppArgs args = (
418 :     str "(";
419 :     PP.openHOVBox strm indent;
420 :     PP.cut strm;
421 :     ppList {
422 :     pp = fn e => (PP.openHBox strm; ppExp e; PP.closeBox strm),
423 :     sep = fn () => (str ","; sp()),
424 :     l = args
425 :     };
426 :     str ")";
427 :     PP.closeBox strm)
428 :     in
429 :     ppDecl (false, decl)
430 :     end
431 :    
432 :     end

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