-(* Copyright (C) 2002-2008 Yoann Padioleau
+(* Copyright (C) 2006, 2007, 2008 Yoann Padioleau
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License (GPL)
type pr_elem_func = Ast_c.info -> unit
type pr_space_func = unit -> unit
+module F = Control_flow_c
+
(*****************************************************************************)
(* This module is used by unparse_c, but because unparse_c have also
let rec pp_expression_gen pr_elem pr_space =
(* subtil: dont try to shorten the def of pp_statement by omitting e,
otherwise get infinite funcall and huge memory consumption *)
- let pp_statement e = pp_statement_gen pr_elem pr_space e in
+ let _pp_statement e = pp_statement_gen pr_elem pr_space e in
+
let rec pp_expression = fun ((exp, typ), ii) ->
(match exp, ii with
| Ident (c), [i] -> pr_elem i
| StatementExpr (statxs, [ii1;ii2]), [i1;i2] ->
pr_elem i1;
pr_elem ii1;
- statxs +> List.iter pp_statement;
+ statxs +> List.iter (pp_statement_seq_gen pr_elem pr_space);
pr_elem ii2;
pr_elem i2;
| Constructor (t, xs), lp::rp::i1::i2::iicommaopt ->
| ParenExpr (_)
),_ -> raise Impossible
);
+
if !Flag_parsing_c.pretty_print_type_info
then begin
pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "/*");
pp_statement st
| Labeled (Default st), [i1;i2] -> pr_elem i1; pr_elem i2; pp_statement st
| Compound statxs, [i1;i2] ->
- pr_elem i1; statxs +> List.iter pp_statement; pr_elem i2;
+ pr_elem i1;
+ statxs +> List.iter (pp_statement_seq_gen pr_elem pr_space);
+ pr_elem i2;
| ExprStatement (None), [i] -> pr_elem i;
| ExprStatement (None), [] -> ()
| MacroStmt, ii ->
ii +> List.iter pr_elem ;
- | Selection (Ifdef (st1s, st2s)), i1::i2::is ->
- pr_elem i1;
- st1s +> List.iter pp_statement;
- (match (st2s, is) with
- | [], [iifakend] -> pr_elem i2; pr_elem iifakend
- | x::xs, [i3;iifakend] ->
- pr_elem i2;
- st2s +> List.iter pp_statement;
- pr_elem i3;
- pr_elem iifakend
-
- | _ -> raise Impossible
- )
| ( Labeled (Label (_,_)) | Labeled (Case (_,_))
| Labeled (CaseRange (_,_,_)) | Labeled (Default _)
| Compound _ | ExprStatement _
| Iteration (MacroIteration (_,_,_))
| Jump (Goto _) | Jump ((Continue|Break|Return)) | Jump (ReturnExpr _)
| Jump (GotoComputed _)
- | Decl _ | Selection (Ifdef (_,_))
+ | Decl _
), _ -> raise Impossible
in
pp_statement
+and pp_statement_seq_gen pr_elem pr_space stseq =
+ match stseq with
+ | StmtElem st ->
+ pp_statement_gen pr_elem pr_space st
+ | IfdefStmt ifdef -> pp_ifdef_gen pr_elem pr_space ifdef
+ | CppDirectiveStmt cpp -> pp_directive_gen pr_elem pr_space cpp
+ | IfdefStmt2 (ifdef, xxs) ->
+ pp_ifdef_tree_sequence pr_elem pr_space ifdef xxs
+
+(* ifdef XXX elsif YYY elsif ZZZ endif *)
+and pp_ifdef_tree_sequence pr_elem pr_space ifdef xxs =
+ match ifdef with
+ | if1::ifxs ->
+ pp_ifdef_gen pr_elem pr_space if1;
+ pp_ifdef_tree_sequence_aux pr_elem pr_space ifxs xxs
+ | _ -> raise Impossible
+
+(* XXX elsif YYY elsif ZZZ endif *)
+and pp_ifdef_tree_sequence_aux pr_elem pr_space ifdefs xxs =
+ Common.zip ifdefs xxs +> List.iter (fun (ifdef, xs) ->
+ xs +> List.iter (pp_statement_seq_gen pr_elem pr_space);
+ pp_ifdef_gen pr_elem pr_space ifdef;
+ )
+
+
+
+
+(* ---------------------- *)
and pp_asmbody_gen pr_elem pr_space (string_list, colon_list) =
string_list +> List.iter pr_elem ;
colon_list +> List.iter (fun (Colon xs, ii) ->
pr_elem iopar;
pp_expression_gen pr_elem pr_space e;
pr_elem icpar
- | _ -> raise Impossible
+ | (ColonExpr _), _ -> raise Impossible
)
))
(* ---------------------- *)
+
+(*
+pp_type_with_ident_gen
+pp_base_type_gen
+pp_type_with_ident_rest_gen
+pp_type_left_gen
+pp_type_right_gen
+pp_type_gen
+
+pp_decl_gen
+*)
and (pp_type_with_ident_gen:
pr_elem_func -> pr_space_func ->
- (string * info) option -> (storage * il) option -> fullType -> unit) =
+ (string * info) option -> (storage * il) option ->
+ fullType -> attribute list ->
+ unit) =
fun pr_elem pr_space ->
- fun ident sto ((qu, iiqu), (ty, iity)) ->
+ fun ident sto ((qu, iiqu), (ty, iity)) attrs ->
pp_base_type_gen pr_elem pr_space ((qu, iiqu), (ty, iity)) sto;
pp_type_with_ident_rest_gen pr_elem pr_space ident
- ((qu, iiqu), (ty, iity))
+ ((qu, iiqu), (ty, iity)) attrs
and (pp_base_type_gen:
);
fields +> List.iter
- (fun (xfield, iipttvirg) ->
+ (fun (xfield, iipttvirg_when_emptyfield) ->
match xfield with
- | FieldDeclList onefield_multivars ->
+ | DeclarationField (FieldDeclList (onefield_multivars, iiptvirg)) ->
(match onefield_multivars with
| x::xs ->
(* handling the first var. Special case, with the
| x -> raise Impossible)
in
pp_type_with_ident_gen pr_elem pr_space
- identinfo None typ;
+ identinfo None typ Ast_c.noattr;
| (BitField (sopt, typ, expr), ii), iivirg ->
(* first var cant have a preceding ',' *)
pp_expression expr
| (Some s, [is;idot]) ->
pp_type_with_ident_gen
- pr_elem pr_space (Some (s, is)) None typ;
+ pr_elem pr_space
+ (Some (s, is)) None typ Ast_c.noattr;
pr_elem idot;
pp_expression expr
| x -> raise Impossible
)
-
- );
+ ); (* match x, first onefield_multivars *)
(* for other vars *)
xs +> List.iter (function
| x -> raise Impossible)
in
pp_type_with_ident_rest_gen pr_elem pr_space
- identinfo typ;
+ identinfo typ Ast_c.noattr;
| (BitField (sopt, typ, expr), ii), iivirg ->
iivirg +> List.iter pr_elem;
(match sopt, ii with
| (Some s, [is;idot]) ->
pp_type_with_ident_rest_gen
- pr_elem pr_space (Some (s, is)) typ;
+ pr_elem pr_space
+ (Some (s, is)) typ Ast_c.noattr;
pr_elem idot;
pp_expression expr
| x -> raise Impossible
);
- );
+ ); (* iter other vars *)
+
+ | [] -> raise Impossible
+ ); (* onefield_multivars *)
+ assert (List.length iiptvirg = 1);
+ iiptvirg +> List.iter pr_elem;
+
+
+ | MacroStructDeclTodo -> pr2 "MacroTodo"
+
- assert (List.length iipttvirg = 1);
- iipttvirg +> List.iter pr_elem;
- | x -> raise Impossible
- )
- | EmptyField -> ()
+ | EmptyField ->
+ iipttvirg_when_emptyfield +> List.iter pr_elem
+
+ | CppDirectiveStruct cpp -> pp_directive_gen pr_elem pr_space cpp
+ | IfdefStruct ifdef -> pp_ifdef_gen pr_elem pr_space ifdef
);
(match sopt,iis with
| _ -> raise Impossible
)
+ | (Pointer _ | (*ParenType _ |*) Array _ | FunctionType _
+ (* | StructUnion _ | Enum _ | BaseType _ *)
+ (* | StructUnionName _ | EnumName _ | TypeName _ *)
+ (* | TypeOfExpr _ | TypeOfType _ *)
+ ), _ -> raise Impossible
+
+
- | x -> raise Impossible
in
pp_base_type
int before *j *)
and (pp_type_with_ident_rest_gen:
pr_elem_func -> pr_space_func ->
- (string * info) option -> fullType -> unit) =
+ (string * info) option ->
+ fullType -> attribute list ->
+ unit) =
fun pr_elem pr_space ->
- fun ident (((qu, iiqu), (ty, iity)) as fullt) ->
- let print_ident ident = do_option (fun (s, iis) -> pr_elem iis) ident
+
+ fun ident (((qu, iiqu), (ty, iity)) as fullt) attrs ->
+ let print_ident ident = Common.do_option (fun (s, iis) ->
+ (* XXX attrs +> pp_attributes pr_elem pr_space; *)
+ pr_elem iis
+ ) ident
in
match ty, iity with
(* bug: pp_type_with_ident_rest None t; print_ident ident *)
pr_elem i;
iiqu +> List.iter pr_elem; (* le const est forcement apres le '*' *)
- pp_type_with_ident_rest_gen pr_elem pr_space ident t;
+ pp_type_with_ident_rest_gen pr_elem pr_space ident t attrs;
(* ugly special case ... todo? maybe sufficient in practice *)
| (ParenType (q1, (Pointer (q2, (FunctionType t, ii3)) ,
| (ParenType t, [i1;i2]) ->
pr2 "PB PARENTYPE ZARB, I forget about the ()";
- pp_type_with_ident_rest_gen pr_elem pr_space ident t;
+ pp_type_with_ident_rest_gen pr_elem pr_space ident t attrs;
| (Array (eopt, t), [i1;i2]) ->
print_ident ident;
pp_type_right_gen pr_elem pr_space fullt;
+
- | x -> raise Impossible
+ | (FunctionType _ | Array _ | ParenType _ | Pointer _
+ ), _ -> raise Impossible
and (pp_type_left_gen: pr_elem_func -> pr_space_func -> fullType -> unit) =
| (StructUnionName (s, structunion), iis) -> ()
| (EnumName s, iis) -> ()
| (TypeName (s,_typ), iis) -> ()
- | x -> raise Impossible
+
+ | TypeOfType _, _ -> ()
+ | TypeOfExpr _, _ -> ()
+
+ | (FunctionType _ | Array _ | Pointer _
+ ), _ -> raise Impossible
in
pp_type_left
pp_type_gen pr_elem pr_space t
| false, Some s, [i1] ->
- pp_type_with_ident_gen pr_elem pr_space (Some (s, i1)) None t;
+ pp_type_with_ident_gen pr_elem pr_space
+ (Some (s, i1)) None t Ast_c.noattr;
| true, Some s, [i1;i2] ->
pr_elem i1;
- pp_type_with_ident_gen pr_elem pr_space (Some (s, i2)) None t;
+ pp_type_with_ident_gen pr_elem pr_space
+ (Some (s, i2)) None t Ast_c.noattr;
| _ -> raise Impossible
| (StructUnionName (s, structunion), iis) -> ()
| (EnumName s, iis) -> ()
| (TypeName (s,_typ), iis) -> ()
- | x -> raise Impossible
+
+ | TypeOfType _, _ -> ()
+ | TypeOfExpr _, _ -> ()
+
+ | (FunctionType _ | Array _ | Pointer _
+ ), _ -> raise Impossible
+
in
pp_type_right
and pp_type_gen pr_elem pr_space t =
- pp_type_with_ident_gen pr_elem pr_space None None t
+ pp_type_with_ident_gen pr_elem pr_space
+ None None t Ast_c.noattr
(* ---------------------- *)
and pp_decl_gen pr_elem pr_space = function
- | DeclList ((((var, returnType, storage, _local),[])::xs),
+ | DeclList ((({v_namei = var; v_type = returnType;
+ v_storage = storage; v_attr = attrs;
+ },[])::xs),
iivirg::ifakestart::iisto) ->
pr_elem ifakestart;
| Some ((s, ini), iis::iini) ->
pp_type_with_ident_gen pr_elem pr_space
(Some (s, iis)) (Some (storage, iisto))
- returnType;
+ returnType attrs;
ini +> do_option (fun init ->
List.iter pr_elem iini; pp_init_gen pr_elem pr_space init);
| None -> pp_type_gen pr_elem pr_space returnType
(* for other vars, we just call pp_type_with_ident_rest. *)
xs +> List.iter (function
- | ((Some ((s, ini), iis::iini), returnType, storage2, _local), iivirg) ->
+ | ({v_namei = Some ((s, ini), iis::iini);
+ v_type = returnType;
+ v_storage = storage2;
+ v_attr = attrs;
+ }, iivirg) ->
+
assert (storage2 = storage);
iivirg +> List.iter pr_elem;
pp_type_with_ident_rest_gen pr_elem pr_space
- (Some (s, iis)) returnType;
+ (Some (s, iis)) returnType attrs;
ini +> do_option (fun (init) ->
List.iter pr_elem iini; pp_init_gen pr_elem pr_space init);
pr_elem rp;
pr_elem iiend;
- | x -> raise Impossible
+ | (DeclList (_, _) | (MacroDecl _)) -> raise Impossible
(* ---------------------- *)
| InitIndexOld (expression, initialiser), [i1;i2] -> (* [1] in oldgcc *)
pr_elem i1; pp_expression expression; pr_elem i2;
pp_init initialiser
- | x -> raise Impossible
+
+ | (InitIndexOld _ | InitFieldOld _ | InitDesignators _
+ | InitList _ | InitExpr _
+ ), _ -> raise Impossible
in
pp_init
| DesignatorRange (e1, e2), [iocro;iellipsis;iccro] ->
pr_elem iocro; pp_expression e1; pr_elem iellipsis;
pp_expression e2; pr_elem iccro;
- | x -> raise Impossible
-
+ | (DesignatorField _ | DesignatorIndex _ | DesignatorRange _
+ ), _ -> raise Impossible
+
+(* ---------------------- *)
+and pp_attributes pr_elem pr_space attrs =
+ attrs +> List.iter (fun (attr, ii) ->
+ ii +> List.iter pr_elem;
+ );
(* ---------------------- *)
and pp_def_gen pr_elem pr_space def =
- match def with
- | ((s, (returnt, (paramst, (b, iib))), sto, statxs),
- is::iifunc1::iifunc2::i1::i2::ifakestart::isto) ->
+ let defbis, ii = def in
+ match ii with
+ | is::iifunc1::iifunc2::i1::i2::ifakestart::isto ->
+
+ let {f_name = s;
+ f_type = (returnt, (paramst, (b, iib)));
+ f_storage = sto;
+ f_body = statxs;
+ f_attr = attrs;
+ } = defbis
+ in
pr_elem ifakestart;
pp_type_with_ident_gen pr_elem pr_space None (Some (sto, isto))
- returnt;
+ returnt Ast_c.noattr;
+
+ pp_attributes pr_elem pr_space attrs;
pr_elem is;
+
+
pr_elem iifunc1;
(* not anymore, cf tests/optional_name_parameter and
pr_elem iifunc2;
pr_elem i1;
- statxs +> List.iter (pp_statement_gen pr_elem pr_space);
+ statxs +> List.iter (pp_statement_seq_gen pr_elem pr_space);
pr_elem i2;
| _ -> raise Impossible
+(* ---------------------- *)
+
+and pp_ifdef_gen pr_elem pr_space ifdef =
+ match ifdef with
+ | IfdefDirective (ifdef, ii) ->
+ List.iter pr_elem ii
-let pp_program_gen pr_elem pr_space progelem =
- match progelem with
- | Declaration decl -> pp_decl_gen pr_elem pr_space decl
- | Definition def -> pp_def_gen pr_elem pr_space def
- | Include ((s, [i1;i2]),h_rel_pos) ->
+and pp_directive_gen pr_elem pr_space directive =
+ match directive with
+ | Include {i_include = (s, ii);} ->
+ let (i1,i2) = Common.tuple_of_list2 ii in
pr_elem i1; pr_elem i2
- | Define ((s,[idefine;iident;ieol]), (defkind, defval)) ->
+ | Define ((s,ii), (defkind, defval)) ->
+ let (idefine,iident,ieol) = Common.tuple_of_list3 ii in
pr_elem idefine;
pr_elem iident;
let define_val = function
| DefineExpr e -> pp_expression_gen pr_elem pr_space e
| DefineStmt st -> pp_statement_gen pr_elem pr_space st
- | DefineDoWhileZero (st, ii) ->
+ | DefineDoWhileZero ((st,e), ii) ->
(match ii with
- | [ido;iwhile;iopar;iint;icpar] ->
+ | [ido;iwhile;iopar;icpar] ->
pr_elem ido;
pp_statement_gen pr_elem pr_space st;
- pr_elem iwhile; pr_elem iopar; pr_elem iint; pr_elem icpar
+ pr_elem iwhile; pr_elem iopar;
+ pp_expression_gen pr_elem pr_space e;
+ pr_elem icpar
| _ -> raise Impossible
)
| DefineFunction def -> pp_def_gen pr_elem pr_space def
| DefineType ty -> pp_type_gen pr_elem pr_space ty
| DefineText (s, ii) -> List.iter pr_elem ii
| DefineEmpty -> ()
+ | DefineInit ini ->
+ pp_init_gen pr_elem pr_space ini
+
+ | DefineTodo -> pr2 "DefineTodo"
in
(match defkind with
| DefineVar -> ()
define_val defval;
pr_elem ieol
+ | Undef (s, ii) ->
+ List.iter pr_elem ii
+ | PragmaAndCo (ii) ->
+ List.iter pr_elem ii
+
+
+
+
+let pp_program_gen pr_elem pr_space progelem =
+ match progelem with
+ | Declaration decl -> pp_decl_gen pr_elem pr_space decl
+ | Definition def -> pp_def_gen pr_elem pr_space def
+
+ | CppTop directive -> pp_directive_gen pr_elem pr_space directive
+
| MacroTop (s, es, [i1;i2;i3;i4]) ->
pr_elem i1;
assert (List.length ii >= 1);
ii +> List.iter pr_elem
| FinalDef info -> pr_elem (Ast_c.rewrap_str "" info)
+
+ | IfdefTop ifdefdir ->
+ pp_ifdef_gen pr_elem pr_space ifdefdir
+
+ | (MacroTop _)
+ -> raise Impossible
- | _ -> raise Impossible
-
+
+
+
+let pp_flow_gen pr_elem pr_space n =
+ match F.unwrap n with
+ | F.FunHeader ({f_name =idb;
+ f_type = (rett, (paramst,(isvaargs,iidotsb)));
+ f_storage = stob;
+ f_body = body;
+ f_attr = attrs},ii) ->
+
+ assert(null body);
+ (*
+ iif ii;
+ iif iidotsb;
+ attrs +> List.iter (vk_attribute bigf);
+ vk_type bigf rett;
+ paramst +> List.iter (fun (param, iicomma) ->
+ vk_param bigf param;
+ iif iicomma;
+ );
+ *)
+ pr2 "Def";
+
+
+ | F.Decl decl ->
+ (* vk_decl bigf decl *)
+ pr2 "Decl"
+
+ | F.ExprStatement (st, (eopt, ii)) ->
+ pp_statement_gen pr_elem pr_space (ExprStatement eopt, ii)
+
+ | F.IfHeader (_, (e,ii))
+ | F.SwitchHeader (_, (e,ii))
+ | F.WhileHeader (_, (e,ii))
+ | F.DoWhileTail (e,ii) ->
+ (*
+ iif ii;
+ vk_expr bigf e
+ *)
+ pr2 "XXX";
+
+
+ | F.ForHeader (_st, (((e1opt,i1), (e2opt,i2), (e3opt,i3)), ii)) ->
+ (*
+ iif i1; iif i2; iif i3;
+ iif ii;
+ e1opt +> do_option (vk_expr bigf);
+ e2opt +> do_option (vk_expr bigf);
+ e3opt +> do_option (vk_expr bigf);
+ *)
+ pr2 "XXX";
+
+ | F.MacroIterHeader (_s, ((s,es), ii)) ->
+ (*
+ iif ii;
+ vk_argument_list bigf es;
+ *)
+ pr2 "XXX";
+
+
+ | F.ReturnExpr (_st, (e,ii)) ->
+ (* iif ii; vk_expr bigf e*)
+ pr2 "XXX";
+
+
+ | F.Case (_st, (e,ii)) ->
+ (* iif ii; vk_expr bigf e *)
+ pr2 "XXX";
+
+ | F.CaseRange (_st, ((e1, e2),ii)) ->
+ (* iif ii; vk_expr bigf e1; vk_expr bigf e2 *)
+ pr2 "XXX";
+
+
+
+ | F.CaseNode i -> ()
+
+ | F.DefineExpr e ->
+ (* vk_expr bigf e *)
+ pr2 "XXX";
+
+ | F.DefineType ft ->
+ (* vk_type bigf ft *)
+ pr2 "XXX";
+
+ | F.DefineHeader ((s,ii), (defkind)) ->
+ (*
+ iif ii;
+ vk_define_kind bigf defkind;
+ *)
+ pr2 "XXX";
+
+
+ | F.DefineDoWhileZeroHeader (((),ii)) ->
+ (* iif ii *)
+ pr2 "XXX";
+
+
+ | F.Include {i_include = (s, ii);} ->
+ (* iif ii; *)
+ pr2 "XXX";
+
+
+ | F.MacroTop (s, args, ii) ->
+ (* iif ii;
+ vk_argument_list bigf args *)
+ pr2 "XXX";
+
+
+ | F.Break (st,((),ii)) ->
+ (* iif ii *)
+ pr2 "XXX";
+ | F.Continue (st,((),ii)) ->
+ (* iif ii *)
+ pr2 "XXX";
+ | F.Default (st,((),ii)) ->
+ (* iif ii *)
+ pr2 "XXX";
+ | F.Return (st,((),ii)) ->
+ (* iif ii *)
+ pr2 "XXX";
+ | F.Goto (st, (s,ii)) ->
+ (* iif ii *)
+ pr2 "XXX";
+ | F.Label (st, (s,ii)) ->
+ (* iif ii *)
+ pr2 "XXX";
+ | F.EndStatement iopt ->
+ (* do_option infof iopt *)
+ pr2 "XXX";
+ | F.DoHeader (st, info) ->
+ (* infof info *)
+ pr2 "XXX";
+ | F.Else info ->
+ (* infof info *)
+ pr2 "XXX";
+ | F.SeqEnd (i, info) ->
+ (* infof info *)
+ pr2 "XXX";
+ | F.SeqStart (st, i, info) ->
+ (* infof info *)
+ pr2 "XXX";
+
+ | F.MacroStmt (st, ((),ii)) ->
+ (* iif ii *)
+ pr2 "XXX";
+ | F.Asm (st, (asmbody,ii)) ->
+ (*
+ iif ii;
+ vk_asmbody bigf asmbody
+ *)
+ pr2 "XXX";
+
+
+ | F.IfdefHeader (info) ->
+ pp_ifdef_gen pr_elem pr_space info
+ | F.IfdefElse (info) ->
+ pp_ifdef_gen pr_elem pr_space info
+ | F.IfdefEndif (info) ->
+ pp_ifdef_gen pr_elem pr_space info
+
+
+ | (
+ F.TopNode|F.EndNode|
+ F.ErrorExit|F.Exit|F.Enter|
+ F.FallThroughNode|F.AfterNode|F.FalseNode|F.TrueNode|F.InLoopNode|
+ F.Fake
+ ) ->
+ pr2 "YYY"
+
+
+
+
+
let pp_expression_simple = pp_expression_gen pr_elem pr_space
let pp_statement_simple = pp_statement_gen pr_elem pr_space
let pp_type_simple = pp_type_gen pr_elem pr_space
+let pp_toplevel_simple = pp_program_gen pr_elem pr_space
+let pp_flow_simple = pp_flow_gen pr_elem pr_space
+
HCoop / bpt / coccinelle.git / blobdiff