4 let 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) ^ "]"
10 and print_size_list l =
11 MiscPottier.string_of_list ", " print_size l
13 let print_stacksize = print_size
15 let print_offset (size, depth) =
16 "offset[" ^ (print_size size) ^ ", " ^ (string_of_int depth) ^ "]"
18 let print_sizeof = print_size
20 let print_global_size = print_size
22 let print_data = function
24 | Data_reserve n -> Printf.sprintf "[%d]" n
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
32 let print_datas init =
33 let rec aux = function
35 | [data] -> print_data data
36 | data :: datas -> Printf.sprintf "%s, %s" (print_data data) (aux datas)
38 Printf.sprintf "{%s}" (aux init)
40 let print_datas_opt = function
42 | Some init -> " = " ^ (print_datas init)
44 let 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)
48 let print_vars = List.fold_left (fun s v -> s ^ (print_var v)) ""
50 let print_constant = function
51 | Cst_int i -> string_of_int i
52 | Cst_float f -> string_of_float f
53 | Cst_addrsymbol id -> "\"" ^ id ^ "\""
55 | Cst_offset off -> "{" ^ (print_offset off) ^ "}"
56 | Cst_sizeof t -> "sizeof (" ^ (print_sizeof t) ^ ")"
58 let print_cmp = function
66 let 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)
76 | Op_intofptr -> "intofptr"
77 | Op_ptrofint -> "ptrofint"
79 let print_op2 = function
93 | Op_cmp cmp -> print_cmp cmp
94 | Op_cmpu cmp -> (print_cmp cmp) ^ "u"
98 | Op_cmpp cmp -> (print_cmp cmp) ^ "p"
100 let rec print_expression (Cminor.Expr (ed, _)) = match ed with
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"
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"
117 | Cminor.Exp_cost (lab, e) ->
118 Printf.sprintf "/* %s */ %s" lab (print_expression e)
119 and add_parenthesis (Cminor.Expr (ed, _) as e) = match ed with
120 | Cminor.Id _ | Cminor.Cst _ | Cminor.Mem _ -> print_expression e
121 | _ -> Printf.sprintf "(%s)" (print_expression e)
125 MiscPottier.string_of_list ", " print_expression
127 let print_decl (x, t) = (Primitive.print_type t) ^ " " ^ x
129 let print_decls vars =
130 MiscPottier.string_of_list ", " print_decl vars
133 let n_spaces n = String.make n ' '
137 let f s (case, exit) =
138 Printf.sprintf "%s%scase %d: exit %d;\n" s (n_spaces n) case exit
143 let rec print_body n = function
144 | Cminor.St_skip -> ""
145 | Cminor.St_assign (id, e) ->
146 Printf.sprintf "%s%s = %s;\n" (n_spaces n) id (print_expression e)
147 | Cminor.St_store (q, e1, e2) ->
148 Printf.sprintf "%s%s[%s] = %s;\n"
150 (Memory.string_of_quantity q)
151 (print_expression e1)
152 (print_expression e2)
153 | Cminor.St_call (None, f, args, sg) ->
154 Printf.sprintf "%s%s(%s) : %s;\n"
158 (Primitive.print_sig sg)
159 | Cminor.St_call (Some id, f, args, sg) ->
160 Printf.sprintf "%s%s = %s(%s) : %s;\n"
165 (Primitive.print_sig sg)
166 | Cminor.St_tailcall (f, args, sg) ->
167 Printf.sprintf "%stailcall %s(%s) : %s;\n"
171 (Primitive.print_sig sg)
172 | Cminor.St_seq (s1, s2) -> (print_body n s1) ^ (print_body n s2)
173 | Cminor.St_ifthenelse (e, s1, s2) ->
174 Printf.sprintf "%sif (%s) {\n%s%s}\n%selse {\n%s%s}\n"
177 (print_body (n+2) s1)
180 (print_body (n+2) s2)
182 | Cminor.St_loop s ->
183 Printf.sprintf "%sloop {\n%s%s}\n"
187 | Cminor.St_block s ->
188 Printf.sprintf "%sblock {\n%s%s}\n"
192 | Cminor.St_exit i ->
193 Printf.sprintf "%sexit %d;\n" (n_spaces n) i
194 | Cminor.St_switch (e, tbl, dflt) ->
195 Printf.sprintf "%sswitch (%s) {\n%s%sdefault: exit %d;\n%s}\n"
198 (print_table ( n+2) tbl)
202 | Cminor.St_return None -> Printf.sprintf "%sreturn;\n" (n_spaces n)
203 | Cminor.St_return (Some e) ->
204 Printf.sprintf "%sreturn %s;\n" (n_spaces n) (print_expression e)
205 | Cminor.St_label (lbl, s) ->
206 Printf.sprintf "%s%s:\n%s" (n_spaces n) lbl (print_body n s)
207 | Cminor.St_goto lbl ->
208 Printf.sprintf "%sgoto %s;\n" (n_spaces n) lbl
209 | Cminor.St_cost (lbl, s) ->
210 Printf.sprintf "%s%s:\n%s"
211 (n_spaces n) lbl (print_body n s)
213 let print_internal f_name f_def =
214 Printf.sprintf "\"%s\" (%s) : %s {\n\n stack: %s\n\n vars: %s;\n\n%s}\n\n\n"
216 (print_decls f_def.Cminor.f_params)
217 (Primitive.print_type_return f_def.Cminor.f_return)
218 (print_stacksize f_def.Cminor.f_stacksize)
219 (print_decls f_def.Cminor.f_vars)
220 (print_body 2 f_def.Cminor.f_body)
223 let print_external f_name f_def =
224 Printf.sprintf "extern \"%s\" : %s\n\n\n"
226 (Primitive.print_sig f_def.ef_sig)
229 let print_funct (f_name, f_def) = match f_def with
230 | Cminor.F_int f_def -> print_internal f_name f_def
231 | Cminor.F_ext f_def -> print_external f_name f_def
233 let print_functs = List.fold_left (fun s f -> s ^ (print_funct f)) ""
235 let print_program p =
236 Printf.sprintf "\n%s\n\n%s"
237 (print_vars p.Cminor.vars)
238 (print_functs p.Cminor.functs)
240 let string_of_statement s = match s with
241 Cminor.St_skip -> "skip"
242 | Cminor.St_assign(_,_) -> "assign"
243 | Cminor.St_store(_,_,_) -> "store"
244 | Cminor.St_call(_,_,_,_) -> "call"
245 | Cminor.St_tailcall(_,_,_) -> "tailcall"
246 | Cminor.St_seq(_,_) -> "seq"
247 | Cminor.St_ifthenelse(_,_,_) -> "ifthenelse"
248 | Cminor.St_loop(_) -> "loop"
249 | Cminor.St_block(_) -> "block"
250 | Cminor.St_exit(_) -> "exit"
251 | Cminor.St_switch(_,_,_) -> "switch"
252 | Cminor.St_return(_) -> "return"
253 | Cminor.St_label(_,_) -> "label"
254 | Cminor.St_goto(_) -> "goto"
255 | Cminor.St_cost(_,_) -> "cost"