Commit | Line | Data |
---|---|---|
5597e56d | 1 | open Printf |
28875fec | 2 | |
5597e56d SK |
3 | module List = ListLabels |
4 | module String = StringLabels | |
5 | ||
6 | module Sym = Tiger_symbol | |
7 | module Pos = Tiger_position | |
28875fec | 8 | |
e7b4c94e SK |
9 | module Indent : sig |
10 | type t | |
11 | val init : enabled:bool -> unit:string -> t | |
12 | val next : t -> t | |
13 | val to_string : t -> string | |
14 | end = struct | |
15 | type t = | |
16 | { unit : string option | |
17 | ; levels : int | |
18 | } | |
19 | ||
20 | let init ~enabled ~unit = | |
21 | { unit = if enabled then Some unit else None | |
22 | ; levels = 0 | |
23 | } | |
24 | ||
25 | let next t = | |
26 | {t with levels = succ t.levels} | |
27 | ||
28 | let to_string = function | |
29 | | {unit=None; _} -> | |
30 | "" | |
31 | | {unit=Some u; levels} -> | |
32 | let rec add = function | |
33 | | 0 -> "" | |
34 | | n -> u ^ (add (pred n)) | |
35 | in | |
36 | "\n" ^ (add levels) | |
37 | end | |
38 | ||
28875fec SK |
39 | type oper = |
40 | | PlusOp | |
41 | | MinusOp | |
42 | | TimesOp | |
43 | | DivideOp | |
44 | | EqOp | |
45 | | NeqOp | |
46 | | LtOp | |
47 | | LeOp | |
48 | | GtOp | |
49 | | GeOp | |
50 | ||
51 | type exp = | |
28875fec SK |
52 | | NilExp |
53 | | IntExp of | |
54 | int | |
55 | | StringExp of | |
56 | { string : string | |
5597e56d | 57 | ; pos : Pos.t |
28875fec SK |
58 | } |
59 | | CallExp of | |
5597e56d | 60 | { func : Sym.t |
28875fec | 61 | ; args : exp list |
5597e56d | 62 | ; pos : Pos.t |
28875fec SK |
63 | } |
64 | | OpExp of | |
65 | { left : exp | |
66 | ; oper : oper | |
67 | ; right : exp | |
5597e56d | 68 | ; pos : Pos.t |
28875fec SK |
69 | } |
70 | | RecordExp of | |
5597e56d SK |
71 | { fields : (Sym.t * exp * Pos.t) list |
72 | ; typ : Sym.t | |
73 | ; pos : Pos.t | |
28875fec SK |
74 | } |
75 | | SeqExp of | |
5597e56d | 76 | (exp * Pos.t) list |
28875fec SK |
77 | | AssignExp of |
78 | { var : var | |
79 | ; exp : exp | |
5597e56d | 80 | ; pos : Pos.t |
28875fec SK |
81 | } |
82 | | IfExp of | |
83 | { test : exp | |
84 | ; then' : exp | |
85 | ; else' : exp option | |
5597e56d | 86 | ; pos : Pos.t |
28875fec SK |
87 | } |
88 | | WhileExp of | |
89 | { test : exp | |
90 | ; body : exp | |
5597e56d | 91 | ; pos : Pos.t |
28875fec SK |
92 | } |
93 | | ForExp of | |
5597e56d | 94 | { var : Sym.t |
28875fec SK |
95 | ; escape : bool ref (* Whoa - why a mutable cell in AST? *) |
96 | ; lo : exp | |
97 | ; hi : exp | |
98 | ; body : exp | |
5597e56d | 99 | ; pos : Pos.t |
28875fec SK |
100 | } |
101 | | BreakExp of | |
5597e56d | 102 | Pos.t |
28875fec SK |
103 | | LetExp of |
104 | { decs : dec list | |
105 | ; body : exp | |
5597e56d | 106 | ; pos : Pos.t |
28875fec SK |
107 | } |
108 | | ArrayExp of | |
5597e56d | 109 | { typ : Sym.t |
28875fec SK |
110 | ; size : exp |
111 | ; init : exp | |
5597e56d | 112 | ; pos : Pos.t |
28875fec | 113 | } |
5597e56d SK |
114 | | VarExp of |
115 | var | |
28875fec SK |
116 | and var = |
117 | | SimpleVar of | |
5597e56d SK |
118 | { symbol : Sym.t |
119 | ; pos : Pos.t | |
28875fec SK |
120 | } |
121 | | FieldVar of | |
122 | { var : var | |
5597e56d SK |
123 | ; symbol : Sym.t |
124 | ; pos : Pos.t | |
28875fec SK |
125 | } |
126 | | SubscriptVar of | |
127 | { var : var | |
128 | ; exp : exp | |
5597e56d | 129 | ; pos : Pos.t |
28875fec SK |
130 | } |
131 | and dec = | |
132 | | FunDecs of (* "FunctionDec" in Appel's code *) | |
133 | fundec list | |
134 | | VarDec of | |
5597e56d | 135 | { name : Sym.t |
28875fec | 136 | ; escape : bool ref (* Again, why mutable? *) |
5597e56d | 137 | ; typ : (Sym.t * Pos.t) option |
28875fec | 138 | ; init : exp |
5597e56d | 139 | ; pos : Pos.t |
28875fec SK |
140 | } |
141 | | TypeDecs of (* "TypeDec" in Appel's code *) | |
142 | typedec list | |
143 | and ty = | |
144 | | NameTy of | |
5597e56d SK |
145 | { symbol : Sym.t |
146 | ; pos : Pos.t | |
28875fec SK |
147 | } |
148 | | RecordTy of | |
149 | field list | |
150 | | ArrayTy of | |
5597e56d SK |
151 | { symbol : Sym.t |
152 | ; pos : Pos.t | |
28875fec SK |
153 | } |
154 | and field = | |
155 | | Field of | |
5597e56d | 156 | { name : Sym.t |
28875fec | 157 | ; escape : bool ref |
5597e56d SK |
158 | ; typ : Sym.t |
159 | ; pos : Pos.t | |
28875fec SK |
160 | } |
161 | and typedec = | |
162 | | TypeDec of (* An anonymous record in Appel's code *) | |
5597e56d | 163 | { name : Sym.t |
28875fec | 164 | ; ty : ty |
5597e56d | 165 | ; pos : Pos.t |
28875fec SK |
166 | } |
167 | and fundec = | |
168 | | FunDec of | |
5597e56d | 169 | { name : Sym.t |
28875fec | 170 | ; params : field list |
5597e56d | 171 | ; result : (Sym.t * Pos.t) option |
28875fec | 172 | ; body : exp |
5597e56d | 173 | ; pos : Pos.t |
28875fec SK |
174 | } |
175 | ||
176 | type t = exp | |
177 | ||
c16dd441 SK |
178 | (* For printing error messages *) |
179 | let op_show op = | |
180 | match op with | |
181 | | PlusOp -> "+" | |
182 | | MinusOp -> "-" | |
183 | | TimesOp -> "*" | |
184 | | DivideOp -> "/" | |
185 | | EqOp -> "=" | |
186 | | NeqOp -> "<>" | |
187 | | LtOp -> "<" | |
188 | | LeOp -> "<=" | |
189 | | GtOp -> ">" | |
190 | | GeOp -> ">=" | |
191 | ||
192 | (* For printing AST *) | |
e7b4c94e SK |
193 | let op_to_string op = |
194 | match op with | |
5597e56d SK |
195 | | PlusOp -> "PlusOp" |
196 | | MinusOp -> "MinusOp" | |
197 | | TimesOp -> "TimesOp" | |
198 | | DivideOp -> "DivideOp" | |
199 | | EqOp -> "EqOp" | |
200 | | NeqOp -> "NeqOp" | |
201 | | LtOp -> "LtOp" | |
202 | | LeOp -> "LeOp" | |
203 | | GtOp -> "GtOp" | |
204 | | GeOp -> "GeOp" | |
205 | ||
e7b4c94e SK |
206 | let xs_to_string ?(sep=",") ~f ~indent xs = |
207 | let i = Indent.to_string indent in | |
208 | xs |> List.map ~f:(fun x -> i ^ (f x)) |> String.concat ~sep | |
209 | ||
210 | let mexp name params ~indent = | |
211 | let params = xs_to_string ~f:(fun x -> x) ~indent params in | |
212 | sprintf "%s[%s]" name params | |
213 | ||
214 | let field_to_string ~indent (Field {name; typ; _}) = | |
215 | let name = Sym.to_string name in | |
216 | let typ = Sym.to_string typ in | |
217 | let indent = Indent.to_string indent in | |
218 | sprintf "%s%s : %s" indent name typ | |
5597e56d | 219 | |
e7b4c94e SK |
220 | let fields_to_string fields ~indent = |
221 | let fields = List.map fields ~f:(field_to_string ~indent) in | |
222 | mexp "" fields ~indent | |
5597e56d | 223 | |
e7b4c94e SK |
224 | let rec exp_to_string ~indent exp = |
225 | let indent = Indent.next indent in | |
226 | let mexp = mexp ~indent in | |
5597e56d SK |
227 | (match exp with |
228 | | NilExp -> | |
e7b4c94e | 229 | mexp "NilExp" [] |
5597e56d | 230 | | IntExp i -> |
e7b4c94e | 231 | mexp "IntExp" [(string_of_int i)] |
5597e56d | 232 | | StringExp {string; _} -> |
e7b4c94e | 233 | mexp "StringExp" [sprintf "%S" string] |
5597e56d SK |
234 | | CallExp {func; args; _} -> |
235 | let func = Sym.to_string func in | |
e7b4c94e SK |
236 | let args = List.map args ~f:(exp_to_string ~indent) in |
237 | mexp "CallExp" [func; mexp "" args] | |
5597e56d | 238 | | OpExp {left; oper; right; _} -> |
e7b4c94e SK |
239 | let op_exp = |
240 | let indent = Indent.next indent in | |
241 | let oper = op_to_string oper in | |
242 | let left = exp_to_string ~indent left in | |
243 | let right = exp_to_string ~indent right in | |
244 | mexp oper [left; right] | |
245 | in | |
246 | mexp "OpExp" [op_exp] | |
5597e56d SK |
247 | | RecordExp {fields; typ; _} -> |
248 | let fields = | |
e7b4c94e SK |
249 | List.map fields ~f:(fun (sym, exp, _) -> |
250 | sprintf | |
251 | "%s = %s" | |
252 | (Sym.to_string sym) | |
253 | (exp_to_string ~indent exp) | |
254 | ) | |
5597e56d SK |
255 | in |
256 | let typ = Sym.to_string typ in | |
e7b4c94e | 257 | mexp "RecordExp" [typ; mexp "" fields] |
5597e56d SK |
258 | | SeqExp exps -> |
259 | exps | |
e7b4c94e SK |
260 | |> List.map ~f:(fun (e, _) -> exp_to_string e ~indent) |
261 | |> mexp "SeqExp" | |
5597e56d | 262 | | AssignExp {var; exp; _} -> |
e7b4c94e SK |
263 | let var = var_to_string ~indent var in |
264 | let exp = exp_to_string ~indent exp in | |
265 | mexp "AssignExp" [var; exp] | |
5597e56d | 266 | | IfExp {test; then'; else'; _} -> |
e7b4c94e SK |
267 | let test = exp_to_string ~indent test in |
268 | let then' = exp_to_string ~indent then' in | |
5597e56d | 269 | (match else' with |
e7b4c94e SK |
270 | | None -> |
271 | mexp "IfThen" [test; then'] | |
272 | | Some e -> | |
273 | mexp "IfThenElse" [test; then'; (exp_to_string ~indent e)] | |
5597e56d SK |
274 | ) |
275 | | WhileExp {test; body; _} -> | |
e7b4c94e SK |
276 | let test = exp_to_string ~indent test in |
277 | let body = exp_to_string ~indent body in | |
278 | mexp "WhileExp" [test; body] | |
5597e56d | 279 | | ForExp {var; lo; hi; body; _} -> |
e7b4c94e SK |
280 | mexp "ForExp" |
281 | [ (Sym.to_string var) | |
282 | ; (exp_to_string ~indent lo) | |
283 | ; (exp_to_string ~indent hi) | |
284 | ; (exp_to_string ~indent body) | |
285 | ] | |
5597e56d | 286 | | BreakExp _ -> |
e7b4c94e | 287 | mexp "BreakExp" [] |
5597e56d | 288 | | LetExp {decs; body; _} -> |
e7b4c94e SK |
289 | let decs = List.map decs ~f:(dec_to_string ~indent) in |
290 | let body = exp_to_string ~indent body in | |
291 | mexp "LetExp" [mexp "" decs; body] | |
5597e56d SK |
292 | | ArrayExp {typ; size; init; _} -> |
293 | let typ = Sym.to_string typ in | |
e7b4c94e SK |
294 | let size = exp_to_string ~indent size in |
295 | let init = exp_to_string ~indent init in | |
296 | mexp "ArrayExp" [typ; size; init] | |
5597e56d | 297 | | VarExp var -> |
e7b4c94e | 298 | mexp "VarExp" [(var_to_string ~indent var)] |
5597e56d | 299 | ) |
e7b4c94e SK |
300 | and var_to_string ~indent var = |
301 | let indent = Indent.next indent in | |
302 | let mexp = mexp ~indent in | |
303 | match var with | |
5597e56d | 304 | | SimpleVar {symbol; _} -> |
e7b4c94e | 305 | mexp "SimpleVar" [(Sym.to_string symbol)] |
5597e56d | 306 | | FieldVar {var; symbol; _} -> |
e7b4c94e SK |
307 | mexp "FieldVar" |
308 | [ (var_to_string ~indent var) | |
309 | ; (Sym.to_string symbol) | |
310 | ] | |
5597e56d | 311 | | SubscriptVar {var; exp; _} -> |
e7b4c94e SK |
312 | mexp "SubscriptVar[%s]" |
313 | [ (var_to_string ~indent var) | |
314 | ; (exp_to_string ~indent exp) | |
315 | ] | |
316 | and dec_to_string ~indent dec = | |
317 | let indent = Indent.next indent in | |
318 | let mexp = mexp ~indent in | |
319 | match dec with | |
5597e56d SK |
320 | | VarDec {name; typ; init; _} -> |
321 | let name = Sym.to_string name in | |
e7b4c94e | 322 | let init = exp_to_string ~indent init in |
5597e56d SK |
323 | (match typ with |
324 | | Some (typ, _) -> | |
325 | let typ = Sym.to_string typ in | |
e7b4c94e | 326 | mexp "VarDec" [name; typ; init] |
5597e56d | 327 | | None -> |
e7b4c94e | 328 | mexp "VarDec" [name; init] |
5597e56d SK |
329 | ) |
330 | | TypeDecs type_decs -> | |
e7b4c94e SK |
331 | mexp "TypeDecs" |
332 | (List.map type_decs ~f:(type_dec_to_string ~indent)) | |
5597e56d | 333 | | FunDecs fun_decs -> |
e7b4c94e SK |
334 | mexp "FunDecs" |
335 | (List.map fun_decs ~f:(fun_dec_to_string ~indent)) | |
336 | and fun_dec_to_string ~indent fun_dec = | |
337 | let indent = Indent.next indent in | |
338 | let mexp = mexp ~indent in | |
339 | match fun_dec with | |
5597e56d SK |
340 | | FunDec {name; params; body; _} -> |
341 | let name = Sym.to_string name in | |
e7b4c94e SK |
342 | let params = fields_to_string ~indent params in |
343 | let body = exp_to_string ~indent body in | |
344 | mexp "FunDec" [name; params; body] | |
345 | and type_dec_to_string ~indent type_dec = | |
346 | let indent = Indent.next indent in | |
347 | let mexp = mexp ~indent in | |
348 | match type_dec with | |
5597e56d | 349 | | TypeDec {name; ty; _} -> |
e7b4c94e SK |
350 | mexp "TypeDec" |
351 | [ (Sym.to_string name) | |
352 | ; (ty_to_string ~indent ty) | |
353 | ] | |
354 | and ty_to_string ~indent ty = | |
355 | let mexp = mexp ~indent in | |
356 | match ty with | |
357 | | NameTy {symbol; _} -> mexp "NameTy" [(Sym.to_string symbol)] | |
358 | | ArrayTy {symbol; _} -> mexp "ArrayTy" [(Sym.to_string symbol)] | |
359 | | RecordTy fields -> mexp "RecordTy" [(fields_to_string ~indent fields)] | |
5597e56d | 360 | |
e7b4c94e SK |
361 | let to_string = |
362 | let unit = String.make 4 ' ' in | |
363 | let indent = Indent.init ~enabled:true ~unit in | |
364 | exp_to_string ~indent |