X-Git-Url: http://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/5636bb2c2537506718da74f85a2b81a5ff3df16f..7fe62b653dbe13c8fc74c58c3ca4b8af523c1637:/parsing_c/pretty_print_c.ml diff --git a/parsing_c/pretty_print_c.ml b/parsing_c/pretty_print_c.ml index ff542fb..4abdc7c 100644 --- a/parsing_c/pretty_print_c.ml +++ b/parsing_c/pretty_print_c.ml @@ -40,8 +40,12 @@ type pretty_printers = { arg_list : (Ast_c.argument Ast_c.wrap2 list) 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; @@ -76,7 +80,11 @@ let mk_pretty_printers 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 @@ -92,7 +100,7 @@ let mk_pretty_printers | 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] -> @@ -128,21 +136,17 @@ let mk_pretty_printers 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 (_,_,_) @@ -150,7 +154,7 @@ let mk_pretty_printers | ArrayAccess (_,_) | RecordAccess (_,_) | RecordPtAccess (_,_) | SizeOfExpr (_) | SizeOfType (_) | Cast (_,_) | StatementExpr (_) | Constructor _ - | ParenExpr (_)),_ -> raise Impossible + | ParenExpr (_) | New (_) | Delete (_)),_ -> raise Impossible ); if !Flag_parsing_c.pretty_print_type_info @@ -167,11 +171,7 @@ let mk_pretty_printers 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 @@ -366,7 +366,19 @@ let mk_pretty_printers 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)) )) @@ -423,6 +435,7 @@ let mk_pretty_printers 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 @@ -441,98 +454,7 @@ let mk_pretty_printers | 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 @@ -626,7 +548,100 @@ let mk_pretty_printers (* | 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 *) @@ -643,6 +658,7 @@ let mk_pretty_printers match ty, iity with (* the work is to do in base_type !! *) + | (NoType _, iis) -> failwith "printing notype" | (BaseType _, iis) -> print_ident ident | (Enum (sopt, enumt), iis) -> print_ident ident | (StructUnion (_, sopt, fields),iis) -> print_ident ident @@ -736,6 +752,7 @@ let mk_pretty_printers 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 '*' *) @@ -780,6 +797,7 @@ let mk_pretty_printers 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]) -> @@ -839,9 +857,12 @@ let mk_pretty_printers 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 ); @@ -858,9 +879,12 @@ let mk_pretty_printers 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 @@ -868,7 +892,7 @@ let mk_pretty_printers 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; @@ -882,6 +906,19 @@ let mk_pretty_printers pr_elem rp; pr_elem iiend; + | 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; + | (DeclList (_, _) | (MacroDecl _)) -> raise Impossible @@ -916,7 +953,7 @@ 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] -> @@ -956,6 +993,7 @@ and pp_init (init, iinit) = returnt Ast_c.noattr; pp_attributes pr_elem pr_space attrs; + pr_space(); pp_name name; pr_elem iifunc1; @@ -997,22 +1035,17 @@ and pp_init (init, iinit) = 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 (* ---------------------- *) @@ -1025,7 +1058,7 @@ and pp_init (init, iinit) = 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; @@ -1054,7 +1087,7 @@ and pp_init (init, iinit) = | DefineTodo -> pr2 "DefineTodo" in (match defkind with - | DefineVar -> () + | DefineVar | Undef -> () | DefineFunc (params, ii) -> let (i1,i2) = tuple_of_list2 ii in pr_elem i1; @@ -1068,8 +1101,6 @@ and pp_init (init, iinit) = define_val defval; pr_elem ieol - | Undef (s, ii) -> - List.iter pr_elem ii | PragmaAndCo (ii) -> List.iter pr_elem ii in @@ -1279,15 +1310,19 @@ and pp_init (init, iinit) = { 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; + 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; } (*****************************************************************************) @@ -1321,6 +1356,8 @@ let ppc = ~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 @@ -1336,21 +1373,33 @@ let pp_elem_sp ~pr_elem ~pr_space = 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_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