Annotation of /branches/pure-cfg/src/compiler/c-target/print-as-c.sml

Parent Directory | Revision Log

---

Revision 616 - (view) (download)

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

---

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