src/cminor/cminorPrinter.ml

   1 open AST
   2
   3
   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
  12
  13 let print_stacksize = print_size
  14
  15 let print_offset (size, depth) =
  16   "offset[" ^ (print_size size) ^ ", " ^ (string_of_int depth) ^ "]"
  17
  18 let print_sizeof = print_size
  19
  20 let print_global_size = print_size
  21
  22 let 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
  32 let 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
  40 let print_datas_opt = function
  41   | None -> ""
  42   | Some init -> " = " ^ (print_datas init)
  43
  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)
  47
  48 let print_vars = List.fold_left (fun s v -> s ^ (print_var v)) ""
  49
  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 ^ "\""
  54   | Cst_stack -> "&0"
  55   | Cst_offset off -> "{" ^ (print_offset off) ^ "}"
  56   | Cst_sizeof t -> "sizeof (" ^ (print_sizeof t) ^ ")"
  57
  58 let print_cmp = function
  59   | Cmp_eq -> "=="
  60   | Cmp_ne -> "!="
  61   | Cmp_gt -> ">"
  62   | Cmp_ge -> ">="
  63   | Cmp_lt -> "<"
  64   | Cmp_le -> "<="
  65
  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)
  72   | Op_negint -> "-"
  73   | Op_notbool -> "!"
  74   | Op_notint -> "~"
  75   | Op_id -> ""
  76   | Op_intofptr -> "intofptr"
  77   | Op_ptrofint -> "ptrofint"
  78
  79 let 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
 100 let 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       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)
 122
 123
 124 let print_args  =
 125   MiscPottier.string_of_list ", " print_expression
 126
 127 let print_decl (x, t) = (Primitive.print_type t) ^ " " ^ x
 128
 129 let print_decls vars =
 130   MiscPottier.string_of_list ", " print_decl vars
 131
 132
 133 let n_spaces n = String.make n ' '
 134
 135
 136 let print_table n =
 137   let f s (case, exit) =
 138     Printf.sprintf "%s%scase %d: exit %d;\n" s (n_spaces n) case exit
 139   in
 140   List.fold_left f ""
 141
 142
 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"
 149         (n_spaces 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"
 155         (n_spaces n)
 156         (print_expression f)
 157         (print_args args)
 158         (Primitive.print_sig sg)
 159   | Cminor.St_call (Some id, f, args, sg) ->
 160       Printf.sprintf "%s%s = %s(%s) : %s;\n"
 161         (n_spaces n)
 162         id
 163         (print_expression f)
 164         (print_args args)
 165         (Primitive.print_sig sg)
 166   | Cminor.St_tailcall (f, args, sg) ->
 167       Printf.sprintf "%stailcall %s(%s) : %s;\n"
 168         (n_spaces n)
 169         (print_expression f)
 170         (print_args args)
 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"
 175         (n_spaces n)
 176         (print_expression e)
 177         (print_body (n+2) s1)
 178         (n_spaces n)
 179         (n_spaces n)
 180         (print_body (n+2) s2)
 181         (n_spaces n)
 182   | Cminor.St_loop s ->
 183       Printf.sprintf "%sloop {\n%s%s}\n"
 184         (n_spaces n)
 185         (print_body (n+2) s)
 186         (n_spaces n)
 187   | Cminor.St_block s ->
 188       Printf.sprintf "%sblock {\n%s%s}\n"
 189         (n_spaces n)
 190         (print_body (n+2) s)
 191         (n_spaces 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"
 196         (n_spaces n)
 197         (print_expression e)
 198         (print_table ( n+2) tbl)
 199         (n_spaces (n+2))
 200         dflt
 201         (n_spaces n)
 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)
 212
 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"
 215     f_name
 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)
 221
 222
 223 let print_external f_name f_def =
 224   Printf.sprintf "extern \"%s\" : %s\n\n\n"
 225     f_name
 226     (Primitive.print_sig f_def.ef_sig)
 227
 228
 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
 232
 233 let print_functs = List.fold_left (fun s f -> s ^ (print_funct f)) ""
 234
 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)
 239
 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"