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

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