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

SCM Repository

[diderot] Annotation of /branches/vis15/src/compiler/codegen/clang.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3989 - (view) (download)

1 : jhr 3768 (* clang.sml
2 :     *
3 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2015 The University of Chicago
6 :     * All rights reserved.
7 :     *
8 : jhr 3769 * An tree representation of programs in a C-like language (e.g., C, C++, CUDA,
9 :     * or OpenCL).
10 : jhr 3768 *)
11 :    
12 :     structure CLang =
13 :     struct
14 :    
15 :     type var = string
16 :     type attr = string (* e.g., "static", "kernel", etc ... *)
17 :    
18 :     datatype ty
19 : jhr 3927 = T_Num of RawTypes.t
20 : jhr 3955 | T_Const of ty (* const annotation; note that T_Const(T_Ptr ty) means
21 :     * that the pointer is constant, whereas T_Ptr(T_Const ty)
22 :     * means that what is pointed to is constant.
23 :     *)
24 : jhr 3768 | T_Ptr of ty
25 : jhr 3769 | T_RestrictPtr of ty (* pointer type with "restrict" annotation *)
26 : jhr 3768 | T_Array of ty * int option
27 :     | T_Named of string
28 : jhr 3769 | T_Template of string * ty list
29 : jhr 3768 | T_Qual of attr * ty (* qualified type *)
30 :    
31 :     datatype typed_var = V of ty * var
32 :    
33 :     val voidTy = T_Named "void"
34 :     val voidPtr = T_Ptr voidTy
35 :     val charTy = T_Named "char"
36 :     val boolTy = T_Named "bool"
37 :     val charPtr = T_Ptr charTy
38 :     val charArrayPtr = T_Ptr charPtr
39 :     val intTy = T_Named "int"
40 :     val int8 = T_Num(RawTypes.RT_Int8)
41 :     val uint8 = T_Num(RawTypes.RT_UInt8)
42 :     val int32 = T_Num(RawTypes.RT_Int32)
43 :     val uint32 = T_Num(RawTypes.RT_UInt32)
44 :     val int64 = T_Num(RawTypes.RT_Int64)
45 :     val float = T_Num(RawTypes.RT_Float)
46 :     val double = T_Num(RawTypes.RT_Double)
47 :    
48 : jhr 3955 (* make a "const ty *" type for some ty *)
49 :     fun constPtrTy ty = T_Ptr(T_Const ty)
50 :    
51 : jhr 3768 datatype decl
52 :     = D_Pragma of string list
53 :     | D_Comment of string list
54 :     (* verbatim text (e.g., preprocessor directives) *)
55 :     | D_Verbatim of string list
56 :     (* global variable declaration *)
57 :     | D_Var of attr list * ty * var * initializer option
58 : jhr 3871 (* TODO: merge D_Proto and D_Func into one by making the body an option *)
59 : jhr 3768 (* function prototype *)
60 :     | D_Proto of attr list * ty * string * param list
61 :     (* function definition *)
62 :     | D_Func of attr list * ty * string * param list * stm
63 : jhr 3871 (* class constructor definition or prototype:
64 : jhr 3870 * D_Constr(attrs, namespace, class, params, inits, body)
65 :     * the inits should be of the form "id(exp)"
66 :     *)
67 : jhr 3871 | D_Constr of attr list * string option * string * param list * exp list * stm option
68 :     (* class destructor definition or prototype *)
69 :     | D_Destr of attr list * string option * string * stm option
70 : jhr 3768 (* struct type declaration; if the third argument is SOME name, then a
71 :     * typedef is generated.
72 :     *)
73 :     | D_StructDef of string option * (ty * string) list * string option
74 : jhr 3812 (* C++ struct/class definition *)
75 :     | D_ClassDef of {
76 :     name : string, (* class/struct name *)
77 :     from : string option, (* optional base class *)
78 : jhr 3870 public : decl list,
79 :     protected : decl list,
80 :     private : decl list
81 : jhr 3812 }
82 : jhr 3989 (* template declaration *)
83 :     | D_Template of template_param list * decl
84 : jhr 3768
85 :     and initializer
86 :     = I_Exp of exp
87 :     | I_Exps of initializer list
88 : jhr 3769 | I_Struct of (string * initializer) list (* C99 labeled struct initializer *)
89 :     | I_Array of (int * initializer) list (* C99 labeled array initializer *)
90 :     | I_Cons of ty * exp list
91 : jhr 3768
92 :     and param = PARAM of attr list * ty * var
93 :    
94 : jhr 3989 and template_param
95 :     = TypeParam of string
96 :     | ConstParam of ty * string
97 :    
98 : jhr 3768 and stm
99 :     = S_Block of stm list (* "{" stms "}" *)
100 :     | S_Comment of string list
101 :     | S_Verbatim of string list
102 :     | S_Decl of attr list * ty * var * initializer option
103 :     (* ty var [ '=' exp ]';' *)
104 :     | S_Exp of exp (* exp ';' *)
105 :     | S_If of exp * stm * stm (* 'if' exp stm 'else' stm *)
106 :     | S_While of exp * stm (* 'while' exp stm *)
107 :     | S_DoWhile of stm * exp (* 'do' stm 'while' exp *)
108 :     | S_For of (ty * var * exp) list * exp * exp list * stm
109 :     (* 'for' '(' inits ';' exp ';' incrs ')' stm *)
110 : jhr 3769 | S_KernCall of string * exp list * exp list
111 :     (* f "<<<" ... ">>>" "(" ... ")" [CUDA] *)
112 : jhr 3768 | S_Return of exp option (* 'return' [ exp ] ';' *)
113 :     | S_Break (* 'break' ';' *)
114 :     | S_Continue (* 'continue' ';' *)
115 :    
116 :     and exp
117 :     = E_Grp of exp (* "(" e ")" *)
118 :     | E_AssignOp of exp * assignop * exp (* lvalue op= e *)
119 :     | E_Cond of exp * exp * exp (* e "?" e ":" e *)
120 :     | E_BinOp of exp * binop * exp (* e op e *)
121 :     | E_UnOp of unop * exp (* op e *)
122 :     | E_PostOp of exp * postfix (* e op *)
123 : jhr 3894 | E_Apply of exp * exp list (* e "(" ... ")" *)
124 :     | E_TApply of string * ty list * exp list
125 :     (* f "<" ... ">" "(" ... ")" *)
126 : jhr 3769 | E_Cons of ty * exp list (* ty "(" ... ")" [C++,CUDA]*)
127 :     | E_New of ty * exp list (* "new" ty "(" ... ")" [C++,CUDA]*)
128 : jhr 3768 | E_Subscript of exp * exp (* e "[" e "]" *)
129 :     | E_Select of exp * string (* e "." f *)
130 :     | E_Indirect of exp * string (* e "->" f *)
131 :     | E_Cast of ty * exp (* "(" ty ")" e *)
132 : jhr 3886 | E_XCast of string * ty * exp (* "xxx_cast<" ty ">(" e ")" [C++] *)
133 : jhr 3769 | E_Vec of ty * exp list (* vector-expression; syntax depends on target [C,OpenCL] *)
134 : jhr 3768 | E_Var of var
135 : jhr 3769 | E_Int of IntLit.t * ty
136 :     | E_Flt of RealLit.t * ty
137 : jhr 3768 | E_Bool of bool
138 :     | E_Str of string
139 :     | E_Char of char
140 :     | E_Sizeof of ty (* "sizeof(" ty ")" *)
141 :    
142 :     (* assignment operators *)
143 :     and assignop
144 :     = $= | += | *= | /= | %= | <<= | >>= | &= | ^= | |=
145 :    
146 :     (* binary operators in increasing order of precedence *)
147 :     and binop
148 :     = #||
149 :     | #&&
150 :     | #|
151 :     | #^
152 :     | #&
153 :     | #== | #!=
154 :     | #< | #<= | #>= | #>
155 :     | #<< | #>>
156 :     | #+ | #-
157 :     | #* | #/ | #%
158 :    
159 :     and unop = %- | %! | %& | %* | %~ | %++ | %--
160 :    
161 :     and postfix = ^++ | ^--
162 :    
163 :     (* smart constructors that add E_Grp wrappers based on operator precedence *)
164 :     local
165 :     val commaP = 0
166 :     val assignP = 1
167 :     val condP = 2
168 :     val lorP = 3
169 :     val landP = 4
170 :     val borP = 5
171 :     val bxorP = 6
172 :     val bandP = 7
173 :     val eqP = 8
174 :     val relP = 9
175 :     val shiftP = 10
176 :     val addP = 11
177 :     val mulP = 12
178 :     val castP = 13
179 :     val unaryP = 14
180 :     val preP = 15
181 :     val compundP = 16 (* compound literal *)
182 :     val postP = 17
183 :     val callP = 18
184 :     val subP = 19
185 :     val atomP = 20
186 :     fun precOfBinop rator = (case rator
187 :     of #|| => lorP
188 :     | #&& => landP
189 :     | #| => borP
190 :     | #^ => bxorP
191 :     | #& => bandP
192 :     | #== => eqP | #!= => eqP
193 :     | #< => relP | #<= => relP | #>= => relP | #> => relP
194 :     | #<< => shiftP | #>> => shiftP
195 :     | #+ => addP | #- => addP
196 :     | #* => mulP | #/ => mulP | #% => mulP
197 :     (* end case *))
198 :     fun prec (E_Grp _) = atomP
199 :     | prec (E_AssignOp _) = assignP
200 :     | prec (E_Cond _) = condP
201 :     | prec (E_BinOp(_, rator, _)) = precOfBinop rator
202 :     | prec (E_UnOp _) = preP
203 :     | prec (E_PostOp _) = postP
204 :     | prec (E_Apply _) = callP
205 : jhr 3894 | prec (E_TApply _) = callP
206 : jhr 3769 | prec (E_Cons _) = callP (* check this *)
207 :     | prec (E_New _) = callP (* check this *)
208 : jhr 3768 | prec (E_Subscript _) = postP
209 :     | prec (E_Select _) = postP
210 :     | prec (E_Indirect _) = postP
211 :     | prec (E_Cast _) = castP
212 : jhr 3886 | prec (E_XCast _) = atomP
213 : jhr 3768 | prec (E_Vec _) = castP
214 :     | prec (E_Var _) = atomP
215 :     | prec (E_Int _) = atomP
216 :     | prec (E_Flt _) = atomP
217 :     | prec (E_Bool _) = atomP
218 :     | prec (E_Str _) = atomP
219 :     | prec (E_Char _) = atomP
220 :     | prec (E_Sizeof _) = callP
221 :     in
222 :     fun mkGrp e = if (prec e < atomP) then E_Grp e else e
223 :     fun mkAssignOp (e1, rator, e2) = let
224 :     val e1' = if prec e1 < unaryP then E_Grp e1 else e1
225 :     val e2' = if prec e2 < assignP then E_Grp e2 else e2
226 :     in
227 :     E_AssignOp(e1', rator, e2')
228 :     end
229 :     (* note that we over-parenthesize here, but it makes nested conditionals easeier to read *)
230 :     fun mkCond (e1, e2, e3) = E_Cond(
231 :     if prec e1 <= condP then E_Grp e1 else e1,
232 :     if prec e2 <= condP then E_Grp e2 else e2,
233 :     if prec e3 < condP then E_Grp e3 else e3)
234 :     (* Note that all C binary operators are left associative. *)
235 :     fun mkBinOp (e1, #-, e2 as E_UnOp(%-, _)) = let
236 :     val e1' = if prec e1 < addP then E_Grp e1 else e1
237 :     val e2' = E_Grp e2
238 :     in
239 :     E_BinOp(e1', #-, e2')
240 :     end
241 :     | mkBinOp (e1, rator, e2) = let
242 :     val p = precOfBinop rator
243 :     val e1' = if prec e1 < p then E_Grp e1 else e1
244 :     val e2' = if prec e2 <= p then E_Grp e2 else e2
245 :     in
246 :     E_BinOp(e1', rator, e2')
247 :     end
248 :     fun mkUnOp (%-, e as E_UnOp(%-, _)) = E_UnOp(%-, E_Grp e)
249 :     | mkUnOp (%-, e as E_UnOp(%--, _)) = E_UnOp(%-, E_Grp e)
250 :     | mkUnOp (%--, e as E_UnOp(%-, _)) = E_UnOp(%--, E_Grp e)
251 :     | mkUnOp (%--, e as E_UnOp(%--, _)) = E_UnOp(%--, E_Grp e)
252 :     | mkUnOp (%&, E_UnOp(%*, e)) = e
253 :     | mkUnOp (%*, E_UnOp(%&, e)) = e
254 :     | mkUnOp (rator, e) = if prec e < unaryP
255 :     then E_UnOp(rator, E_Grp e)
256 :     else E_UnOp(rator, e)
257 :     fun mkPostOp (e, rator) = if prec e < postP
258 :     then E_PostOp(E_Grp e, rator)
259 :     else E_PostOp(e, rator)
260 :     fun mkApply (f, args) = E_Apply(E_Var f, args)
261 : jhr 3769 (* FIXME: check precedence *)
262 : jhr 3768 fun mkApplyExp (e, args) = E_Apply(e, args)
263 : jhr 3894 fun mkTemplateApply (f, tys, args) = E_TApply(f, tys, args)
264 : jhr 3769 val mkCons = E_Cons
265 :     val mkNew = E_New
266 : jhr 3768 fun mkSubscript(e1, e2) = if prec e1 < postP
267 :     then E_Subscript(E_Grp e1, e2)
268 :     else E_Subscript(e1, e2)
269 :     fun mkSelect (e, f) = if prec e < postP
270 :     then E_Select(E_Grp e, f)
271 :     else E_Select(e, f)
272 :     fun mkIndirect (e, f) = if prec e < postP
273 :     then E_Indirect(E_Grp e, f)
274 :     else E_Indirect(e, f)
275 : jhr 3886 fun mkDispatch (e, meth, args) = mkApplyExp(mkSelect(e, meth), args)
276 :     fun mkIndirectDispatch (e, meth, args) = mkApplyExp(mkIndirect(e, meth), args)
277 : jhr 3768 fun mkCast (ty, e) = if prec e < castP
278 :     then E_Cast(ty, E_Grp e)
279 :     else E_Cast(ty, e)
280 : jhr 3886 fun mkConstCast (ty, e) = E_XCast("const_cast", ty, e)
281 :     fun mkDynamicCast (ty, e) = E_XCast("dynamic_cast", ty, e)
282 :     fun mkReinterpretCast (ty, e) = E_XCast("reinterpret_cast", ty, e)
283 :     fun mkStaticCast (ty, e) = E_XCast("static_cast", ty, e)
284 : jhr 3768 val mkVec = E_Vec
285 :     val mkVar = E_Var
286 :     fun mkIntTy (n, ty) = if n < 0 then E_UnOp(%-, E_Int(~n, ty)) else E_Int(n, ty)
287 :     fun mkInt n = mkIntTy(n, intTy)
288 : jhr 3769 fun mkFlt (f, ty) = if RealLit.isNeg f
289 :     then E_UnOp(%-, E_Flt(RealLit.negate f, ty))
290 : jhr 3768 else E_Flt(f, ty)
291 :     val mkBool = E_Bool
292 :     val mkStr = E_Str
293 :     val mkChar = E_Char
294 :     val mkSizeof = E_Sizeof
295 :     fun mkAddrOf x = mkUnOp(%&, x)
296 :     end (* local *)
297 :    
298 :     val skip = S_Block[]
299 :    
300 :     local
301 :     fun paren (e as E_Grp _) = e
302 :     | paren e = E_Grp e
303 :     in
304 :     val mkComment = S_Comment
305 :     fun mkBlock [stm] = stm
306 :     | mkBlock stms = S_Block stms
307 :     fun unBlock (S_Block stms) = stms
308 :     | unBlock stm = [stm]
309 :     fun prependStm (stm, blk) = mkBlock(stm :: unBlock blk)
310 :     fun appendStm (blk, stm) = mkBlock(unBlock blk @ [stm])
311 :     fun concatBlocks blocks = mkBlock(List.concat(List.map unBlock blocks))
312 :     fun mkDecl (ty, x, init) = S_Decl([], ty, x, init)
313 :     fun mkDeclInit (ty, x, init) = S_Decl([], ty, x, SOME(I_Exp init))
314 :     val mkAttrDecl = S_Decl
315 :     val mkExpStm = S_Exp
316 :     fun mkAssign (e1, e2) = S_Exp(mkAssignOp(e1, $=, e2))
317 :     fun mkAssign' (e1, rator, e2) = S_Exp(mkAssignOp(e1, rator, e2))
318 :     fun mkIfThenElse (e, b1, b2) = S_If(paren e, b1, b2)
319 :     fun mkIfThen (e, b) = mkIfThenElse (e, b, skip)
320 :     val mkFor = S_For
321 :     fun mkWhile (e, b) = S_While(paren e, b)
322 :     fun mkDoWhile (b, e) = S_DoWhile(b, paren e)
323 :     fun mkCall (f, args) = S_Exp(mkApply(f, args))
324 :     fun mkCallExp (f, args) = S_Exp(mkApplyExp(f, args))
325 : jhr 3894 fun mkTemplateCall (f, tys, args) = S_Exp(mkTemplateApply(f, tys, args))
326 : jhr 3769 val mkKernCall = S_KernCall
327 : jhr 3768 val mkReturn = S_Return
328 :     val mkBreak = S_Break
329 :     val mkContinue = S_Continue
330 :     end (* local *)
331 :    
332 :     (* utility functions *)
333 :    
334 :     fun varToString x = x
335 :    
336 :     fun assignopToString rator = (case rator
337 :     of $= => "="
338 :     | += => "+="
339 :     | *= => "*="
340 :     | /= => "/="
341 :     | %= => "%="
342 :     | <<= => "<<="
343 :     | >>= => ">>="
344 :     | &= => "&="
345 :     | ^= => "^="
346 :     | |= => "|="
347 :     (* end case *))
348 :    
349 :     fun binopToString rator = (case rator
350 :     of #|| => "||"
351 :     | #&& => "&&"
352 :     | #== => "=="
353 :     | #| => "|"
354 :     | #^ => "^"
355 :     | #& => "&"
356 :     | #!= => "!="
357 :     | #< => "<"
358 :     | #<= => "<="
359 :     | #>= => ">="
360 :     | #> => ">"
361 :     | #<< => "<<"
362 :     | #>> => ">>"
363 :     | #+ => "+"
364 :     | #- => "-"
365 :     | #* => "*"
366 :     | #/ => "/"
367 :     | #% => "%"
368 :     (* end case *))
369 :    
370 :     fun unopToString rator = (case rator
371 :     of %- => "-"
372 :     | %! => "!"
373 :     | %& => "&"
374 :     | %* => "*"
375 :     | %~ => "~"
376 :     | %++ => "++"
377 :     | %-- => "--"
378 :     (* end case *))
379 :    
380 :     fun postopToString rator = (case rator
381 :     of ^++ => "++"
382 :     | ^-- => "--"
383 :     (* end case *))
384 :    
385 :     (* generate verbatim text from a template string by substituting for placeholders
386 :     * Placeholders have the syntax @<id>@ and are replaced with the string associated
387 :     * with <id> in the list of substitutions. If <id> is empty, then no substitution
388 :     * is applied, instead the "@@" is replaced by "@".
389 :     *)
390 :     local
391 : jhr 3770 fun verbatim sl subs = List.map (StringSubst.expand subs) sl
392 : jhr 3768 in
393 :     fun verbatimDcl sl subs = D_Verbatim(verbatim sl subs)
394 :     fun verbatimStm sl subs = S_Verbatim(verbatim sl subs)
395 :     end (* local *)
396 :    
397 :     (* for debugging (not syntactically correct!) *)
398 :     fun expToString e = let
399 :     fun e2s (e, l) = (case e
400 :     of E_Grp e => "(" :: e2s(e, ")"::l)
401 :     | E_AssignOp(e1, rator, e2) => e2s(e1, assignopToString rator :: e2s(e2, l))
402 :     | E_Cond(e1, e2, e3) => "(" :: e2s(e1, "?" :: e2s(e2, ":" :: e2s (e3, ")" :: l)))
403 :     | E_BinOp(e1, rator, e2) => e2s(e1, binopToString rator :: e2s(e2, l))
404 :     | E_UnOp(rator, e) => unopToString rator :: e2s(e, l)
405 :     | E_PostOp(e, rator) => e2s(e, postopToString rator :: l)
406 :     | E_Apply(e, es) => e2s(e, "(" :: args2s(es, ")"::l))
407 : jhr 3894 | E_TApply(f, tys, es) => f :: "<ty>" :: "(" :: args2s(es, ")"::l)
408 : jhr 3769 | E_Cons(ty, es) => e2s(e, "ty(" :: args2s(es, ")"::l))
409 :     | E_New(ty, es) => e2s(e, "new ty (" :: args2s(es, ")"::l))
410 : jhr 3768 | E_Subscript(e1, e2) => e2s(e1, "[" :: e2s(e2, "]"::l))
411 :     | E_Select(e, f) => e2s(e, "." :: f :: l)
412 :     | E_Indirect(e, f) => e2s(e, "->" :: f :: l)
413 :     | E_Cast(ty, e) => "(ty)" :: e2s(e, l) (* FIXME: need tyToString *)
414 : jhr 3886 | E_XCast(c, ty, e) => c :: "<ty>(" :: e2s(e, ")" :: l) (* FIXME: need tyToString *)
415 : jhr 3768 | E_Vec(ty, args) => "(vec)(" :: args2s(args, ")"::l) (* FIXME: need tyToString *)
416 :     | E_Var x => x::l
417 : jhr 3769 | E_Int(n, _) => IntLit.toString n :: l
418 :     | E_Flt(f, _) => RealLit.toString f :: l
419 : jhr 3768 | E_Bool b => Bool.toString b :: l
420 :     | E_Str s => "\"" :: String.toCString s :: "\"" :: l
421 :     | E_Char c => "'" :: Char.toCString c :: "'" :: l
422 :     | E_Sizeof ty => "sizeof(ty)" :: l
423 :     (* end case *))
424 :     and args2s ([], l) = l
425 :     | args2s ([e], l) = e2s(e, l)
426 :     | args2s (e::es, l) = e2s(e, ","::args2s(es, l))
427 :     in
428 :     String.concat(e2s(e, []))
429 :     end
430 :    
431 :     end

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