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

SCM Repository

[diderot] Annotation of /branches/pure-cfg/src/compiler/codegen/clang.sml
ViewVC logotype

Annotation of /branches/pure-cfg/src/compiler/codegen/clang.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 525 - (view) (download)

1 : jhr 520 (* 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 : jhr 522 * or OpenCL). The purpose of this code is to commonality between the various
8 :     * backends, which are all generating C-like code.
9 : jhr 520 *)
10 :    
11 :     structure CLang =
12 : jhr 521 struct
13 : jhr 520
14 : jhr 522 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
21 :     | T_Named of string
22 :    
23 : jhr 525 val int32 = T_Num(RawTypes.RT_Int32)
24 :     val int64 = T_Num(RawTypes.RT_Int64)
25 :     val float = T_Num(RawTypes.RT_Float)
26 :     val double = T_Num(RawTypes.RT_Double)
27 :    
28 : jhr 522 datatype decl
29 : jhr 525 = D_Comment of string list
30 :     | D_Var of attr list * ty * var
31 :     | D_Func of attr list * ty * string * param list * stm
32 : jhr 522
33 :     and param = PARAM of attr * ty * var
34 :    
35 :     and stm
36 : jhr 525 = S_Block of stm list (* "{" stms "}" *)
37 :     | S_Comment of string list
38 :     | S_Decl of ty * var * exp option (* ty var [ '=' exp ]';' *)
39 :     | S_Assign of exp * exp (* lvalue '=' exp ';' *)
40 :     | S_If of exp * stm * stm (* 'if' exp stm 'else' stm *)
41 :     | S_While of exp * stm (* 'while' exp stm *)
42 : jhr 522 | S_Call of string * exp list
43 : jhr 525 | S_Return of exp option (* 'return' [ exp ] ';' *)
44 : jhr 522
45 :     and exp
46 : jhr 520 = E_Grp of exp (* "(" e ")" *)
47 :     | E_BinOp of exp * binop * exp (* e op e *)
48 :     | E_UnOp of unop * exp (* op e *)
49 :     | E_Apply of string * exp list (* f "(" ... ")" *)
50 : jhr 521 | E_Subscript of exp * exp (* e "[" e "]" *)
51 :     | E_Select of exp * string (* e "." f *)
52 : jhr 525 | E_Indirect of exp * string (* e "->" f *)
53 : jhr 521 | E_Cast of ty * exp (* "(" ty ")" e *)
54 :     | E_Var of var
55 : jhr 525 | E_Int of IntegerLit.integer * ty
56 :     | E_Flt of FloatLit.float * ty
57 :     | E_Bool of bool
58 : jhr 520
59 : jhr 521 (* binary operators in increasing order of precedence *)
60 :     and binop
61 :     = #||
62 :     | #&&
63 :     | #== | #!=
64 :     | #< | #<= | #>= | #>
65 :     | #+ | #-
66 :     | #* | #/ | #%
67 :    
68 :     and unop = %- | %! | %& | %* | %~
69 :    
70 : jhr 522 (* smart constructors that add E_Grp wrappers based on operator precedence *)
71 : jhr 521 local
72 :     val commaP = 0
73 :     val assignP = 1
74 :     val condP = 2
75 :     val lorP = 3
76 :     val landP = 4
77 :     val borP = 5
78 :     val bandP = 6
79 :     val eqP = 7
80 :     val relP = 8
81 :     val shiftP = 9
82 :     val addP = 10
83 :     val mulP = 11
84 :     val unaryP = 12
85 :     val preP = 13
86 :     val compundP = 14 (* compound literal *)
87 :     val postP = 15
88 :     val callP = 16
89 :     val subP = 17
90 :     val atomP = 18
91 :     fun precOfBinop rator = (case rator
92 :     of #|| => lorP
93 :     | #&& => landP
94 :     | #== => eqP | #!= => eqP
95 :     | #< => relP | #<= => relP | #>= => relP | #> => relP
96 :     | #+ => addP | #- => addP
97 :     | #* => mulP | #/ => mulP | #% => mulP
98 :     (* end case *))
99 :     fun prec (E_Grp _) = atomP
100 :     | prec (E_BinOp(_, rator, _)) = precOfBinop rator
101 :     | prec (E_UnOp(rator, _)) = preP
102 :     | prec (E_Apply _) = callP
103 :     | prec (E_Subscript _) = postP
104 :     | prec (E_Select _) = postP
105 : jhr 525 | prec (E_Indirect _) = postP
106 : jhr 521 | prec (E_Cast _) = unaryP
107 :     | prec (E_Var _) = atomP
108 : jhr 525 | prec (E_Int _) = atomP
109 :     | prec (E_Flt _) = atomP
110 :     | prec (E_Bool _) = atomP
111 : jhr 521 in
112 :     fun mkGrp e = if (prec e < atomP) then E_Grp e else e
113 : jhr 522 (* Note that all C binary operators are left associative. *)
114 : jhr 521 fun mkBinOp (e1, rator, e2) = let
115 :     val p = precOfBinop rator
116 :     val e1' = if prec e1 < p then E_Grp e1 else e1
117 :     val e2' = if prec e2 <= p then E_Grp e2 else e2
118 :     in
119 :     E_BinOp(e1', rator, e2')
120 :     end
121 :     fun mkUnOp (rator, e) = if prec e < unaryP
122 :     then E_UnOp(rator, E_Grp e)
123 :     else E_UnOp(rator, e)
124 :     fun mkApply (f, args) = E_Apply(f, args)
125 :     fun mkSubscript(e1, e2) = if prec e1 < postP
126 :     then E_Subscript(E_Grp e1, e2)
127 :     else E_Subscript(e1, e2)
128 :     fun mkSelect (e, f) = if prec e < postP
129 :     then E_Select(E_Grp e, f)
130 :     else E_Select(e, f)
131 : jhr 525 fun mkIndirect (e, f) = if prec e < postP
132 :     then E_Indirect(E_Grp e, f)
133 :     else E_Indirect(e, f)
134 : jhr 521 fun mkCast (ty, e) = E_Cast(ty, e)
135 :     val mkVar = E_Var
136 : jhr 525 val mkInt = E_Int
137 :     val mkFlt = E_Flt
138 :     val mkBool = E_Bool
139 : jhr 521 end (* local *)
140 :    
141 : jhr 525 val skip = S_Block[]
142 : jhr 522
143 :     local
144 :     fun paren (e as E_Grp _) = e
145 :     | paren e = E_Grp e
146 :     in
147 : jhr 525 fun mkBlock [stm] = stm
148 :     | mkBlock stms = S_Block stms
149 :     val mkAssign = S_Assign
150 : jhr 522 fun mkIfThenElse (e, b1, b2) = S_If(paren e, b1, b2)
151 :     fun mkIfThen (e, b) = mkIfThenElse (e, b, skip)
152 :     fun mkWhile (e, b) = S_While(paren e, b)
153 :     end (* local *)
154 :    
155 : jhr 525 (* utility functions *)
156 :    
157 :     fun varToString x = x
158 :    
159 :     fun binopToString rator = (case rator
160 :     of #|| => "||"
161 :     | #&& => "&&"
162 :     | #== => "=="
163 :     | #!= => "!="
164 :     | #< => "<"
165 :     | #<= => "<="
166 :     | #>= => ">="
167 :     | #> => ">"
168 :     | #+ => "+"
169 :     | #- => "-"
170 :     | #* => "*"
171 :     | #/ => "/"
172 :     | #% => "%"
173 :     (* end case *))
174 :    
175 :     fun unopToString rator = (case rator
176 :     of %- => "-"
177 :     | %! => "!"
178 :     | %& => "&"
179 :     | %* => "*"
180 :     | %~ => "~"
181 :     (* end case *))
182 :    
183 : jhr 520 end

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