type pretty_printers = {
expression : Ast_c.expression printer;
arg_list : (Ast_c.argument Ast_c.wrap2 list) printer;
+ arg : Ast_c.argument printer;
statement : Ast_c.statement printer;
decl : Ast_c.declaration printer;
+ field : Ast_c.field printer;
+ field_list : Ast_c.field list printer;
init : Ast_c.initialiser printer;
+ init_list : (Ast_c.initialiser wrap2 list) printer;
param : Ast_c.parameterType printer;
+ paramlist : (Ast_c.parameterType Ast_c.wrap2 list) printer;
ty : Ast_c.fullType printer;
type_with_ident : type_with_ident;
toplevel : Ast_c.toplevel printer;
start_block(); f(); pr_unindent() in
-
+ let pp_list printer l =
+ l +> List.iter (fun (e, opt) ->
+ assert (List.length opt <= 1); (* opt must be a comma? *)
+ opt +> List.iter (function x -> pr_elem x; pr_space());
+ printer e) in
let rec pp_expression = fun ((exp, typ), ii) ->
(match exp, ii with
| CondExpr (e1, e2, e3), [i1;i2] ->
pp_expression e1; pr_space(); pr_elem i1; pr_space();
do_option (function x -> pp_expression x; pr_space()) e2; pr_elem i2;
- pp_expression e3
+ pr_space(); pp_expression e3
| Sequence (e1, e2), [i] ->
pp_expression e1; pr_elem i; pr_space(); pp_expression e2
| Assignment (e1, op, e2), [i] ->
statxs +> List.iter pp_statement_seq;
pr_elem ii2;
pr_elem i2;
- | Constructor (t, xs), lp::rp::i1::i2::iicommaopt ->
+ | Constructor (t, init), [lp;rp] ->
pr_elem lp;
pp_type t;
pr_elem rp;
- pr_elem i1;
- xs +> List.iter (fun (x, ii) ->
- assert (List.length ii <= 1);
- ii +> List.iter (function x -> pr_elem x; pr_space());
- pp_init x
- );
- iicommaopt +> List.iter pr_elem;
- pr_elem i2;
+ pp_init init
| ParenExpr (e), [i1;i2] -> pr_elem i1; pp_expression e; pr_elem i2;
+ | New (t), [i1] -> pr_elem i1; pp_argument t
+ | Delete(t), [i1] -> pr_elem i1; pp_expression t
+
| (Ident (_) | Constant _ | FunCall (_,_) | CondExpr (_,_,_)
| Sequence (_,_)
| Assignment (_,_,_)
| ArrayAccess (_,_) | RecordAccess (_,_) | RecordPtAccess (_,_)
| SizeOfExpr (_) | SizeOfType (_) | Cast (_,_)
| StatementExpr (_) | Constructor _
- | ParenExpr (_)),_ -> raise Impossible
+ | ParenExpr (_) | New (_) | Delete (_)),_ -> raise Impossible
);
if !Flag_parsing_c.pretty_print_type_info
pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "*/");
end
- and pp_arg_list es =
- es +> List.iter (fun (e, opt) ->
- assert (List.length opt <= 1); (* opt must be a comma? *)
- opt +> List.iter (function x -> pr_elem x; pr_space());
- pp_argument e)
+ and pp_arg_list es = pp_list pp_argument es
and pp_argument argument =
let rec pp_action (ActMisc ii) = ii +> List.iter pr_elem in
pr_elem iifakend
- | Iteration (For ((e1opt,il1),(e2opt,il2),(e3opt, il3),st)),
+ | Iteration (For (first,(e2opt,il2),(e3opt, il3),st)),
[i1;i2;i3;iifakend] ->
pr_elem i1; pr_space();
pr_elem i2;
- pp_statement (Ast_c.mk_st (ExprStatement e1opt) il1);
+ (match first with
+ ForExp (e1opt,il1) ->
+ pp_statement (Ast_c.mk_st (ExprStatement e1opt) il1)
+ | ForDecl decl -> pp_decl decl);
pp_statement (Ast_c.mk_st (ExprStatement e2opt) il2);
assert (null il3);
pp_statement (Ast_c.mk_st (ExprStatement e3opt) il3);
| Compound _ | ExprStatement _
| Selection (If (_, _, _)) | Selection (Switch (_, _))
| Iteration (While (_, _)) | Iteration (DoWhile (_, _))
- | Iteration (For ((_,_), (_,_), (_, _), _))
+ | Iteration (For (_, (_,_), (_, _), _))
| Iteration (MacroIteration (_,_,_))
| Jump ((Continue|Break|Return)) | Jump (ReturnExpr _)
| Jump (GotoComputed _)
pr_elem iopar;
pp_expression e;
pr_elem icpar
- | (ColonExpr _), _ -> raise Impossible)
+ (* the following case used to be just raise Impossible, but
+ the code __asm__ __volatile__ ("dcbz 0, %[input]"
+ ::[input]"r"(&coherence_data[i]));
+ in linux-2.6.34/drivers/video/fsl-diu-fb.c matches this case *)
+ | (ColonExpr e), ii ->
+ (match List.rev ii with
+ icpar::iopar::istring::rest ->
+ List.iter pr_elem (List.rev rest);
+ pr_elem istring;
+ pr_elem iopar;
+ pp_expression e;
+ pr_elem icpar
+ | _ -> raise Impossible))
))
in
match ty, iity with
+ | (NoType,_) -> ()
| (Pointer t, [i]) -> pp_base_type t sto
| (ParenType t, _) -> pp_base_type t sto
| (Array (eopt, t), [i1;i2]) -> pp_base_type t sto
| (FunctionType (returnt, paramst), [i1;i2]) ->
- pp_base_type returnt sto
+ pp_base_type returnt sto;
| (StructUnion (su, sopt, fields),iis) ->
| x -> raise Impossible
);
- fields +> List.iter
- (fun (field) ->
-
- match field with
- | DeclarationField(FieldDeclList(onefield_multivars,iiptvirg))->
- (match onefield_multivars with
- | x::xs ->
- (* handling the first var. Special case, with the
- first var, we print the whole type *)
-
- (match x with
- | (Simple (nameopt, typ)), iivirg ->
- (* first var cant have a preceding ',' *)
- assert (List.length iivirg =|= 0);
- let identinfo =
- match nameopt with
- | None -> None
- | Some name -> Some (get_s_and_info_of_name name)
- in
- pp_type_with_ident identinfo None typ Ast_c.noattr;
-
- | (BitField (nameopt, typ, iidot, expr)), iivirg ->
- (* first var cant have a preceding ',' *)
- assert (List.length iivirg =|= 0);
- (match nameopt with
- | None ->
- pp_type typ;
- | Some name ->
- let (s, is) = get_s_and_info_of_name name in
- pp_type_with_ident
- (Some (s, is)) None typ Ast_c.noattr;
- );
- pr_elem iidot;
- pp_expression expr
-
- ); (* match x, first onefield_multivars *)
-
- (* for other vars *)
- xs +> List.iter (function
- | (Simple (nameopt, typ)), iivirg ->
- iivirg +> List.iter pr_elem;
- let identinfo =
- match nameopt with
- | None -> None
- | Some name -> Some (get_s_and_info_of_name name)
- in
- pp_type_with_ident_rest identinfo typ Ast_c.noattr
-
- | (BitField (nameopt, typ, iidot, expr)), iivirg ->
- iivirg +> List.iter pr_elem;
- (match nameopt with
- | Some name ->
- let (s,is) = get_s_and_info_of_name name in
- pp_type_with_ident_rest
- (Some (s, is)) typ Ast_c.noattr;
- pr_elem iidot;
- pp_expression expr
- | x -> raise Impossible
- )); (* iter other vars *)
-
- | [] -> raise Impossible
- ); (* onefield_multivars *)
- assert (List.length iiptvirg =|= 1);
- iiptvirg +> List.iter pr_elem;
-
-
- | MacroDeclField ((s, es), ii) ->
- let (iis, lp, rp, iiend, ifakestart) =
- Common.tuple_of_list5 ii in
- (* iis::lp::rp::iiend::ifakestart::iisto
- iisto +> List.iter pr_elem; (* static and const *)
- *)
- pr_elem ifakestart;
- pr_elem iis;
- pr_elem lp;
- es +> List.iter (fun (e, opt) ->
- assert (List.length opt <= 1);
- opt +> List.iter pr_elem;
- pp_argument e;
- );
-
- pr_elem rp;
- pr_elem iiend;
-
-
-
- | EmptyField iipttvirg_when_emptyfield ->
- pr_elem iipttvirg_when_emptyfield
-
- | CppDirectiveStruct cpp -> pp_directive cpp
- | IfdefStruct ifdef -> pp_ifdef ifdef
- );
+ fields +> List.iter pp_field;
(match sopt,iis with
| Some s , [i1;i2;i3;i4] -> pr_elem i4
(* | TypeOfExpr _ | TypeOfType _ *)
), _ -> raise Impossible
+ and pp_field_list fields = fields +> Common.print_between pr_nl pp_field
+ and pp_field = function
+ DeclarationField(FieldDeclList(onefield_multivars,iiptvirg))->
+ (match onefield_multivars with
+ x::xs ->
+ (* handling the first var. Special case, with the
+ first var, we print the whole type *)
+
+ (match x with
+ (Simple (nameopt, typ)), iivirg ->
+ (* first var cant have a preceding ',' *)
+ assert (List.length iivirg =|= 0);
+ let identinfo =
+ match nameopt with
+ | None -> None
+ | Some name -> Some (get_s_and_info_of_name name)
+ in
+ pp_type_with_ident identinfo None typ Ast_c.noattr;
+
+ | (BitField (nameopt, typ, iidot, expr)), iivirg ->
+ (* first var cant have a preceding ',' *)
+ assert (List.length iivirg =|= 0);
+ (match nameopt with
+ | None ->
+ pp_type typ;
+ | Some name ->
+ let (s, is) = get_s_and_info_of_name name in
+ pp_type_with_ident
+ (Some (s, is)) None typ Ast_c.noattr;
+ );
+ pr_elem iidot;
+ pp_expression expr
+
+ ); (* match x, first onefield_multivars *)
+
+ (* for other vars *)
+ xs +> List.iter (function
+ | (Simple (nameopt, typ)), iivirg ->
+ iivirg +> List.iter pr_elem;
+ let identinfo =
+ match nameopt with
+ | None -> None
+ | Some name -> Some (get_s_and_info_of_name name)
+ in
+ pp_type_with_ident_rest identinfo typ Ast_c.noattr
+
+ | (BitField (nameopt, typ, iidot, expr)), iivirg ->
+ iivirg +> List.iter pr_elem;
+ (match nameopt with
+ | Some name ->
+ let (s,is) = get_s_and_info_of_name name in
+ pp_type_with_ident_rest
+ (Some (s, is)) typ Ast_c.noattr;
+ pr_elem iidot;
+ pp_expression expr
+ | None ->
+ (* was raise Impossible, but have no idea why because
+ nameless bit fields are accepted by the parser and
+ nothing seems to be done to give them names *)
+ pr_elem iidot;
+ pp_expression expr
+ )); (* iter other vars *)
+
+ | [] -> raise Impossible
+ ); (* onefield_multivars *)
+ assert (List.length iiptvirg =|= 1);
+ iiptvirg +> List.iter pr_elem;
+
+
+ | MacroDeclField ((s, es), ii) ->
+ let (iis, lp, rp, iiend, ifakestart) =
+ Common.tuple_of_list5 ii in
+ (* iis::lp::rp::iiend::ifakestart::iisto
+ iisto +> List.iter pr_elem; (* static and const *)
+ *)
+ pr_elem ifakestart;
+ pr_elem iis;
+ pr_elem lp;
+ es +> List.iter (fun (e, opt) ->
+ assert (List.length opt <= 1);
+ opt +> List.iter pr_elem;
+ pp_argument e;
+ );
+
+ pr_elem rp;
+ pr_elem iiend;
+
+ | EmptyField iipttvirg_when_emptyfield ->
+ pr_elem iipttvirg_when_emptyfield
+
+ | CppDirectiveStruct cpp -> pp_directive cpp
+ | IfdefStruct ifdef -> pp_ifdef ifdef
+
(* used because of DeclList, in int i,*j[23]; we dont print anymore the
int before *j *)
and (pp_type_with_ident_rest: (string * info) option ->
match ty, iity with
(* the work is to do in base_type !! *)
+ | (NoType, iis) -> ()
| (BaseType _, iis) -> print_ident ident
| (Enum (sopt, enumt), iis) -> print_ident ident
| (StructUnion (_, sopt, fields),iis) -> print_ident ident
and (pp_type_left: fullType -> unit) =
fun ((qu, iiqu), (ty, iity)) ->
match ty, iity with
+ (NoType,_) -> failwith "pp_type_left: unexpected NoType"
| (Pointer t, [i]) ->
pr_elem i;
iiqu +> List.iter pr_elem; (* le const est forcement apres le '*' *)
and pp_type_right (((qu, iiqu), (ty, iity)) : fullType) =
match ty, iity with
+ (NoType,_) -> failwith "pp_type_right: unexpected NoType"
| (Pointer t, [i]) -> pp_type_right t
| (Array (eopt, t), [i1;i2]) ->
pp_type_with_ident
(Some (s, iis)) (Some (storage, iisto))
returnType attrs;
- iniopt +> do_option (fun (iini, init) ->
- pr_elem iini;
- pp_init init);
+ (match iniopt with
+ Ast_c.NoInit -> ()
+ | Ast_c.ValInit(iini,init) -> pr_elem iini; pp_init init
+ | Ast_c.ConstrInit((init,[lp;rp])) ->
+ pr_elem lp; pp_arg_list init; pr_elem rp
+ | Ast_c.ConstrInit _ -> raise Impossible)
| None -> pp_type returnType
);
iivirg +> List.iter pr_elem;
pp_type_with_ident_rest
(Some (s, iis)) returnType attrs;
- iniopt +> do_option (fun (iini, init) ->
- pr_elem iini; pp_init init
- );
+ (match iniopt with
+ Ast_c.NoInit -> ()
+ | Ast_c.ValInit(iini,init) -> pr_elem iini; pp_init init
+ | Ast_c.ConstrInit((init,[lp;rp])) ->
+ pr_elem lp; pp_arg_list init; pr_elem rp
+ | Ast_c.ConstrInit _ -> raise Impossible);
| x -> raise Impossible
pr_elem iivirg;
- | MacroDecl ((s, es), iis::lp::rp::iiend::ifakestart::iisto) ->
+ | MacroDecl ((s, es, true), iis::lp::rp::iiend::ifakestart::iisto) ->
pr_elem ifakestart;
iisto +> List.iter pr_elem; (* static and const *)
pr_elem iis;
pr_elem rp;
pr_elem iiend;
- | (DeclList (_, _) | (MacroDecl _)) -> raise Impossible
+ | MacroDecl ((s, es, false), iis::lp::rp::ifakestart::iisto) ->
+ pr_elem ifakestart;
+ iisto +> List.iter pr_elem; (* static and const *)
+ pr_elem iis;
+ pr_elem lp;
+ es +> List.iter (fun (e, opt) ->
+ assert (List.length opt <= 1);
+ opt +> List.iter pr_elem;
+ pp_argument e;
+ );
+ pr_elem rp;
+
+ | MacroDeclInit
+ ((s, es, ini), iis::lp::rp::eq::iiend::ifakestart::iisto) ->
+ pr_elem ifakestart;
+ iisto +> List.iter pr_elem; (* static and const *)
+ pr_elem iis;
+ pr_elem lp;
+ es +> List.iter (fun (e, opt) ->
+ assert (List.length opt <= 1);
+ opt +> List.iter pr_elem;
+ pp_argument e;
+ );
+
+ pr_elem rp;
+ pr_elem eq;
+ pp_init ini;
+ pr_elem iiend;
+
+ | (DeclList (_, _) | (MacroDecl _) | (MacroDeclInit _)) ->
+ raise Impossible
(* ---------------------- *)
and pp_init (init, iinit) =
| InitList _ | InitExpr _
), _ -> raise Impossible
-
+ and pp_init_list ini = pp_list pp_init ini
and pp_designator = function
| DesignatorField (s), [i1; i2] ->
returnt Ast_c.noattr;
pp_attributes pr_elem pr_space attrs;
+ pr_space();
pp_name name;
pr_elem iifunc1;
iib +> List.iter pr_elem;
*)
- paramst +> List.iter (fun (param,iicomma) ->
- assert ((List.length iicomma) <= 1);
- iicomma +> List.iter (function x -> pr_elem x; pr_space());
-
- pp_param param;
- );
+ pp_param_list paramst;
iib +> List.iter pr_elem;
- pr_elem iifunc2;
+ pr_elem iifunc2; pr_space();
pr_elem i1;
statxs +> List.iter pp_statement_seq;
pr_elem i2;
| _ -> raise Impossible
-
+ and pp_param_list paramst = pp_list pp_param paramst
(* ---------------------- *)
and pp_directive = function
| Include {i_include = (s, ii);} ->
let (i1,i2) = Common.tuple_of_list2 ii in
- pr_elem i1; pr_elem i2
+ pr_elem i1; pr_space(); pr_elem i2
| Define ((s,ii), (defkind, defval)) ->
let (idefine,iident,ieol) = Common.tuple_of_list3 ii in
pr_elem idefine;
| DefineTodo -> pr2 "DefineTodo"
in
(match defkind with
- | DefineVar -> ()
+ | DefineVar | Undef -> ()
| DefineFunc (params, ii) ->
let (i1,i2) = tuple_of_list2 ii in
pr_elem i1;
define_val defval;
pr_elem ieol
- | Undef (s, ii) ->
- List.iter pr_elem ii
| PragmaAndCo (ii) ->
List.iter pr_elem ii in
pr2 "XXX";
- | F.ForHeader (_st, (((e1opt,i1), (e2opt,i2), (e3opt,i3)), ii)) ->
+ | F.ForHeader (_st, ((first, (e2opt,i2), (e3opt,i3)), ii)) ->
(*
iif i1; iif i2; iif i3;
iif ii;
{ expression = pp_expression;
- arg_list = pp_arg_list;
- statement = pp_statement;
- decl = pp_decl;
- init = pp_init;
- param = pp_param;
- ty = pp_type;
+ arg_list = pp_arg_list;
+ arg = pp_argument;
+ statement = pp_statement;
+ decl = pp_decl;
+ field = pp_field;
+ field_list = pp_field_list;
+ init = pp_init;
+ init_list = pp_init_list;
+ param = pp_param;
+ paramlist = pp_param_list;
+ ty = pp_type;
type_with_ident = pp_type_with_ident;
- toplevel = pp_toplevel;
- flow = pp_flow;
+ toplevel = pp_toplevel;
+ flow = pp_flow;
}
(*****************************************************************************)
~pr_elem ~pr_space ~pr_nl ~pr_outdent ~pr_indent ~pr_unindent
let pp_expression_simple = ppc.expression
+let pp_decl_simple = ppc.decl
+let pp_field_simple = ppc.field
let pp_statement_simple = ppc.statement
let pp_type_simple = ppc.ty
let pp_init_simple = ppc.init
let pp_expression_gen ~pr_elem ~pr_space =
(pp_elem_sp pr_elem pr_space).expression
-let pp_arg_list_gen pr_elem pr_space =
+let pp_arg_list_gen ~pr_elem ~pr_space =
(pp_elem_sp pr_elem pr_space).arg_list
+let pp_arg_gen ~pr_elem ~pr_space =
+ (pp_elem_sp pr_elem pr_space).arg
+
let pp_statement_gen ~pr_elem ~pr_space =
(pp_elem_sp pr_elem pr_space).statement
-let pp_decl_gen pr_elem pr_space =
+let pp_decl_gen ~pr_elem ~pr_space =
(pp_elem_sp pr_elem pr_space).decl
+let pp_field_gen ~pr_elem ~pr_space =
+ (pp_elem_sp pr_elem pr_space).field
+
+let pp_field_list_gen ~pr_elem ~pr_space =
+ (pp_elem_sp pr_elem pr_space).field_list
+
let pp_init_gen ~pr_elem ~pr_space =
(pp_elem_sp pr_elem pr_space).init
+let pp_init_list_gen ~pr_elem ~pr_space =
+ (pp_elem_sp pr_elem pr_space).init_list
+
let pp_param_gen ~pr_elem ~pr_space =
(pp_elem_sp pr_elem pr_space).param
+let pp_param_list_gen ~pr_elem ~pr_space =
+ (pp_elem_sp pr_elem pr_space).paramlist
+
let pp_type_gen ~pr_elem ~pr_space =
(pp_elem_sp pr_elem pr_space).ty
HCoop / bpt / coccinelle.git / blobdiff