source: Deliverables/D2.2/8051/src/cminor/cminorPrinter.ml @ 486

Last change on this file since 486 was 486, checked in by ayache, 8 years ago

Deliverable D2.2

File size: 7.1 KB
Line 
1open AST
2
3let print_type = function
4  | Sig_int -> "int"
5  | Sig_float -> "float"
6  | Sig_ptr -> "ptr"
7
8let print_ret_type = function
9  | Type_ret t -> print_type t
10  | Type_void -> "void"
11
12let print_sig sg =
13  let rec aux = function
14    | [] -> ""
15    | [t] -> (print_type t) ^ " -> "
16    | t :: sg -> (print_type t) ^ " -> " ^ (aux sg)
17  in
18  (aux sg.args) ^ (print_ret_type sg.res)
19
20
21let print_data = function
22  | Data_reserve n -> Printf.sprintf "[%d]" n
23  | Data_int8 i -> Printf.sprintf "(int8) %d" i
24  | Data_int16 i -> Printf.sprintf "(int16) %d" i
25  | Data_int32 i -> Printf.sprintf "%d" i
26  | Data_float32 f -> Printf.sprintf "%f" f
27  | Data_float64 f -> Printf.sprintf "(float64) %f" f
28
29let print_datas init =
30  let rec aux = function
31    | [] -> ""
32    | [data] -> print_data data
33    | data :: datas -> Printf.sprintf "%s, %s" (print_data data) (aux datas)
34  in
35  Printf.sprintf "{%s}" (aux init)
36
37let print_var (id, init) =
38  Printf.sprintf "var \"%s\" %s\n" id (print_datas init)
39
40let print_vars = List.fold_left (fun s v -> s ^ (print_var v)) ""
41
42let print_constant = function
43  | Cst_int i -> string_of_int i
44  | Cst_float f -> string_of_float f
45  | Cst_addrsymbol id -> "\"" ^ id ^ "\""
46  | Cst_stackoffset off -> "&" ^ (string_of_int off)
47
48let print_cmp = function
49  | Cmp_eq -> "=="
50  | Cmp_ne -> "!="
51  | Cmp_gt -> ">"
52  | Cmp_ge -> ">="
53  | Cmp_lt -> "<"
54  | Cmp_le -> "<="
55
56let print_op1 = function
57  | Op_cast8unsigned -> "int8u"
58  | Op_cast8signed -> "int8s"
59  | Op_cast16unsigned -> "int16u"
60  | Op_cast16signed -> "int16s"
61  | Op_negint -> "-"
62  | Op_notbool -> "!"
63  | Op_notint -> "~"
64  | Op_negf -> "-f"
65  | Op_absf -> "absf"
66  | Op_singleoffloat -> "float32"
67  | Op_intoffloat -> "intoffloat"
68  | Op_intuoffloat -> "intuoffloat"
69  | Op_floatofint -> "floatofint"
70  | Op_floatofintu -> "floatofintu"
71  | Op_id -> ""
72  | Op_intofptr -> "intofptr"
73  | Op_ptrofint -> "ptrofint"
74
75let print_op2 = function
76  | Op_add -> "+"
77  | Op_sub -> "-"
78  | Op_mul -> "*"
79  | Op_div -> "/"
80  | Op_divu -> "/u"
81  | Op_mod -> "%"
82  | Op_modu -> "%u"
83  | Op_and -> "&&"
84  | Op_or -> "||"
85  | Op_xor -> "^"
86  | Op_shl -> "<<"
87  | Op_shr -> ">>"
88  | Op_shru -> ">>u"
89  | Op_addf -> "+f"
90  | Op_subf -> "-f"
91  | Op_mulf -> "*f"
92  | Op_divf -> "/f"
93  | Op_cmp cmp -> print_cmp cmp
94  | Op_cmpu cmp -> (print_cmp cmp) ^ "u"
95  | Op_cmpf cmp -> (print_cmp cmp) ^ "f"
96  | Op_addp -> "+p"
97  | Op_subp -> "-p"
98  | Op_cmpp cmp -> (print_cmp cmp) ^ "p"
99
100let rec print_expression = function
101  | Cminor.Id id -> id
102  | Cminor.Cst cst -> print_constant cst
103  | Cminor.Op1 (op1, e) ->
104      Printf.sprintf "%s%s" (print_op1 op1) (add_parenthesis e)
105  | Cminor.Op2 (op2, e1, e2) ->
106      Printf.sprintf "%s %s %s"
107        (add_parenthesis e1)
108        (print_op2 op2)
109        (add_parenthesis e2)
110  | Cminor.Mem (chunk, e) ->
111      Printf.sprintf "%s[%s]" (Memory.string_of_memory_q chunk) (print_expression e)
112  | Cminor.Cond (e1, e2, e3) ->
113      Printf.sprintf "%s ? %s : %s"
114        (add_parenthesis e1)
115        (add_parenthesis e2)
116        (add_parenthesis e3)
117  | Cminor.Exp_cost (lab, e) ->
118      Printf.sprintf "/* %s */ %s" lab (print_expression e)
119and add_parenthesis e = match e with
120  | Cminor.Id _ | Cminor.Cst _ | Cminor.Mem _ -> print_expression e
121  | _ -> Printf.sprintf "(%s)" (print_expression e)
122
123
124let rec print_args = function
125  | [] -> ""
126  | [e] -> print_expression e
127  | e :: args -> (print_expression e) ^ ", " ^ (print_args args)
128
129
130let n_spaces n = String.make n ' '
131
132
133let print_locals n vars =
134  let rec aux = function
135    | [] -> ""
136    | [id] -> id
137    | id :: vars -> id ^ ", " ^ (aux vars)
138  in
139  match vars with
140    | [] -> ""
141    | _ -> Printf.sprintf "%svar %s;\n\n" (n_spaces n) (aux vars)
142
143
144let print_table n =
145  let f s (case, exit) =
146    Printf.sprintf "%s%scase %d: exit %d;\n" s (n_spaces n) case exit
147  in
148  List.fold_left f ""
149
150
151let rec print_body n = function
152  | Cminor.St_skip -> ""
153  | Cminor.St_assign (id, e) ->
154      Printf.sprintf "%s%s = %s;\n" (n_spaces n) id (print_expression e)
155  | Cminor.St_store (chunk, e1, e2) ->
156      Printf.sprintf "%s%s[%s] = %s;\n"
157        (n_spaces n)
158        (Memory.string_of_memory_q chunk)
159        (print_expression e1)
160        (print_expression e2)
161  | Cminor.St_call (None, f, args, sg) ->
162      Printf.sprintf "%s%s(%s) : %s;\n"
163        (n_spaces n)
164        (print_expression f)
165        (print_args args)
166        (print_sig sg)
167  | Cminor.St_call (Some id, f, args, sg) ->
168      Printf.sprintf "%s%s = %s(%s) : %s;\n"
169        (n_spaces n)
170        id
171        (print_expression f)
172        (print_args args)
173        (print_sig sg)
174  | Cminor.St_tailcall (f, args, sg) ->
175      Printf.sprintf "%stailcall %s(%s) : %s;\n"
176        (n_spaces n)
177        (print_expression f)
178        (print_args args)
179        (print_sig sg)
180  | Cminor.St_seq (s1, s2) -> (print_body n s1) ^ (print_body n s2)
181  | Cminor.St_ifthenelse (e, s1, s2) ->
182      Printf.sprintf "%sif (%s) {\n%s%s}\n%selse {\n%s%s}\n"
183        (n_spaces n)
184        (print_expression e)
185        (print_body (n+2) s1)
186        (n_spaces n)
187        (n_spaces n)
188        (print_body (n+2) s2)
189        (n_spaces n)
190  | Cminor.St_loop s ->
191      Printf.sprintf "%sloop {\n%s%s}\n"
192        (n_spaces n)
193        (print_body (n+2) s)
194        (n_spaces n)
195  | Cminor.St_block s ->
196      Printf.sprintf "%sblock {\n%s%s}\n"
197        (n_spaces n)
198        (print_body (n+2) s)
199        (n_spaces n)
200  | Cminor.St_exit i ->
201      Printf.sprintf "%sexit %d;\n" (n_spaces n) i
202  | Cminor.St_switch (e, tbl, dflt) ->
203      Printf.sprintf "%sswitch (%s) {\n%s%sdefault: exit %d;\n%s}\n"
204        (n_spaces n)
205        (print_expression e)
206        (print_table ( n+2) tbl)
207        (n_spaces (n+2))
208        dflt
209        (n_spaces n)
210  | Cminor.St_return None -> Printf.sprintf "%sreturn;\n" (n_spaces n)
211  | Cminor.St_return (Some e) ->
212      Printf.sprintf "%sreturn %s;\n" (n_spaces n) (print_expression e)
213  | Cminor.St_label (lbl, s) ->
214      Printf.sprintf "%s%s:\n%s" (n_spaces n) lbl (print_body n s)
215  | Cminor.St_goto lbl ->
216      Printf.sprintf "%sgoto %s;\n" (n_spaces n) lbl
217  | Cminor.St_cost (lbl, s) ->
218      Printf.sprintf "%s%s:\n%s"
219        (n_spaces n) lbl (print_body n s)
220
221let print_internal f_name f_def =
222  Printf.sprintf "\"%s\" (%s) : %s {\n\n  stack %d;\n\n%s%s\n}\n\n\n"
223    f_name
224    (print_args (List.map (fun id -> Cminor.Id id) f_def.Cminor.f_params))
225    (print_sig f_def.Cminor.f_sig)
226    f_def.Cminor.f_stacksize
227    (print_locals 2 f_def.Cminor.f_vars)
228    (print_body 2 f_def.Cminor.f_body)
229
230
231let print_external f_name f_def =
232  Printf.sprintf "extern \"%s\" : %s\n\n\n"
233    f_name
234    (print_sig f_def.ef_sig)
235
236
237let print_funct (f_name, f_def) = match f_def with
238  | Cminor.F_int f_def -> print_internal f_name f_def
239  | Cminor.F_ext f_def -> print_external f_name f_def
240
241let print_functs = List.fold_left (fun s f -> s ^ (print_funct f)) ""
242
243let print_program p =
244  Printf.sprintf "\n%s\n\n%s"
245    (print_vars p.Cminor.vars)
246    (print_functs p.Cminor.functs)
247
248let string_of_statement s = match s with
249    Cminor.St_skip -> "skip"
250  | Cminor.St_assign(_,_) -> "assign"
251  | Cminor.St_store(_,_,_) -> "store"
252  | Cminor.St_call(_,_,_,_) -> "call"
253  | Cminor.St_tailcall(_,_,_) -> "tailcall"
254  | Cminor.St_seq(_,_) -> "seq"
255  | Cminor.St_ifthenelse(_,_,_) -> "ifthenelse"
256  | Cminor.St_loop(_) -> "loop"
257  | Cminor.St_block(_) -> "block"
258  | Cminor.St_exit(_) -> "exit"
259  | Cminor.St_switch(_,_,_) -> "switch"
260  | Cminor.St_return(_) -> "return"
261  | Cminor.St_label(_,_) -> "label"
262  | Cminor.St_goto(_) -> "goto"
263  | Cminor.St_cost(_,_) -> "cost"
Note: See TracBrowser for help on using the repository browser.