Annotation of /branches/vis12/src/compiler/codegen/clang.sml

Parent Directory | Revision Log

---

Revision 1850 - (view) (download)

1 :	jhr	1115	(* clang.sml
2 :			*
3 :			* COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :			* All rights reserved.
5 :			*
6 :			* An tree representation of programs in a C-like language (e.g., C, CUDA,
7 :			* or OpenCL). The purpose of this code is to commonality between the various
8 :			* backends, which are all generating C-like code.
9 :			*)
10 :
11 :			structure CLang =
12 :			struct
13 :
14 :			type var = string
15 :	jhr	1368	type attr = string (* e.g., "static", "kernel", etc ... *)
16 :	jhr	1115
17 :			datatype ty
18 :			= T_Num of RawTypes.ty
19 :			| T_Ptr of ty
20 :			| T_Array of ty * int option
21 :			| T_Named of string
22 :	jhr	1444	| T_Qual of attr * ty (* qualified type *)
23 :	jhr	1115
24 :	jhr	1368	datatype typed_var = V of ty * var
25 :
26 :	jhr	1115	val voidTy = T_Named "void"
27 :	jhr	1301	val charTy = T_Named "char"
28 :	jhr	1368	val boolTy = T_Named "bool"
29 :	jhr	1301	val charPtr = T_Ptr(charTy)
30 :			val charArrayPtr = T_Ptr(charPtr)
31 :	jhr	1232	val intTy = T_Named "int"
32 :	jhr	1716	val int8 = T_Num(RawTypes.RT_Int8)
33 :			val uint8 = T_Num(RawTypes.RT_UInt8)
34 :	jhr	1115	val int32 = T_Num(RawTypes.RT_Int32)
35 :			val uint32 = T_Num(RawTypes.RT_UInt32)
36 :			val int64 = T_Num(RawTypes.RT_Int64)
37 :			val float = T_Num(RawTypes.RT_Float)
38 :			val double = T_Num(RawTypes.RT_Double)
39 :
40 :			datatype decl
41 :			= D_Comment of string list
42 :			(* verbatim text (e.g., preprocessor directives) *)
43 :			| D_Verbatim of string list
44 :			(* global variable declaration *)
45 :			| D_Var of attr list * ty * var * initializer option
46 :	jhr	1702	(* function prototype *)
47 :			| D_Proto of attr list * ty * string * param list
48 :	jhr	1115	(* function definition *)
49 :			| D_Func of attr list * ty * string * param list * stm
50 :	jhr	1716	(* struct type declaration; if the second argument is SOME name, then a
51 :			* typedef is generated.
52 :			*)
53 :			| D_StructDef of string option * (ty * string) list * string option
54 :	jhr	1115
55 :			and initializer
56 :			= I_Exp of exp
57 :			| I_Struct of (string * initializer) list
58 :			| I_Array of (int * initializer) list
59 :
60 :			and param = PARAM of attr list * ty * var
61 :
62 :			and stm
63 :	jhr	1368	= S_Block of stm list (* "{" stms "}" *)
64 :	jhr	1115	| S_Comment of string list
65 :	jhr	1368	| S_Decl of attr list * ty * var * initializer option
66 :			(* ty var [ '=' exp ]';' *)
67 :			| S_Exp of exp (* exp ';' *)
68 :			| S_If of exp * stm * stm (* 'if' exp stm 'else' stm *)
69 :			| S_While of exp * stm (* 'while' exp stm *)
70 :	jhr	1444	| S_DoWhile of stm * exp (* 'do' stm 'while' exp *)
71 :	jhr	1115	| S_For of (ty * var * exp) list * exp * exp list * stm
72 :	jhr	1368	(* 'for' '(' inits ';' exp ';' incrs ')' stm *)
73 :			| S_Call of string * exp list (* func '(' args ')' *)
74 :			| S_Return of exp option (* 'return' [ exp ] ';' *)
75 :			| S_Break (* 'break' ';' *)
76 :			| S_Continue (* 'continue' ';' *)
77 :	jhr	1115
78 :			and exp
79 :	jhr	1368	= E_Grp of exp (* "(" e ")" *)
80 :	jhr	1115	| E_AssignOp of exp * assignop * exp (* lvalue op= e *)
81 :	jhr	1640	| E_Cond of exp * exp * exp (* e "?" e ":" e *)
82 :	jhr	1368	| E_BinOp of exp * binop * exp (* e op e *)
83 :			| E_UnOp of unop * exp (* op e *)
84 :			| E_PostOp of exp * postfix (* e op *)
85 :			| E_Apply of string * exp list (* f "(" ... ")" *)
86 :			| E_Subscript of exp * exp (* e "[" e "]" *)
87 :			| E_Select of exp * string (* e "." f *)
88 :			| E_Indirect of exp * string (* e "->" f *)
89 :			| E_Cast of ty * exp (* "(" ty ")" e *)
90 :	jhr	1115	| E_Var of var
91 :			| E_Int of IntegerLit.integer * ty
92 :			| E_Flt of FloatLit.float * ty
93 :			| E_Bool of bool
94 :			| E_Str of string
95 :	jhr	1368	| E_Sizeof of ty (* "sizeof(" ty ")" *)
96 :	jhr	1115
97 :			(* assignment operators *)
98 :			and assignop
99 :			= $= | += | *= | /= | %= | <<= | >>= | &= | ^= | |=
100 :
101 :			(* binary operators in increasing order of precedence *)
102 :			and binop
103 :			= #||
104 :			| #&&
105 :	jhr	1444	| #|
106 :			| #^
107 :			| #&
108 :	jhr	1115	| #== | #!=
109 :			| #< | #<= | #>= | #>
110 :			| #<< | #>>
111 :			| #+ | #-
112 :			| #* | #/ | #%
113 :
114 :			and unop = %- | %! | %& | %* | %~ | %++ | %--
115 :
116 :			and postfix = ^++ | ^--
117 :
118 :			(* smart constructors that add E_Grp wrappers based on operator precedence *)
119 :			local
120 :	jhr	1368	val commaP = 0
121 :			val assignP = 1
122 :			val condP = 2
123 :			val lorP = 3
124 :			val landP = 4
125 :			val borP = 5
126 :	jhr	1444	val bxorP = 6
127 :			val bandP = 7
128 :			val eqP = 8
129 :			val relP = 9
130 :			val shiftP = 10
131 :			val addP = 11
132 :			val mulP = 12
133 :			val castP = 13
134 :			val unaryP = 14
135 :			val preP = 15
136 :			val compundP = 16 (* compound literal *)
137 :			val postP = 17
138 :			val callP = 18
139 :			val subP = 19
140 :			val atomP = 20
141 :	jhr	1115	fun precOfBinop rator = (case rator
142 :	jhr	1368	of #|| => lorP
143 :			| #&& => landP
144 :	jhr	1444	| #| => borP
145 :			| #^ => bxorP
146 :			| #& => bandP
147 :	jhr	1368	| #== => eqP | #!= => eqP
148 :			| #< => relP | #<= => relP | #>= => relP | #> => relP
149 :			| #<< => shiftP | #>> => shiftP
150 :			| #+ => addP | #- => addP
151 :			| #* => mulP | #/ => mulP | #% => mulP
152 :			(* end case *))
153 :	jhr	1115	fun prec (E_Grp _) = atomP
154 :	jhr	1368	| prec (E_AssignOp _) = assignP
155 :	jhr	1640	| prec (E_Cond _) = condP
156 :	jhr	1368	| prec (E_BinOp(_, rator, _)) = precOfBinop rator
157 :			| prec (E_UnOp _) = preP
158 :			| prec (E_PostOp _) = postP
159 :			| prec (E_Apply _) = callP
160 :			| prec (E_Subscript _) = postP
161 :			| prec (E_Select _) = postP
162 :			| prec (E_Indirect _) = postP
163 :	jhr	1444	| prec (E_Cast _) = castP
164 :	jhr	1368	| prec (E_Var _) = atomP
165 :			| prec (E_Int _) = atomP
166 :			| prec (E_Flt _) = atomP
167 :			| prec (E_Bool _) = atomP
168 :			| prec (E_Str _) = atomP
169 :			| prec (E_Sizeof _) = callP
170 :	jhr	1115	in
171 :			fun mkGrp e = if (prec e < atomP) then E_Grp e else e
172 :			fun mkAssignOp (e1, rator, e2) = let
173 :	jhr	1368	val e1' = if prec e1 < unaryP then E_Grp e1 else e1
174 :			val e2' = if prec e2 < assignP then E_Grp e2 else e2
175 :			in
176 :			E_AssignOp(e1', rator, e2')
177 :			end
178 :	jhr	1640	(* note that we over-parenthesize here, but it makes nested conditionals easeier to read *)
179 :			fun mkCond (e1, e2, e3) = E_Cond(
180 :			if prec e1 <= condP then E_Grp e1 else e1,
181 :			if prec e2 <= condP then E_Grp e2 else e2,
182 :			if prec e3 < condP then E_Grp e3 else e3)
183 :	jhr	1115	(* Note that all C binary operators are left associative. *)
184 :			fun mkBinOp (e1, #-, e2 as E_UnOp(%-, _)) = let
185 :	jhr	1368	val e1' = if prec e1 < addP then E_Grp e1 else e1
186 :			val e2' = E_Grp e2
187 :			in
188 :			E_BinOp(e1', #-, e2')
189 :			end
190 :	jhr	1115	| mkBinOp (e1, rator, e2) = let
191 :	jhr	1368	val p = precOfBinop rator
192 :			val e1' = if prec e1 < p then E_Grp e1 else e1
193 :			val e2' = if prec e2 <= p then E_Grp e2 else e2
194 :			in
195 :			E_BinOp(e1', rator, e2')
196 :			end
197 :	jhr	1115	fun mkUnOp (%-, e as E_UnOp(%-, _)) = E_UnOp(%-, E_Grp e)
198 :			| mkUnOp (%-, e as E_UnOp(%--, _)) = E_UnOp(%-, E_Grp e)
199 :			| mkUnOp (%--, e as E_UnOp(%-, _)) = E_UnOp(%--, E_Grp e)
200 :			| mkUnOp (%--, e as E_UnOp(%--, _)) = E_UnOp(%--, E_Grp e)
201 :			| mkUnOp (rator, e) = if prec e < unaryP
202 :	jhr	1368	then E_UnOp(rator, E_Grp e)
203 :			else E_UnOp(rator, e)
204 :	jhr	1115	fun mkPostOp (e, rator) = if prec e < postP
205 :	jhr	1368	then E_PostOp(E_Grp e, rator)
206 :			else E_PostOp(e, rator)
207 :	jhr	1115	fun mkApply (f, args) = E_Apply(f, args)
208 :			fun mkSubscript(e1, e2) = if prec e1 < postP
209 :	jhr	1368	then E_Subscript(E_Grp e1, e2)
210 :			else E_Subscript(e1, e2)
211 :	jhr	1115	fun mkSelect (e, f) = if prec e < postP
212 :	jhr	1368	then E_Select(E_Grp e, f)
213 :			else E_Select(e, f)
214 :	jhr	1115	fun mkIndirect (e, f) = if prec e < postP
215 :	jhr	1368	then E_Indirect(E_Grp e, f)
216 :			else E_Indirect(e, f)
217 :	jhr	1444	fun mkCast (ty, e) = if prec e < castP
218 :			then E_Cast(ty, E_Grp e)
219 :			else E_Cast(ty, e)
220 :	jhr	1115	val mkVar = E_Var
221 :	jhr	1368	fun mkIntTy (n, ty) = if n < 0 then E_UnOp(%-, E_Int(~n, ty)) else E_Int(n, ty)
222 :			fun mkInt n = mkIntTy(n, intTy)
223 :	jhr	1115	fun mkFlt (f, ty) = if FloatLit.isNeg f
224 :	jhr	1368	then E_UnOp(%-, E_Flt(FloatLit.negate f, ty))
225 :			else E_Flt(f, ty)
226 :	jhr	1115	val mkBool = E_Bool
227 :			val mkStr = E_Str
228 :			val mkSizeof = E_Sizeof
229 :			end (* local *)
230 :
231 :			val skip = S_Block[]
232 :
233 :			local
234 :			fun paren (e as E_Grp _) = e
235 :	jhr	1368	| paren e = E_Grp e
236 :	jhr	1115	in
237 :			val mkComment = S_Comment
238 :			fun mkBlock [stm] = stm
239 :			| mkBlock stms = S_Block stms
240 :	jhr	1806	fun unBlock (S_Block stms) = stms
241 :			| unBlock stm = [stm]
242 :	jhr	1368	fun mkDecl (ty, x, init) = S_Decl([], ty, x, init)
243 :	jhr	1715	fun mkDeclInit (ty, x, init) = S_Decl([], ty, x, SOME(I_Exp init))
244 :	jhr	1368	val mkAttrDecl = S_Decl
245 :	jhr	1115	val mkExpStm = S_Exp
246 :			fun mkAssign (e1, e2) = S_Exp(mkAssignOp(e1, $=, e2))
247 :			fun mkIfThenElse (e, b1, b2) = S_If(paren e, b1, b2)
248 :			fun mkIfThen (e, b) = mkIfThenElse (e, b, skip)
249 :			val mkFor = S_For
250 :			fun mkWhile (e, b) = S_While(paren e, b)
251 :	jhr	1444	fun mkDoWhile (b, e) = S_DoWhile(b, paren e)
252 :	jhr	1115	val mkCall = S_Call
253 :			val mkReturn = S_Return
254 :			val mkBreak = S_Break
255 :			val mkContinue = S_Continue
256 :			end (* local *)
257 :
258 :			(* utility functions *)
259 :
260 :			fun varToString x = x
261 :
262 :			fun assignopToString rator = (case rator
263 :	jhr	1368	of $= => "="
264 :			| += => "+="
265 :			| *= => "*="
266 :			| /= => "/="
267 :			| %= => "%="
268 :			| <<= => "<<="
269 :			| >>= => ">>="
270 :			| &= => "&="
271 :			| ^= => "^="
272 :			| |= => "|="
273 :			(* end case *))
274 :	jhr	1115
275 :			fun binopToString rator = (case rator
276 :	jhr	1368	of #|| => "||"
277 :			| #&& => "&&"
278 :			| #== => "=="
279 :	jhr	1444	| #| => "|"
280 :			| #^ => "^"
281 :			| #& => "&"
282 :	jhr	1368	| #!= => "!="
283 :			| #< => "<"
284 :			| #<= => "<="
285 :			| #>= => ">="
286 :			| #> => ">"
287 :			| #<< => "<<"
288 :			| #>> => ">>"
289 :			| #+ => "+"
290 :			| #- => "-"
291 :			| #* => "*"
292 :			| #/ => "/"
293 :			| #% => "%"
294 :			(* end case *))
295 :	jhr	1115
296 :			fun unopToString rator = (case rator
297 :	jhr	1368	of %- => "-"
298 :			| %! => "!"
299 :			| %& => "&"
300 :			| %* => "*"
301 :			| %~ => "~"
302 :			| %++ => "++"
303 :			| %-- => "--"
304 :			(* end case *))
305 :	jhr	1115
306 :			fun postopToString rator = (case rator
307 :	jhr	1368	of ^++ => "++"
308 :			| ^-- => "--"
309 :			(* end case *))
310 :	jhr	1115
311 :	jhr	1640	(* generate verbatim text from a template string by substituting for placeholders
312 :			* Placeholders have the syntax @<id>@ and are replaced with the string associated
313 :			* with <id> in the list of substitutions. If <id> is empty, then no substitution
314 :			* is applied, instead the "@@" is replaced by "@".
315 :			*)
316 :			local
317 :			structure SS = Substring
318 :			in
319 :			fun verbatim sl subs = let
320 :			fun scan (start, ss, n, frags) = (case SS.getc ss
321 :			of SOME(#"@", rest) => let
322 :			val frags = SS.slice(start, 0, SOME n) :: frags
323 :			val (expansion, rest) = scanPlaceholder rest
324 :			in
325 :			scan (rest, rest, 0, expansion::frags)
326 :			end
327 :			| SOME(_, rest) => scan (start, rest, n+1, frags)
328 :			| NONE => SS.concat(List.rev(start::frags))
329 :			(* end case *))
330 :			and scanPlaceholder start = let
331 :			fun scan (ss, n) = (case SS.getc ss
332 :			of NONE => raise Fail "incomplete placeholder"
333 :			| SOME(#"@", rest) => (SS.string(SS.slice(start, 0, SOME n)), rest)
334 :			| SOME(_, rest) => scan (rest, n+1)
335 :			(* end case *))
336 :			val (placeholder, rest) = scan (start, 0)
337 :			in
338 :			if (placeholder = "")
339 :			then (SS.full "@", rest)
340 :			else (case List.find (fn (s, _) => (s = placeholder)) subs
341 :			of SOME(_, expansion) => (SS.full expansion, rest)
342 :			| NONE => raise Fail(concat["unknown placeholder @", placeholder, "@"])
343 :			(* end case *))
344 :			end
345 :			fun expand s = let
346 :			val ss = SS.full s
347 :			in
348 :			scan (ss, ss, 0, [])
349 :			end
350 :			in
351 :			D_Verbatim(List.map expand sl)
352 :			end
353 :			end (* local *)
354 :
355 :	jhr	1301	(* for debugging (not syntactically correct!) *)
356 :	jhr	1115	fun expToString e = let
357 :	jhr	1368	fun e2s (e, l) = (case e
358 :			of E_Grp e => "(" :: e2s(e, ")"::l)
359 :			| E_AssignOp(e1, rator, e2) => e2s(e1, assignopToString rator :: e2s(e2, l))
360 :	jhr	1702	| E_Cond(e1, e2, e3) => "(" :: e2s(e1, "?" :: e2s(e2, ":" :: e2s (e3, ")" :: l)))
361 :	jhr	1368	| E_BinOp(e1, rator, e2) => e2s(e1, binopToString rator :: e2s(e2, l))
362 :			| E_UnOp(rator, e) => unopToString rator :: e2s(e, l)
363 :			| E_PostOp(e, rator) => e2s(e, postopToString rator :: l)
364 :			| E_Apply(f, es) => let
365 :			fun args2s ([], l) = l
366 :			| args2s ([e], l) = e2s(e, l)
367 :			| args2s (e::es, l) = e2s(e, ","::args2s(es, l))
368 :			in
369 :			f :: "(" :: args2s(es, ")"::l)
370 :			end
371 :			| E_Subscript(e1, e2) => e2s(e1, "[" :: e2s(e2, "]"::l))
372 :			| E_Select(e, f) => e2s(e, "." :: f :: l)
373 :			| E_Indirect(e, f) => e2s(e, "->" :: f :: l)
374 :	jhr	1850	| E_Cast(ty, e) => "(ty)" :: e2s(e, l) (* FIXME: need tyToString *)
375 :	jhr	1368	| E_Var x => x::l
376 :			| E_Int(n, _) => IntegerLit.toString n :: l
377 :			| E_Flt(f, _) => FloatLit.toString f :: l
378 :			| E_Bool b => Bool.toString b :: l
379 :			| E_Str s => concat["\"", String.toCString s, "\""] :: l
380 :			| E_Sizeof ty => "sizeof(ty)" :: l
381 :			(* end case *))
382 :			in
383 :			String.concat(e2s(e, []))
384 :			end
385 :	jhr	1115
386 :			end

---

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