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

SCM Repository

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

Annotation of /trunk/src/compiler/codegen/clang.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1232 - (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 :     type attr = string (* e.g., "static", "kernel", etc ... *)
16 :    
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 :    
23 :     val voidTy = T_Named "void"
24 :     val charPtr = T_Ptr(T_Named "char")
25 : jhr 1232 val intTy = T_Named "int"
26 : jhr 1115 val int32 = T_Num(RawTypes.RT_Int32)
27 :     val uint32 = T_Num(RawTypes.RT_UInt32)
28 :     val int64 = T_Num(RawTypes.RT_Int64)
29 :     val float = T_Num(RawTypes.RT_Float)
30 :     val double = T_Num(RawTypes.RT_Double)
31 :    
32 :     datatype decl
33 :     = D_Comment of string list
34 :     (* verbatim text (e.g., preprocessor directives) *)
35 :     | D_Verbatim of string list
36 :     (* global variable declaration *)
37 :     | D_Var of attr list * ty * var * initializer option
38 :     (* function definition *)
39 :     | D_Func of attr list * ty * string * param list * stm
40 :     (* typedef of struct type *)
41 :     | D_StructDef of (ty * string) list * string
42 :    
43 :     and initializer
44 :     = I_Exp of exp
45 :     | I_Struct of (string * initializer) list
46 :     | I_Array of (int * initializer) list
47 :    
48 :     and param = PARAM of attr list * ty * var
49 :    
50 :     and stm
51 :     = S_Block of stm list (* "{" stms "}" *)
52 :     | S_Comment of string list
53 :     | S_Decl of ty * var * initializer option (* ty var [ '=' exp ]';' *)
54 :     | S_Exp of exp (* exp ';' *)
55 :     | S_If of exp * stm * stm (* 'if' exp stm 'else' stm *)
56 :     | S_While of exp * stm (* 'while' exp stm *)
57 :     | S_For of (ty * var * exp) list * exp * exp list * stm
58 :     (* 'for' '(' inits ';' exp ';' incrs ')' stm *)
59 :     | S_Call of string * exp list (* func '(' args ')' *)
60 :     | S_Return of exp option (* 'return' [ exp ] ';' *)
61 :     | S_Break (* 'break' ';' *)
62 :     | S_Continue (* 'continue' ';' *)
63 :    
64 :     and exp
65 :     = E_Grp of exp (* "(" e ")" *)
66 :     | E_AssignOp of exp * assignop * exp (* lvalue op= e *)
67 :     | E_BinOp of exp * binop * exp (* e op e *)
68 :     | E_UnOp of unop * exp (* op e *)
69 :     | E_PostOp of exp * postfix (* e op *)
70 :     | E_Apply of string * exp list (* f "(" ... ")" *)
71 :     | E_Subscript of exp * exp (* e "[" e "]" *)
72 :     | E_Select of exp * string (* e "." f *)
73 :     | E_Indirect of exp * string (* e "->" f *)
74 :     | E_Cast of ty * exp (* "(" ty ")" e *)
75 :     | E_Var of var
76 :     | E_Int of IntegerLit.integer * ty
77 :     | E_Flt of FloatLit.float * ty
78 :     | E_Bool of bool
79 :     | E_Str of string
80 :     | E_Sizeof of ty (* "sizeof(" ty ")" *)
81 :    
82 :     (* assignment operators *)
83 :     and assignop
84 :     = $= | += | *= | /= | %= | <<= | >>= | &= | ^= | |=
85 :    
86 :     (* binary operators in increasing order of precedence *)
87 :     and binop
88 :     = #||
89 :     | #&&
90 :     | #== | #!=
91 :     | #< | #<= | #>= | #>
92 :     | #<< | #>>
93 :     | #+ | #-
94 :     | #* | #/ | #%
95 :    
96 :     and unop = %- | %! | %& | %* | %~ | %++ | %--
97 :    
98 :     and postfix = ^++ | ^--
99 :    
100 :     (* smart constructors that add E_Grp wrappers based on operator precedence *)
101 :     local
102 :     val commaP = 0
103 :     val assignP = 1
104 :     val condP = 2
105 :     val lorP = 3
106 :     val landP = 4
107 :     val borP = 5
108 :     val bandP = 6
109 :     val eqP = 7
110 :     val relP = 8
111 :     val shiftP = 9
112 :     val addP = 10
113 :     val mulP = 11
114 :     val unaryP = 12
115 :     val preP = 13
116 :     val compundP = 14 (* compound literal *)
117 :     val postP = 15
118 :     val callP = 16
119 :     val subP = 17
120 :     val atomP = 18
121 :     fun precOfBinop rator = (case rator
122 :     of #|| => lorP
123 :     | #&& => landP
124 :     | #== => eqP | #!= => eqP
125 :     | #< => relP | #<= => relP | #>= => relP | #> => relP
126 :     | #<< => shiftP | #>> => shiftP
127 :     | #+ => addP | #- => addP
128 :     | #* => mulP | #/ => mulP | #% => mulP
129 :     (* end case *))
130 :     fun prec (E_Grp _) = atomP
131 :     | prec (E_AssignOp _) = assignP
132 :     | prec (E_BinOp(_, rator, _)) = precOfBinop rator
133 :     | prec (E_UnOp _) = preP
134 :     | prec (E_PostOp _) = postP
135 :     | prec (E_Apply _) = callP
136 :     | prec (E_Subscript _) = postP
137 :     | prec (E_Select _) = postP
138 :     | prec (E_Indirect _) = postP
139 :     | prec (E_Cast _) = unaryP
140 :     | prec (E_Var _) = atomP
141 :     | prec (E_Int _) = atomP
142 :     | prec (E_Flt _) = atomP
143 :     | prec (E_Bool _) = atomP
144 :     | prec (E_Str _) = atomP
145 :     | prec (E_Sizeof _) = callP
146 :     in
147 :     fun mkGrp e = if (prec e < atomP) then E_Grp e else e
148 :     fun mkAssignOp (e1, rator, e2) = let
149 :     val e1' = if prec e1 < unaryP then E_Grp e1 else e1
150 :     val e2' = if prec e2 < assignP then E_Grp e2 else e2
151 :     in
152 :     E_AssignOp(e1', rator, e2')
153 :     end
154 :     (* Note that all C binary operators are left associative. *)
155 :     fun mkBinOp (e1, #-, e2 as E_UnOp(%-, _)) = let
156 :     val e1' = if prec e1 < addP then E_Grp e1 else e1
157 :     val e2' = E_Grp e2
158 :     in
159 :     E_BinOp(e1', #-, e2')
160 :     end
161 :     | mkBinOp (e1, rator, e2) = let
162 :     val p = precOfBinop rator
163 :     val e1' = if prec e1 < p then E_Grp e1 else e1
164 :     val e2' = if prec e2 <= p then E_Grp e2 else e2
165 :     in
166 :     E_BinOp(e1', rator, e2')
167 :     end
168 :     fun mkUnOp (%-, e as E_UnOp(%-, _)) = E_UnOp(%-, E_Grp e)
169 :     | mkUnOp (%-, e as E_UnOp(%--, _)) = E_UnOp(%-, E_Grp e)
170 :     | mkUnOp (%--, e as E_UnOp(%-, _)) = E_UnOp(%--, E_Grp e)
171 :     | mkUnOp (%--, e as E_UnOp(%--, _)) = E_UnOp(%--, E_Grp e)
172 :     | mkUnOp (rator, e) = if prec e < unaryP
173 :     then E_UnOp(rator, E_Grp e)
174 :     else E_UnOp(rator, e)
175 :     fun mkPostOp (e, rator) = if prec e < postP
176 :     then E_PostOp(E_Grp e, rator)
177 :     else E_PostOp(e, rator)
178 :     fun mkApply (f, args) = E_Apply(f, args)
179 :     fun mkSubscript(e1, e2) = if prec e1 < postP
180 :     then E_Subscript(E_Grp e1, e2)
181 :     else E_Subscript(e1, e2)
182 :     fun mkSelect (e, f) = if prec e < postP
183 :     then E_Select(E_Grp e, f)
184 :     else E_Select(e, f)
185 :     fun mkIndirect (e, f) = if prec e < postP
186 :     then E_Indirect(E_Grp e, f)
187 :     else E_Indirect(e, f)
188 :     fun mkCast (ty, e) = E_Cast(ty, e)
189 :     val mkVar = E_Var
190 :     fun mkInt (n, ty) = if n < 0 then E_UnOp(%-, E_Int(~n, ty)) else E_Int(n, ty)
191 :     fun mkFlt (f, ty) = if FloatLit.isNeg f
192 :     then E_UnOp(%-, E_Flt(FloatLit.negate f, ty))
193 :     else E_Flt(f, ty)
194 :     val mkBool = E_Bool
195 :     val mkStr = E_Str
196 :     val mkSizeof = E_Sizeof
197 :     end (* local *)
198 :    
199 :     val skip = S_Block[]
200 :    
201 :     local
202 :     fun paren (e as E_Grp _) = e
203 :     | paren e = E_Grp e
204 :     in
205 :     val mkComment = S_Comment
206 :     fun mkBlock [stm] = stm
207 :     | mkBlock stms = S_Block stms
208 :     val mkDecl = S_Decl
209 :     val mkExpStm = S_Exp
210 :     fun mkAssign (e1, e2) = S_Exp(mkAssignOp(e1, $=, e2))
211 :     fun mkIfThenElse (e, b1, b2) = S_If(paren e, b1, b2)
212 :     fun mkIfThen (e, b) = mkIfThenElse (e, b, skip)
213 :     val mkFor = S_For
214 :     fun mkWhile (e, b) = S_While(paren e, b)
215 :     val mkCall = S_Call
216 :     val mkReturn = S_Return
217 :     val mkBreak = S_Break
218 :     val mkContinue = S_Continue
219 :     end (* local *)
220 :    
221 :     (* utility functions *)
222 :    
223 :     fun varToString x = x
224 :    
225 :     fun assignopToString rator = (case rator
226 :     of $= => "="
227 :     | += => "+="
228 :     | *= => "*="
229 :     | /= => "/="
230 :     | %= => "%="
231 :     | <<= => "<<="
232 :     | >>= => ">>="
233 :     | &= => "&="
234 :     | ^= => "^="
235 :     | |= => "|="
236 :     (* end case *))
237 :    
238 :     fun binopToString rator = (case rator
239 :     of #|| => "||"
240 :     | #&& => "&&"
241 :     | #== => "=="
242 :     | #!= => "!="
243 :     | #< => "<"
244 :     | #<= => "<="
245 :     | #>= => ">="
246 :     | #> => ">"
247 :     | #<< => "<<"
248 :     | #>> => ">>"
249 :     | #+ => "+"
250 :     | #- => "-"
251 :     | #* => "*"
252 :     | #/ => "/"
253 :     | #% => "%"
254 :     (* end case *))
255 :    
256 :     fun unopToString rator = (case rator
257 :     of %- => "-"
258 :     | %! => "!"
259 :     | %& => "&"
260 :     | %* => "*"
261 :     | %~ => "~"
262 :     | %++ => "++"
263 :     | %-- => "--"
264 :     (* end case *))
265 :    
266 :     fun postopToString rator = (case rator
267 :     of ^++ => "++"
268 :     | ^-- => "--"
269 :     (* end case *))
270 :    
271 :     fun expToString e = let
272 :     fun e2s (e, l) = (case e
273 :     of E_Grp e => "(" :: e2s(e, ")"::l)
274 :     | E_AssignOp(e1, rator, e2) => e2s(e1, assignopToString rator :: e2s(e2, l))
275 :     | E_BinOp(e1, rator, e2) => e2s(e1, binopToString rator :: e2s(e2, l))
276 :     | E_UnOp(rator, e) => unopToString rator :: e2s(e, l)
277 :     | E_PostOp(e, rator) => e2s(e, postopToString rator :: l)
278 :     | E_Apply(f, es) => let
279 :     fun args2s ([], l) = l
280 :     | args2s ([e], l) = e2s(e, l)
281 :     | args2s (e::es, l) = e2s(e, ","::args2s(es, l))
282 :     in
283 :     f :: "(" :: args2s(es, ")"::l)
284 :     end
285 :     | E_Subscript(e1, e2) => e2s(e1, "[" :: e2s(e2, "]"::l))
286 :     | E_Select(e, f) => e2s(e, "." :: f :: l)
287 :     | E_Indirect(e, f) => e2s(e, "->" :: f :: l)
288 :     | E_Cast(ty, e) => "(ty)" :: e2s(e, l) (* FIXME *)
289 :     | E_Var x => x::l
290 :     | E_Int(n, _) => IntegerLit.toString n :: l
291 :     | E_Flt(f, _) => FloatLit.toString f :: l
292 :     | E_Bool b => Bool.toString b :: l
293 :     | E_Str s => concat["\"", String.toCString s, "\""] :: l
294 :     | E_Sizeof ty => "sizeof(ty)" :: l
295 :     (* end case *))
296 :     in
297 :     String.concat(e2s(e, []))
298 :     end
299 :    
300 :     end

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