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

SCM Repository

[diderot] Annotation of /branches/charisee/src/compiler/c-util/print-as-c.sml
ViewVC logotype

Annotation of /branches/charisee/src/compiler/c-util/print-as-c.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2666 - (view) (download)

1 : jhr 1115 (* print-as-c.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 C99 syntax.
7 :     *)
8 :    
9 :     structure PrintAsC : 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 1766 val indent0 = (PP.Abs 0)
27 : jhr 2114 val indent = (PP.Abs 4) (* standard indentation amount *)
28 : jhr 1115
29 : jhr 2114 fun new outs = PP.openOut {dst = outs, wid = 120}
30 : jhr 1115
31 :     val close = PP.closeStream
32 :    
33 :     fun output (strm, decl) = let
34 : jhr 2114 val str = PP.string strm
35 :     fun sp () = PP.space strm 1
36 :     fun inHBox f = (PP.openHBox strm; f(); PP.closeBox strm)
37 :     fun ppComLn s = (
38 :     inHBox (fn () => (str "// "; str s));
39 :     PP.newline strm)
40 :     fun ppList {pp, sep, l} = let
41 :     fun ppList' [] = ()
42 :     | ppList' [x] = pp x
43 :     | ppList' (x::xs) = (pp x; sep(); ppList' xs)
44 :     in
45 :     ppList' l
46 :     end
47 :     fun ppTy (ty, optVar) = let
48 :     fun getBaseTy (CL.T_Ptr ty) = getBaseTy ty
49 :     | getBaseTy (CL.T_Array(ty, _)) = getBaseTy ty
50 :     | getBaseTy (CL.T_Num rty) = (case rty
51 :     of RawTypes.RT_Int8 => "int8_t"
52 :     | RawTypes.RT_UInt8 => "uint8_t"
53 :     | RawTypes.RT_Int16 => "int16_t"
54 :     | RawTypes.RT_UInt16 => "uint16_t"
55 :     | RawTypes.RT_Int32 => "int32_t"
56 :     | RawTypes.RT_UInt32 => "uint32_t"
57 :     | RawTypes.RT_Int64 => "int64_t"
58 :     | RawTypes.RT_UInt64 => "uint64_t"
59 :     | RawTypes.RT_Float => "float"
60 :     | RawTypes.RT_Double => "double"
61 :     (* end case *))
62 :     | getBaseTy (CL.T_Named ty) = ty
63 : jhr 1444 | getBaseTy (CL.T_Qual(attr, ty)) =
64 :     concat[attr, " ", getBaseTy ty]
65 : jhr 2114 fun pp (isFirst, CL.T_Ptr ty, optVar) = (
66 :     if isFirst then sp() else ();
67 :     case ty
68 :     of CL.T_Array _ => (
69 :     str "(*"; pp(false, ty, optVar); str ")")
70 :     | _ => (str "*"; pp(false, ty, optVar))
71 :     (* end case *))
72 :     | pp (isFirst, CL.T_Array(ty, optN), optVar) = (
73 :     pp (isFirst, ty, optVar);
74 :     case optN
75 :     of NONE => str "[]"
76 :     | SOME n => (str "["; str(Int.toString n); str "]")
77 :     (* end case *))
78 : jhr 1444 | pp (isFirst, CL.T_Qual(_, ty), optVar) =
79 :     pp (isFirst, ty, optVar)
80 : jhr 2114 | pp (isFirst, _, SOME x) = (
81 :     if isFirst then sp() else ();
82 :     str x)
83 :     | pp (_, _, NONE) = ()
84 :     in
85 :     str (getBaseTy ty);
86 :     pp (true, ty, optVar)
87 :     end
88 : jhr 1368 fun ppAttrs [] = ()
89 :     | ppAttrs attrs = (
90 :     ppList {pp=str, sep=sp, l = attrs};
91 :     sp())
92 : jhr 2114 fun ppDecl dcl = (case dcl
93 : jhr 2356 of CL.D_Pragma l => (
94 :     inHBox (fn () => (
95 :     str "#pragma";
96 :     List.app (fn s => (sp(); str s)) l));
97 :     PP.newline strm)
98 :     | CL.D_Comment l => List.app ppComLn l
99 : jhr 1640 | CL.D_Verbatim l => List.app str l
100 : jhr 2114 | CL.D_Var(attrs, ty, x, optInit) => (
101 :     inHBox (fn () => (
102 :     ppAttrs attrs;
103 :     ppTy (ty, SOME x);
104 :     case optInit
105 :     of SOME init => (sp(); str "="; sp(); ppInit init)
106 :     | NONE => ()
107 :     (* end case *);
108 :     str ";"));
109 :     PP.newline strm)
110 : jhr 1766 | CL.D_Proto(attrs, ty, f, params) => (
111 :     inHBox (fn () => (
112 :     ppAttrs attrs;
113 :     ppTy(ty, SOME f);
114 :     sp(); str "(";
115 :     ppList {pp=ppParam, sep=fn () => (str ","; sp()), l=params};
116 :     str ");"));
117 :     PP.newline strm)
118 : jhr 2114 | CL.D_Func(attrs, ty, f, params, body) => (
119 :     PP.openVBox strm indent0;
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 :     ppBlock (case body of CL.S_Block stms => stms | stm => [stm]);
128 :     PP.closeBox strm;
129 : jhr 1368 PP.newline strm)
130 : jhr 2114 | CL.D_StructDef(SOME name, fields, NONE) => (
131 :     PP.openVBox strm indent0;
132 :     inHBox (fn () => (str "struct"; sp(); str name; sp(); str "{"));
133 :     PP.openVBox strm indent;
134 :     List.app (fn (ty, x) => (
135 :     PP.newline strm;
136 :     inHBox (fn () => (ppTy(ty, SOME x); str ";"))))
137 :     fields;
138 :     PP.closeBox strm;
139 :     PP.newline strm;
140 :     str "};";
141 :     PP.closeBox strm;
142 :     PP.newline strm)
143 :     | CL.D_StructDef(optStruct, fields, SOME tyName) => (
144 :     PP.openVBox strm indent0;
145 :     str "typedef struct {";
146 :     PP.openVBox strm indent;
147 :     List.app (fn (ty, x) => (
148 :     PP.newline strm;
149 :     inHBox (fn () => (ppTy(ty, SOME x); str ";"))))
150 :     fields;
151 :     PP.closeBox strm;
152 :     PP.newline strm;
153 :     inHBox (fn () => (str "}"; sp(); str tyName; str ";"));
154 :     PP.closeBox strm;
155 :     PP.newline strm)
156 : cchiw 2664 | CL.D_NotDone => str ""
157 : jhr 2114 (* end case *))
158 :     and ppParam (CL.PARAM(attrs, ty, x)) = (
159 :     ppAttrs attrs;
160 :     ppTy(ty, SOME(CL.varToString x)))
161 :     and ppInit init = (case init
162 :     of CL.I_Exp e => ppExp e
163 :     | CL.I_Struct fields => (
164 :     str "{";
165 :     PP.openHVBox strm indent;
166 :     List.app (fn (lab, init) => (
167 :     PP.break strm;
168 :     inHBox (fn () => (
169 :     str("." ^ lab); sp(); str "="; sp(); ppInit init; str ","))))
170 :     fields;
171 :     PP.closeBox strm;
172 :     str "}")
173 :     | CL.I_Array elems => (
174 :     str "{";
175 :     PP.openHVBox strm indent;
176 :     List.app (fn (i, init) => (
177 :     PP.break strm;
178 :     inHBox (fn () => (
179 :     str(concat["[", Int.toString i, "]"]); sp(); str "="; sp();
180 :     ppInit init; str ","))))
181 :     elems;
182 :     PP.closeBox strm;
183 :     str "}")
184 :     (* end case *))
185 :     and ppBlock stms = (
186 :     str "{";
187 :     PP.openVBox strm indent;
188 :     List.app (fn stm => (PP.newline strm; ppStm stm)) stms;
189 :     PP.closeBox strm;
190 :     PP.newline strm;
191 :     str "}")
192 :     and ppStm stm = (case stm
193 :     of CL.S_Block stms => ppBlock stms
194 :     | CL.S_Comment l => List.app ppComLn l
195 : jhr 2356 | CL.S_Verbatim [] => ()
196 :     | CL.S_Verbatim (stm::stms) => (
197 :     str stm;
198 :     List.app (fn stm => (PP.newline strm; str stm)) stms)
199 : jhr 2114 | CL.S_Decl(attrs, ty, x, NONE) => inHBox (fn () => (
200 :     ppAttrs attrs;
201 :     ppTy(ty, SOME x); str ";"))
202 :     | CL.S_Decl(attrs, ty, x, SOME e) => inHBox (fn () => (
203 :     ppAttrs attrs;
204 :     ppTy(ty, SOME x); sp(); str "="; sp(); ppInit e; str ";"))
205 :     | CL.S_Exp e => inHBox (fn () => (ppExp e; str ";"))
206 :     | CL.S_If(e, blk, CL.S_Block[]) =>
207 :     inHBox (fn () => (str "if"; sp(); ppExp e; ppStms blk))
208 :     | CL.S_If(e, blk1, blk2) => (
209 :     PP.openVBox strm indent0;
210 :     inHBox (fn () => (str "if"; sp(); ppExp e; ppStms blk1));
211 :     PP.newline strm;
212 :     inHBox (fn () => (str "else"; ppStms blk2));
213 :     PP.closeBox strm)
214 :     | CL.S_While(e, blk) =>
215 :     inHBox (fn () => (str "while"; sp(); ppExp e; ppStms blk))
216 :     | CL.S_DoWhile(blk, e) =>
217 :     inHBox (fn () => (
218 :     str "do"; ppStms blk; sp(); str "while"; sp(); ppExp e))
219 :     | CL.S_For(inits, cond, incrs, blk) => let
220 :     fun ppInit (ty, x, e) = inHBox (fn () => (
221 :     ppTy(ty, SOME x);
222 :     sp(); str "="; sp();
223 :     ppExp e))
224 :     in
225 :     inHBox (fn () => (
226 :     str "for"; sp(); str "(";
227 :     ppList {pp = ppInit, sep = fn () => str ",", l = inits};
228 :     str ";"; sp();
229 :     ppExp cond; str ";"; sp();
230 :     ppList {pp = ppExp, sep = fn () => str ",", l = incrs};
231 :     str ")";
232 :     ppStms blk))
233 :     end
234 :     | CL.S_Call(f, args) => inHBox (fn () => (str f; ppArgs args; str ";"))
235 :     | CL.S_Return(SOME e) => inHBox (fn () => (str "return"; sp(); ppExp e; str ";"))
236 :     | CL.S_Return _ => str "return;"
237 :     | CL.S_Break => str "break;"
238 :     | CL.S_Continue => str "continue;"
239 : cchiw 2666 | CL.S_ExtAssign (ty,v,e)=> (ppTy(ty, NONE); str v; str "=";str" __extension__ "; ppExp e; str ";")
240 : cchiw 2665 | CL.S_Eq(e1,e2) => (ppExp e1;str "="; ppExp e2;str";")
241 :    
242 : jhr 2114 (* end case *))
243 :     and ppStms (CL.S_Block stms) = (sp(); ppBlock stms)
244 :     | ppStms stm = (
245 :     PP.openHOVBox strm indent;
246 :     sp ();
247 :     ppStm stm;
248 :     PP.closeBox strm)
249 :     and ppExp e = (case e
250 :     of CL.E_Grp e => (str "("; ppExp e; str ")")
251 :     | CL.E_AssignOp(lhs, rator, rhs) => (
252 :     ppExp lhs; sp(); str(CL.assignopToString rator); sp(); ppExp rhs)
253 : jhr 1640 | CL.E_Cond(e1, e2, e3) => (
254 :     ppExp e1; sp(); str "?"; sp(); ppExp e2; sp(); str ":"; sp(); ppExp e3)
255 : jhr 2114 | CL.E_BinOp(e1, rator, e2) => (ppExp e1; str(CL.binopToString rator); ppExp e2)
256 :     | CL.E_UnOp(rator, e) => (str(CL.unopToString rator); ppExp e)
257 :     | CL.E_PostOp(e, rator) => (ppExp e; str(CL.postopToString rator))
258 :     | CL.E_Apply(f, args) => (str f; ppArgs args)
259 :     | CL.E_Subscript(e1, e2) => (ppExp e1; str "["; ppExp e2; str "]")
260 :     | CL.E_Select(e, f) => (ppExp e; str "."; str f)
261 :     | CL.E_Indirect(e, f) => (ppExp e; str "->"; str f)
262 :     | CL.E_Cast(ty, e) => (
263 :     str "("; ppTy(ty, NONE); str ")"; ppExp e)
264 :     | CL.E_Var x => str(CL.varToString x)
265 :     | CL.E_Int(n, CL.T_Num(RawTypes.RT_Int64)) =>
266 :     str(IntegerLit.toString n ^ "l")
267 :     | CL.E_Int(n, _) => str(IntegerLit.toString n)
268 :     | CL.E_Flt(f, ty) => let
269 :     val isDouble = (case ty
270 :     of CL.T_Num(RawTypes.RT_Float) => false
271 :     | _ => true
272 :     (* end case *))
273 :     (* NOTE: the CLang.mkFlt function guarantees that f is non-negative *)
274 :     val f = if FloatLit.same(FloatLit.posInf, f)
275 :     then if isDouble
276 :     then "HUGE_VAL"
277 :     else "HUGE_VALF"
278 :     else if FloatLit.same(FloatLit.nan, f)
279 :     then if isDouble
280 :     then "nan(\"\")"
281 :     else "nanf(\"\")"
282 :     else if isDouble
283 :     then FloatLit.toString f
284 :     else FloatLit.toString f ^ "f"
285 :     in
286 :     str f
287 :     end
288 :     | CL.E_Bool b => str(Bool.toString b)
289 :     | CL.E_Str s => str(concat["\"", String.toCString s, "\""])
290 :     | CL.E_Sizeof ty => (str "sizeof("; ppTy(ty, NONE); str ")")
291 : cchiw 2664 (*Just added *)
292 : cchiw 2665 | CL.E_Struct e => let
293 :     fun m []= str " "
294 :     | m [e1]=ppExp e1
295 :     | m (e1::es) = (ppExp e1;str ",";m(es))
296 :     in (str "{"; m e; str "}")
297 :     end
298 :     | CL.E_Ref(ty,e2 )=>(str "*(";ppTy(ty,NONE) ;
299 :     str "* )&("; ppExp e2; str ")")
300 :     (* *(ty* )& (exp) *)
301 : cchiw 2666 | CL.E_Ext e=> ( str " __extension__ "; ppExp e)
302 : cchiw 2664
303 : cchiw 2665
304 : jhr 2114 (* end case *))
305 :     and ppArgs args = (
306 :     str "(";
307 :     PP.openHOVBox strm indent;
308 :     PP.cut strm;
309 :     ppList {
310 :     pp = fn e => (PP.openHBox strm; ppExp e; PP.closeBox strm),
311 :     sep = fn () => (str ","; sp()),
312 :     l = args
313 :     };
314 :     str ")";
315 :     PP.closeBox strm)
316 :     in
317 :     ppDecl decl
318 :     end
319 : jhr 1115
320 :     end

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