Search GODI:
| File doc/godi-frontc/html/code_VALCprint.print_enum.html | GODI Package godi-frontc |
| code_VALCprint.print_enum.html |
let rec print_base_type typ =
match typ with
NO_TYPE -> ()
| VOID -> print "void"
| CHAR sign -> print ((get_sign sign) ^ "char")
| INT (size, sign) -> print ((get_sign sign) ^ (get_size size) ^ "int")
| BITFIELD (sign, _) -> print ((get_sign sign) ^ "int")
| FLOAT size -> print ((if size then "long " else "") ^ "float")
| DOUBLE size -> print ((if size then "long " else "") ^ "double")
| NAMED_TYPE id -> print id
| ENUM (id, items) -> print_enum id items
| STRUCT (id, flds) -> print_fields ("struct " ^ id) flds
| UNION (id, flds) -> print_fields ("union " ^ id) flds
| PROTO (typ, _, _) -> print_base_type typ
| OLD_PROTO (typ, _, _) -> print_base_type typ
| PTR typ -> print_base_type typ
| ARRAY (typ, _) -> print_base_type typ
| CONST typ -> print_base_type typ
| VOLATILE typ -> print_base_type typ
and print_fields id (flds : name_group list) =
print id;
if flds = []
then ()
else begin
print " {";
indent ();
List.iter
(fun fld -> print_name_group fld; print ";"; new_line ())
flds;
unindent ();
print "}"
end
and print_enum id items =
print ("enum " ^ id);
if items = []
then ()
else begin
print " {";
indent ();
print_commas
true
(fun (id, exp) -> print id;
if exp = NOTHING then ()
else begin
space ();
print "= ";
print_expression exp 1
end)
items;
unindent ();
print "}";
end
(*
** Declaration Printing
*)
and get_base_type typ =
match typ with
PTR typ -> get_base_type typ
| CONST typ -> get_base_type typ
| VOLATILE typ -> get_base_type typ
| ARRAY (typ, _) -> get_base_type typ
| _ -> typ
and print_pointer typ =
match typ with
PTR typ -> print_pointer typ; print "*"
| CONST typ -> print_pointer typ; print " const "
| VOLATILE typ -> print_pointer typ; print " volatile "
| ARRAY (typ, _) -> print_pointer typ
| _ -> ()
and print_array typ =
match typ with
ARRAY (typ, dim) ->
print_array typ;
print "[";
print_expression dim 0;
print "]"
| _ -> ()
and print_type (fct : unit -> unit) (typ : base_type ) =
let base = get_base_type typ in
match base with
BITFIELD (_, exp) -> fct (); print " : "; print_expression exp 1
| PROTO (typ', pars, ell) ->
print_type
(fun _ ->
if base <> typ then print "(";
print_pointer typ;
fct ();
print_array typ;
if base <> typ then print ")";
print "(";
print_params pars ell;
print ")")
typ'
| OLD_PROTO (typ', pars, ell) ->
print_type
(fun _ ->
if base <> typ then print "(";
print_pointer typ;
fct ();
print_array typ;
if base <> typ then print ")";
print "(";
print_old_params pars ell;
print ")")
typ'
| _ -> print_pointer typ; fct (); print_array typ
and print_onlytype typ =
print_base_type typ;
print_type (fun _ -> ()) typ
and print_name ((id, typ, attr, exp) : name) =
print_type (fun _ -> print id) typ;
print_attributes attr;
if exp <> NOTHING then begin
space ();
print "= ";
print_expression exp 1
end else ()
and get_storage sto =
match sto with
NO_STORAGE -> ""
| AUTO -> "auto"
| STATIC -> "static"
| EXTERN -> "extern"
| REGISTER -> "register"
and print_name_group (typ, sto, names) =
if sto <> NO_STORAGE then begin
print (get_storage sto);
space ()
end;
print_base_type typ;
space ();
print_commas false print_name names
and print_single_name (typ, sto, name) =
if sto <> NO_STORAGE then begin
print (get_storage sto);
space ()
end;
print_base_type typ;
space ();
print_name name
and print_params (pars : single_name list) (ell : bool) =
print_commas false print_single_name pars;
if ell then print (if pars = [] then "..." else ", ...") else ()
and print_old_params pars ell =
print_commas false (fun id -> print id) pars;
if ell then print (if pars = [] then "..." else ", ...") else ()
(*
** Expression printing
** Priorities
** 16 varaibles
** 15 . -> [] call()
** 14 ++, -- (post)
** 13 ++ -- (pre) ~ ! - + & *(cast)
** 12 * / %
** 11 + -
** 10 << >>
** 9 < <= > >=
** 8 == !=
** 7 &
** 6 ^
** 5 |
** 4 &&
** 3 ||
** 2 ? :
** 1 = ?=
** 0 ,
*)
and get_operator exp =
match exp with
NOTHING -> ("", 16)
| UNARY (op, _) ->
(match op with
MINUS -> ("-", 13)
| PLUS -> ("+", 13)
| NOT -> ("!", 13)
| BNOT -> ("~", 13)
| MEMOF -> ("*", 13)
| ADDROF -> ("&", 13)
| PREINCR -> ("++", 13)
| PREDECR -> ("--", 13)
| POSINCR -> ("++", 14)
| POSDECR -> ("--", 14))
| BINARY (op, _, _) ->
(match op with
MUL -> ("*", 12)
| DIV -> ("/", 12)
| MOD -> ("%", 12)
| ADD -> ("+", 11)
| SUB -> ("-", 11)
| SHL -> ("<<", 10)
| SHR -> (">>", 10)
| LT -> ("<", 9)
| LE -> ("<=", 9)
| GT -> (">", 9)
| GE -> (">=", 9)
| EQ -> ("==", 8)
| NE -> ("!=", 8)
| BAND -> ("&", 7)
| XOR -> ("^", 6)
| BOR -> ("|", 5)
| AND -> ("&&", 4)
| OR -> ("||", 3)
| ASSIGN -> ("=", 1)
| ADD_ASSIGN -> ("+=", 1)
| SUB_ASSIGN -> ("-=", 1)
| MUL_ASSIGN -> ("*=", 1)
| DIV_ASSIGN -> ("/=", 1)
| MOD_ASSIGN -> ("%=", 1)
| BAND_ASSIGN -> ("&=", 1)
| BOR_ASSIGN -> ("|=", 1)
| XOR_ASSIGN -> ("^=", 1)
| SHL_ASSIGN -> ("<<=", 1)
| SHR_ASSIGN -> (">>=", 1))
| QUESTION _ -> ("", 2)
| CAST _ -> ("", 13)
| CALL _ -> ("", 15)
| COMMA _ -> ("", 0)
| CONSTANT _ -> ("", 16)
| VARIABLE _ -> ("", 16)
| EXPR_SIZEOF _ -> ("", 16)
| TYPE_SIZEOF _ -> ("", 16)
| INDEX _ -> ("", 15)
| MEMBEROF _ -> ("", 15)
| MEMBEROFPTR _ -> ("", 15)
| GNU_BODY _ -> ("", 17)
and print_comma_exps exps =
print_commas false (fun exp -> print_expression exp 1) exps
and print_expression (exp : expression) (lvl : int) =
let (txt, lvl') = get_operator exp in
let _ = if lvl > lvl' then print "(" else () in
let _ = match exp with
NOTHING -> ()
| UNARY (op, exp') ->
(match op with
POSINCR | POSDECR ->
print_expression exp' lvl';
print txt
| _ ->
print txt;
print_expression exp' lvl')
| BINARY (_, exp1, exp2) ->
(*if (op = SUB) && (lvl <= lvl') then print "(";*)
print_expression exp1 lvl';
space ();
print txt;
space ();
(*print_expression exp2 (if op = SUB then (lvl' + 1) else lvl');*)
print_expression exp2 (lvl' + 1)
(*if (op = SUB) && (lvl <= lvl') then print ")"*)
| QUESTION (exp1, exp2, exp3) ->
print_expression exp1 2;
space ();
print "? ";
print_expression exp2 2;
space ();
print ": ";
print_expression exp3 2;
| CAST (typ, exp) ->
print "(";
print_onlytype typ;
print ")";
print_expression exp 15
| CALL (exp, args) ->
print_expression exp 16;
print "(";
print_comma_exps args;
print ")"
| COMMA exps ->
print_comma_exps exps
| CONSTANT cst ->
(match cst with
CONST_INT i -> print i
| CONST_FLOAT r -> print r
| CONST_CHAR c -> print ("'" ^ (escape_string c) ^ "'")
| CONST_STRING s -> print ("\"" ^ (escape_string s) ^ "\"")
| CONST_COMPOUND exps ->
print "{";
print_comma_exps exps;
print "}")
| VARIABLE name ->
print name
| EXPR_SIZEOF exp ->
print "sizeof(";
print_expression exp 0;
print ")"
| TYPE_SIZEOF typ ->
print "sizeof(";
print_onlytype typ;
print ")"
| INDEX (exp, idx) ->
print_expression exp 16;
print "[";
print_expression idx 0;
print "]"
| MEMBEROF (exp, fld) ->
print_expression exp 16;
print ("." ^ fld)
| MEMBEROFPTR (exp, fld) ->
print_expression exp 16;
print ("->" ^ fld)
| GNU_BODY (decs, stat) ->
print "(";
print_statement (BLOCK (decs, stat));
print ")" in
if lvl > lvl' then print ")" else ()
(*
** Statement printing
*)
and print_statement stat =
match stat with
NOP ->
print ";";
new_line ()
| COMPUTATION exp ->
print_expression exp 0;
print ";";
new_line ()
| BLOCK (defs, stat) ->
new_line ();
print "{";
indent ();
print_defs defs;
if stat <> NOP then print_statement stat else ();
unindent ();
print "}";
new_line ();
| SEQUENCE (s1, s2) ->
print_statement s1;
print_statement s2;
| IF (exp, s1, s2) ->
print "if(";
print_expression exp 0;
print ")";
print_substatement s1;
if s2 = NOP
then ()
else begin
print "else";
print_substatement s2;
end
| WHILE (exp, stat) ->
print "while(";
print_expression exp 0;
print ")";
print_substatement stat
| DOWHILE (exp, stat) ->
print "do";
print_substatement stat;
print "while(";
print_expression exp 0;
print ");";
new_line ();
| FOR (exp1, exp2, exp3, stat) ->
print "for(";
print_expression exp1 0;
print ";";
space ();
print_expression exp2 0;
print ";";
space ();
print_expression exp3 0;
print ")";
print_substatement stat
| BREAK ->
print "break;"; new_line ()
| CONTINUE ->
print "continue;"; new_line ()
| RETURN exp ->
print "return";
if exp = NOTHING
then ()
else begin
print " ";
print_expression exp 1
end;
print ";";
new_line ()
| SWITCH (exp, stat) ->
print "switch(";
print_expression exp 0;
print ")";
print_substatement stat
| CASE (exp, stat) ->
unindent ();
print "case ";
print_expression exp 1;
print ":";
indent ();
print_substatement stat
| DEFAULT stat ->
unindent ();
print "default :";
indent ();
print_substatement stat
| LABEL (name, stat) ->
print (name ^ ":");
space ();
print_substatement stat
| GOTO name ->
print ("goto " ^ name ^ ";");
new_line ()
and print_substatement stat =
match stat with
IF _
| SEQUENCE _
| DOWHILE _ ->
new_line ();
print "{";
indent ();
print_statement stat;
unindent ();
print "}";
new_line ();
| BLOCK _ ->
print_statement stat
| _ ->
indent ();
print_statement stat;
unindent ()
(*
** GCC Attributes
*)
and print_attributes attrs =
List.iter
(fun attr ->
space ();
print "__attribute__ ";
print_attribute attr)
attrs
and print_attribute attr =
match attr with
NO_ATTR -> ()
| ATTR_LIST lst ->
print "(";
print_commas false print_attribute lst;
print ")"
| ATTR_ID id -> print id
(*
** Declaration printing
*)
and print_defs defs =
let prev = ref false in
List.iter
(fun def ->
(match def with
DECDEF _ -> prev := false
| _ ->
if not !prev then force_new_line ();
prev := true);
print_def def)
defs
and print_def def =
match def with
FUNDEF (proto, body) ->
print_single_name proto;
let (decs, stat) = body in print_statement (BLOCK (decs, stat));
force_new_line ();
| OLDFUNDEF (proto, decs, body) ->
print_single_name proto;
force_new_line ();
List.iter
(fun dec -> print_name_group dec; print ";"; new_line ())
decs;
let (decs, stat) = body in print_statement (BLOCK (decs, stat));
force_new_line ();
| DECDEF names ->
print_name_group names;
print ";";
new_line ()
| TYPEDEF names ->
print "typedef ";
print_name_group names;
print ";";
new_line ();
force_new_line ()
| ONLYTYPEDEF names ->
print_name_group names;
print ";";
new_line ();
force_new_line ()
