]>
Commit | Line | Data |
---|---|---|
1 | (* L3 Compiler | |
2 | * Abstract Syntax Trees | |
3 | * Author: Alex Vaynberg | |
4 | * Modified: Frank Pfenning <fp@cs.cmu.edu> | |
5 | * Modified: Joshua Wise <jwise@andrew.cmu.edu> | |
6 | * Modified: Chris Lu <czl@andrew.cmu.edu> | |
7 | * | |
8 | * Uses pretty printing library | |
9 | * structure PP -- see util/pp.sml | |
10 | *) | |
11 | ||
12 | signature AST = | |
13 | sig | |
14 | type ident = Symbol.symbol | |
15 | ||
16 | datatype vtype = Int | Typedef of ident | Pointer of vtype | Array of vtype | TNull | |
17 | val typeeq : vtype * vtype -> bool | |
18 | val castable : vtype * vtype -> bool (* true if the second type can be casted to the first implicitly *) | |
19 | type variable = ident * vtype | |
20 | datatype typedef = Struct of variable list | |
21 | | MarkedTypedef of typedef Mark.marked | |
22 | ||
23 | datatype oper = | |
24 | PLUS | |
25 | | MINUS | |
26 | | TIMES | |
27 | | DIVIDEDBY | |
28 | | MODULO | |
29 | | NEGATIVE (* unary minus *) | |
30 | | LSH | |
31 | | RSH | |
32 | | LOGOR | |
33 | | LOGAND | |
34 | | BITAND | |
35 | | BITXOR | |
36 | | BITOR | |
37 | | BITNOT | |
38 | | BANG (* logical not *) | |
39 | | NEQ | |
40 | | EQ | |
41 | | LT | |
42 | | LE | |
43 | | GE | |
44 | | GT | |
45 | ||
46 | datatype exp = | |
47 | Var of ident | |
48 | | ConstExp of Word32.word | |
49 | | OpExp of oper * exp list | |
50 | | Marked of (* Kane *) exp Mark.marked | |
51 | | FuncCall of ident * (exp list) | |
52 | | Member of exp * ident | |
53 | | DerefMember of exp * ident | |
54 | | Dereference of exp | |
55 | | ArrIndex of exp * exp | |
56 | | New of vtype | |
57 | | NewArr of vtype * exp | |
58 | | Null | |
59 | and stm = | |
60 | Assign of exp * exp | |
61 | | AsnOp of oper * exp * exp | |
62 | | Effect of exp (* Just side effect the expression *) | |
63 | | Return of exp | |
64 | | Nop | |
65 | | Break | |
66 | | Continue | |
67 | | If of exp * stm list * stm list option | |
68 | | For of stm option * exp * stm option * stm list | |
69 | | While of exp * stm list | |
70 | | MarkedStm of stm Mark.marked | |
71 | ||
72 | datatype function = | |
73 | Extern of vtype * (variable list) | |
74 | | Function of vtype * (variable list) * (variable list) * stm list | |
75 | | MarkedFunction of function Mark.marked | |
76 | ||
77 | type program = typedef Symbol.table * function Symbol.table | |
78 | ||
79 | (* print as source, with redundant parentheses *) | |
80 | structure Print : | |
81 | sig | |
82 | val pp_exp : exp -> string | |
83 | val pp_type : vtype -> string | |
84 | val pp_stm : stm -> string | |
85 | val pp_program : program -> string | |
86 | end | |
87 | end | |
88 | ||
89 | structure Ast :> AST = | |
90 | struct | |
91 | type ident = Symbol.symbol | |
92 | ||
93 | datatype vtype = Int | Typedef of ident | Pointer of vtype | Array of vtype | TNull | |
94 | fun typeeq (Int, Int) = true | |
95 | | typeeq (Typedef a, Typedef b) = (Symbol.name a) = (Symbol.name b) | |
96 | | typeeq (Pointer a, Pointer b) = typeeq (a, b) | |
97 | | typeeq (Array a, Array b) = typeeq (a, b) | |
98 | | typeeq (TNull, TNull) = true | |
99 | | typeeq _ = false | |
100 | fun castable (Pointer _, TNull) = true | |
101 | | castable (Array _, TNull) = true | |
102 | | castable (a, b) = typeeq (a, b) | |
103 | type variable = ident * vtype | |
104 | datatype typedef = Struct of variable list | |
105 | | MarkedTypedef of typedef Mark.marked | |
106 | ||
107 | datatype oper = | |
108 | PLUS | |
109 | | MINUS | |
110 | | TIMES | |
111 | | DIVIDEDBY | |
112 | | MODULO | |
113 | | NEGATIVE (* unary minus *) | |
114 | | LSH | |
115 | | RSH | |
116 | | LOGOR | |
117 | | LOGAND | |
118 | | BITAND | |
119 | | BITXOR | |
120 | | BITOR | |
121 | | BITNOT | |
122 | | BANG | |
123 | | NEQ | |
124 | | EQ | |
125 | | LT | |
126 | | LE | |
127 | | GE | |
128 | | GT | |
129 | ||
130 | datatype exp = | |
131 | Var of ident | |
132 | | ConstExp of Word32.word | |
133 | | OpExp of oper * exp list | |
134 | | Marked of exp Mark.marked | |
135 | | FuncCall of ident * (exp list) | |
136 | | Member of exp * ident | |
137 | | DerefMember of exp * ident | |
138 | | Dereference of exp | |
139 | | ArrIndex of exp * exp | |
140 | | New of vtype | |
141 | | NewArr of vtype * exp | |
142 | | Null | |
143 | and stm = | |
144 | Assign of exp * exp | |
145 | | AsnOp of oper * exp * exp | |
146 | | Effect of exp (* Just side effect the expression *) | |
147 | | Return of exp | |
148 | | Nop | |
149 | | Break | |
150 | | Continue | |
151 | | If of exp * stm list * stm list option | |
152 | | For of stm option * exp * stm option * stm list | |
153 | | While of exp * stm list | |
154 | | MarkedStm of stm Mark.marked | |
155 | ||
156 | datatype function = | |
157 | Extern of vtype * (variable list) | |
158 | | Function of vtype * (variable list) * (variable list) * stm list | |
159 | | MarkedFunction of function Mark.marked | |
160 | ||
161 | type program = typedef Symbol.table * function Symbol.table | |
162 | ||
163 | (* print programs and expressions in source form | |
164 | * using redundant parentheses to clarify precedence | |
165 | *) | |
166 | structure Print = | |
167 | struct | |
168 | fun pp_ident id = Symbol.name id | |
169 | ||
170 | fun pp_oper PLUS = "+" | |
171 | | pp_oper MINUS = "-" | |
172 | | pp_oper TIMES = "*" | |
173 | | pp_oper DIVIDEDBY = "/" | |
174 | | pp_oper MODULO = "%" | |
175 | | pp_oper NEGATIVE = "-" | |
176 | | pp_oper LSH = "<<" | |
177 | | pp_oper RSH = ">>" | |
178 | | pp_oper LOGAND = "&&" | |
179 | | pp_oper LOGOR = "||" | |
180 | | pp_oper BITAND = "&" | |
181 | | pp_oper BITXOR = "^" | |
182 | | pp_oper BITOR = "|" | |
183 | | pp_oper BITNOT = "~" | |
184 | | pp_oper BANG = "!" | |
185 | | pp_oper NEQ = "!=" | |
186 | | pp_oper EQ = "==" | |
187 | | pp_oper LT = "<" | |
188 | | pp_oper LE = "<=" | |
189 | | pp_oper GT = ">" | |
190 | | pp_oper GE = ">=" | |
191 | ||
192 | fun pp_exp (Var(id)) = pp_ident id | |
193 | | pp_exp (ConstExp(c)) = Word32Signed.toString c | |
194 | | pp_exp (OpExp(oper, [e])) = | |
195 | pp_oper oper ^ "(" ^ pp_exp e ^ ")" | |
196 | | pp_exp (OpExp(oper, [e1,e2])) = | |
197 | "(" ^ pp_exp e1 ^ " " ^ pp_oper oper | |
198 | ^ " " ^ pp_exp e2 ^ ")" | |
199 | | pp_exp (OpExp(oper, _)) = | |
200 | pp_oper oper | |
201 | | pp_exp (FuncCall(id, l)) = pp_ident id ^ "(" ^ pp_expl l ^ ")" | |
202 | | pp_exp (Marked(marked_exp)) = | |
203 | pp_exp (Mark.data marked_exp) | |
204 | | pp_exp (Member(e, i)) = pp_exp e ^ "." ^ pp_ident i | |
205 | | pp_exp (DerefMember(e, i)) = pp_exp e ^ "->" ^ pp_ident i | |
206 | | pp_exp (Dereference(e)) = "*(" ^ pp_exp e ^ ")" | |
207 | | pp_exp (ArrIndex(e1, e2)) = pp_exp e1 ^ "[" ^pp_exp e2 ^ "]" | |
208 | | pp_exp (New t) = "new(" ^ pp_type t ^ ")" | |
209 | | pp_exp (NewArr (t, s)) = "new(" ^ pp_type t ^ "[" ^ pp_exp s ^ "])" | |
210 | | pp_exp Null = "NULL" | |
211 | ||
212 | and pp_expl nil = "" | |
213 | | pp_expl (e::a::l) = (pp_exp e) ^ ", " ^ (pp_expl (a::l)) | |
214 | | pp_expl (e::l) = (pp_exp e) ^ (pp_expl l) | |
215 | ||
216 | and pp_stm (Assign (e1,e2)) = | |
217 | pp_exp e1 ^ " = " ^ pp_exp e2 ^ ";\n" | |
218 | | pp_stm (AsnOp (oop, e1, e2)) = | |
219 | pp_exp e1 ^ " " ^ pp_oper oop ^ "= " ^ pp_exp e2 ^ ";\n" | |
220 | | pp_stm (Effect (e)) = | |
221 | pp_exp e ^ ";\n" | |
222 | | pp_stm (Return e) = | |
223 | "return " ^ pp_exp e ^ ";\n" | |
224 | | pp_stm Nop = ";\n" | |
225 | | pp_stm Break = "break;\n" | |
226 | | pp_stm Continue = "continue;\n" | |
227 | | pp_stm (If (e, s, NONE)) = "if ("^pp_exp e^")\n"^pp_block s | |
228 | | pp_stm (If (e, s, SOME s2)) = "if ("^pp_exp e^")\n"^pp_block s^"else\n"^pp_block s2 | |
229 | | pp_stm (While (e, s)) = "while ("^pp_exp e^")\n"^pp_block s | |
230 | | pp_stm (For (so1, e, so2, s)) = "for ("^ (if (isSome so1) then pp_stm (valOf so1) else "") ^ pp_exp e ^ (if(isSome so2) then pp_stm (valOf so2) else "") ^ ")\n" ^ pp_block s | |
231 | | pp_stm (MarkedStm m) = pp_stm (Mark.data m) | |
232 | ||
233 | and pp_block (nil) = ";" | |
234 | | pp_block (a::nil) = pp_stm a | |
235 | | pp_block (l) = let | |
236 | val contents = map pp_stm l | |
237 | in | |
238 | "{\n" ^ String.concat contents ^ "}\n" | |
239 | end | |
240 | ||
241 | and pp_stms nil = "" | |
242 | | pp_stms (s::ss) = pp_stm s ^ "\n" ^ pp_stms ss | |
243 | ||
244 | and pp_type Int = "int" | |
245 | | pp_type (Typedef i) = pp_ident i | |
246 | | pp_type (Pointer t) = pp_type t ^ "*" | |
247 | | pp_type (Array t) = pp_type t ^ "[]" | |
248 | | pp_type TNull = "{NULL type}" | |
249 | ||
250 | and pp_params nil = "" | |
251 | | pp_params ((i, t)::a::l) = (pp_ident i) ^ " : " ^ (pp_type t) ^ ", " ^ (pp_params (a::l)) | |
252 | | pp_params ((i, t)::l) = (pp_ident i) ^ " : " ^ (pp_type t) ^ (pp_params l) | |
253 | ||
254 | and pp_vars nil = "" | |
255 | | pp_vars ((i, t)::l) = "var " ^ (pp_ident i) ^ " : " ^ (pp_type t) ^ ";\n" ^ (pp_vars l) | |
256 | ||
257 | and pp_function (n, Extern(t, pl)) = "extern " ^ (pp_type t) ^ " " ^ (pp_ident n) ^ "(" ^ (pp_params pl) ^ ");\n" | |
258 | | pp_function (n, Function(t, pl, vl, stms)) = (pp_type t) ^ " " ^ (pp_ident n) ^ "(" ^ (pp_params pl) ^ ")\n{\n" ^ (pp_vars vl) ^ (String.concat (map pp_stm stms)) ^ "\n}\n" | |
259 | | pp_function (n, MarkedFunction d) = pp_function (n, Mark.data d) | |
260 | ||
261 | and pp_typedef (i, Struct (v)) = "struct " ^ (pp_ident i) ^ " {\n" ^ (String.concat (map (fn (i', t) => " " ^ (pp_ident i') ^ " : " ^ (pp_type t) ^ ";\n") v)) ^ "}\n" | |
262 | | pp_typedef (i, MarkedTypedef d) = pp_typedef (i, Mark.data d) | |
263 | ||
264 | and pp_program (types, funs) = String.concat ((map pp_typedef (Symbol.elemsi types)) @ (map pp_function (Symbol.elemsi funs))) | |
265 | end | |
266 | end |