source: Deliverables/D2.2/8051-indexed-labels-branch/src/cminor/cminorPrinter.ml @ 1334

Last change on this file since 1334 was 1334, checked in by tranquil, 8 years ago

work on Cminor completed

File size: 7.7 KB
Line 
1open AST
2
3
4let rec print_size = function
5  | AST.SQ q -> Memory.string_of_quantity q
6  | AST.SProd l -> "struct {" ^ (print_size_list l) ^ "}"
7  | AST.SSum l -> "union {" ^ (print_size_list l) ^ "}"
8  | AST.SArray (i, se) ->
9    (print_size se) ^ "[" ^ (string_of_int i) ^ "]"
10and print_size_list l =
11  MiscPottier.string_of_list ", " print_size l
12
13let print_stacksize = print_size
14
15let print_offset (size, depth) =
16  "offset[" ^ (print_size size) ^ ", " ^ (string_of_int depth) ^ "]"
17
18let print_sizeof = print_size
19
20let print_global_size = print_size
21
22let print_data = function
23(*
24  | Data_reserve n -> Printf.sprintf "[%d]" n
25*)
26  | Data_int8 i -> Printf.sprintf "(int8) %d" i
27  | Data_int16 i -> Printf.sprintf "(int16) %d" i
28  | Data_int32 i -> Printf.sprintf "%d" i
29  | Data_float32 f -> Printf.sprintf "%f" f
30  | Data_float64 f -> Printf.sprintf "(float64) %f" f
31
32let print_datas init =
33  let rec aux = function
34    | [] -> ""
35    | [data] -> print_data data
36    | data :: datas -> Printf.sprintf "%s, %s" (print_data data) (aux datas)
37  in
38  Printf.sprintf "{%s}" (aux init)
39
40let print_datas_opt = function
41  | None -> ""
42  | Some init -> " = " ^ (print_datas init)
43
44let print_var (id, size, init_opt) =
45  Printf.sprintf "var \"%s\" : %s%s;\n"
46    id (print_global_size size) (print_datas_opt init_opt)
47
48let print_vars = List.fold_left (fun s v -> s ^ (print_var v)) ""
49
50let print_constant = function
51  | Cst_int i -> string_of_int i
52  | Cst_float f -> string_of_float f
53  | Cst_addrsymbol id -> "\"" ^ id ^ "\""
54  | Cst_stack -> "&0"
55  | Cst_offset off -> "{" ^ (print_offset off) ^ "}"
56  | Cst_sizeof t -> "sizeof (" ^ (print_sizeof t) ^ ")"
57
58let print_cmp = function
59  | Cmp_eq -> "=="
60  | Cmp_ne -> "!="
61  | Cmp_gt -> ">"
62  | Cmp_ge -> ">="
63  | Cmp_lt -> "<"
64  | Cmp_le -> "<="
65
66let print_op1 = function
67  | Op_cast ((src_size, sign), dest_size) ->
68    Printf.sprintf "int%s%sto%s"
69      (Primitive.print_size src_size)
70      (Primitive.print_signedness sign)
71      (Primitive.print_size dest_size)
72  | Op_negint -> "-"
73  | Op_notbool -> "!"
74  | Op_notint -> "~"
75  | Op_id -> ""
76  | Op_intofptr -> "intofptr"
77  | Op_ptrofint -> "ptrofint"
78
79let print_op2 = function
80  | Op_add -> "+"
81  | Op_sub -> "-"
82  | Op_mul -> "*"
83  | Op_div -> "/"
84  | Op_divu -> "/u"
85  | Op_mod -> "%"
86  | Op_modu -> "%u"
87  | Op_and -> "&&"
88  | Op_or -> "||"
89  | Op_xor -> "^"
90  | Op_shl -> "<<"
91  | Op_shr -> ">>"
92  | Op_shru -> ">>u"
93  | Op_cmp cmp -> print_cmp cmp
94  | Op_cmpu cmp -> (print_cmp cmp) ^ "u"
95  | Op_addp -> "+p"
96  | Op_subp -> "-p"
97  | Op_subpp -> "-pp"
98  | Op_cmpp cmp -> (print_cmp cmp) ^ "p"
99
100let rec print_expression (Cminor.Expr (ed, _)) = match ed with
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 (q, e) ->
111      Printf.sprintf "%s[%s]" (Memory.string_of_quantity q) (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                  let lab = CostLabel.string_of_cost_label lab in
119      Printf.sprintf "/* %s */ %s" lab (print_expression e)
120and add_parenthesis (Cminor.Expr (ed, _) as e) = match ed with
121  | Cminor.Id _ | Cminor.Cst _ | Cminor.Mem _ -> print_expression e
122  | _ -> Printf.sprintf "(%s)" (print_expression e)
123
124
125let print_args  =
126  MiscPottier.string_of_list ", " print_expression
127
128let print_decl (x, t) = (Primitive.print_type t) ^ " " ^ x
129
130let print_decls vars =
131  MiscPottier.string_of_list ", " print_decl vars
132
133
134let n_spaces n = String.make n ' '
135
136
137let print_table n =
138  let f s (case, exit) =
139    Printf.sprintf "%s%scase %d: exit %d;\n" s (n_spaces n) case exit
140  in
141  List.fold_left f ""
142
143
144let rec print_body n = function
145  | Cminor.St_skip -> ""
146  | Cminor.St_assign (id, e) ->
147      Printf.sprintf "%s%s = %s;\n" (n_spaces n) id (print_expression e)
148  | Cminor.St_store (q, e1, e2) ->
149      Printf.sprintf "%s%s[%s] = %s;\n"
150        (n_spaces n)
151        (Memory.string_of_quantity q)
152        (print_expression e1)
153        (print_expression e2)
154  | Cminor.St_call (None, f, args, sg) ->
155      Printf.sprintf "%s%s(%s) : %s;\n"
156        (n_spaces n)
157        (print_expression f)
158        (print_args args)
159        (Primitive.print_sig sg)
160  | Cminor.St_call (Some id, f, args, sg) ->
161      Printf.sprintf "%s%s = %s(%s) : %s;\n"
162        (n_spaces n)
163        id
164        (print_expression f)
165        (print_args args)
166        (Primitive.print_sig sg)
167  | Cminor.St_tailcall (f, args, sg) ->
168      Printf.sprintf "%stailcall %s(%s) : %s;\n"
169        (n_spaces n)
170        (print_expression f)
171        (print_args args)
172        (Primitive.print_sig sg)
173  | Cminor.St_seq (s1, s2) -> (print_body n s1) ^ (print_body n s2)
174  | Cminor.St_ifthenelse (e, s1, Cminor.St_skip) ->
175    Printf.sprintf "%sif (%s) {\n%s%s}\n"
176    (n_spaces n)
177    (print_expression e)
178    (print_body (n+2) s1)
179    (n_spaces n)
180  | Cminor.St_ifthenelse (e, s1, s2) ->
181      Printf.sprintf "%sif (%s) {\n%s%s}\n%selse {\n%s%s}\n"
182        (n_spaces n)
183        (print_expression e)
184        (print_body (n+2) s1)
185        (n_spaces n)
186        (n_spaces n)
187        (print_body (n+2) s2)
188        (n_spaces n)
189  | Cminor.St_loop s ->
190      Printf.sprintf "%sloop {\n%s%s}\n"
191        (n_spaces n)
192        (print_body (n+2) s)
193        (n_spaces n)
194  | Cminor.St_block s ->
195      Printf.sprintf "%sblock {\n%s%s}\n"
196        (n_spaces n)
197        (print_body (n+2) s)
198        (n_spaces n)
199  | Cminor.St_exit i ->
200      Printf.sprintf "%sexit %d;\n" (n_spaces n) i
201  | Cminor.St_switch (e, tbl, dflt) ->
202      Printf.sprintf "%sswitch (%s) {\n%s%sdefault: exit %d;\n%s}\n"
203        (n_spaces n)
204        (print_expression e)
205        (print_table ( n+2) tbl)
206        (n_spaces (n+2))
207        dflt
208        (n_spaces n)
209  | Cminor.St_return None -> Printf.sprintf "%sreturn;\n" (n_spaces n)
210  | Cminor.St_return (Some e) ->
211      Printf.sprintf "%sreturn %s;\n" (n_spaces n) (print_expression e)
212  | Cminor.St_label (lbl, s) ->
213      Printf.sprintf "%s%s:\n%s" (n_spaces n) lbl (print_body n s)
214  | Cminor.St_goto lbl ->
215      Printf.sprintf "%sgoto %s;\n" (n_spaces n) lbl
216  | Cminor.St_cost (lbl, s) ->
217                  let lbl = CostLabel.string_of_cost_label lbl in
218      Printf.sprintf "%s%s:\n%s" (n_spaces n) lbl (print_body n s)
219        | Cminor.St_ind_0 (i, s) ->
220                  Printf.sprintf "%sindex %d:\n%s" (n_spaces n) i (print_body n s)
221        | Cminor.St_ind_inc (s, i) ->
222                  Printf.sprintf "%s%sincrement %d;\n" (print_body n s) (n_spaces n) i
223
224let print_internal f_name f_def =
225  Printf.sprintf "\"%s\" (%s) : %s {\n\n  stack: %s\n\n  vars: %s;\n\n%s}\n\n\n"
226    f_name
227    (print_decls f_def.Cminor.f_params)
228    (Primitive.print_type_return f_def.Cminor.f_return)
229    (print_stacksize f_def.Cminor.f_stacksize)
230    (print_decls f_def.Cminor.f_vars)
231    (print_body 2 f_def.Cminor.f_body)
232
233
234let print_external f_name f_def =
235  Printf.sprintf "extern \"%s\" : %s\n\n\n"
236    f_name
237    (Primitive.print_sig f_def.ef_sig)
238
239
240let print_funct (f_name, f_def) = match f_def with
241  | Cminor.F_int f_def -> print_internal f_name f_def
242  | Cminor.F_ext f_def -> print_external f_name f_def
243
244let print_functs = List.fold_left (fun s f -> s ^ (print_funct f)) ""
245
246let print_program p =
247  Printf.sprintf "\n%s\n\n%s"
248    (print_vars p.Cminor.vars)
249    (print_functs p.Cminor.functs)
250
251let string_of_statement s = match s with
252    Cminor.St_skip -> "skip"
253  | Cminor.St_assign(_,_) -> "assign"
254  | Cminor.St_store(_,_,_) -> "store"
255  | Cminor.St_call(_,_,_,_) -> "call"
256  | Cminor.St_tailcall(_,_,_) -> "tailcall"
257  | Cminor.St_seq(_,_) -> "seq"
258  | Cminor.St_ifthenelse(_,_,_) -> "ifthenelse"
259  | Cminor.St_loop(_) -> "loop"
260  | Cminor.St_block(_) -> "block"
261  | Cminor.St_exit(_) -> "exit"
262  | Cminor.St_switch(_,_,_) -> "switch"
263  | Cminor.St_return(_) -> "return"
264  | Cminor.St_label(_,_) -> "label"
265  | Cminor.St_goto(_) -> "goto"
266  | Cminor.St_cost(_,_) -> "cost"
267        | Cminor.St_ind_0 _ -> "index"
268        | Cminor.St_ind_inc _ -> "increment"
Note: See TracBrowser for help on using the repository browser.