X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/113803cf8147c1b5332cc7d9ac43febcc197e4f0..5427db06e325c3c7c572e2e1ebe88a2fd211641c:/parsing_c/pretty_print_c.ml diff --git a/parsing_c/pretty_print_c.ml b/parsing_c/pretty_print_c.ml index f6cd8d6..8029f09 100644 --- a/parsing_c/pretty_print_c.ml +++ b/parsing_c/pretty_print_c.ml @@ -1,9 +1,12 @@ -(* Copyright (C) 2006, 2007, 2008, 2009 Ecole des Mines de Nantes and DIKU +(* Yoann Padioleau, Julia Lawall + * + * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. + * Copyright (C) 2006, 2007, 2008, 2009 Ecole des Mines de Nantes and DIKU * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License (GPL) * version 2 as published by the Free Software Foundation. - * + * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the @@ -13,42 +16,43 @@ open Common open Ast_c +module F = Control_flow_c + +(*****************************************************************************) +(* Wrappers *) +(*****************************************************************************) +let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_unparsing + +(*****************************************************************************) +(* Types *) +(*****************************************************************************) -type pr_elem_func = Ast_c.info -> unit -type pr_space_func = unit -> unit -type pr_nl_func = unit -> unit -type pr_indent_func = unit -> unit -type pr_outdent_func = unit -> unit -type pr_unindent_func = unit -> unit - -type expression_printer = Ast_c.expression -> unit -type arg_list_printer = Ast_c.argument Ast_c.wrap2 list -> unit -type statement_printer = Ast_c.statement -> unit -type declaration_printer = Ast_c.declaration -> unit -type initialiser_printer = Ast_c.initialiser -> unit -type param_printer = Ast_c.parameterType -> unit -type type_printer = Ast_c.fullType -> unit -type type_with_ident_printer = +type type_with_ident = (string * Ast_c.info) option -> - (Ast_c.storage * Ast_c.il) option -> Ast_c.fullType -> - Ast_c.attribute list -> unit -type toplevel_printer = Ast_c.toplevel -> unit -type flow_printer = Control_flow_c.node -> unit - -(* result type *) -type pretty_printers = - {expression : expression_printer; - arg_list : arg_list_printer; - statement : statement_printer; - decl : declaration_printer; - init : initialiser_printer; - param : param_printer; - ty : type_printer; - type_with_ident : type_with_ident_printer; - toplevel : toplevel_printer; - flow : flow_printer} + (Ast_c.storage * Ast_c.il) option -> + Ast_c.fullType -> + Ast_c.attribute list -> unit + +type 'a printer = 'a -> unit + +type pretty_printers = { + expression : Ast_c.expression printer; + 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; + flow : Control_flow_c.node printer +} + -module F = Control_flow_c (*****************************************************************************) @@ -61,87 +65,105 @@ module F = Control_flow_c * to pretty print some piece of C that was generated, or some * abstract-lined piece of code, etc. *) -let pretty_print_c pr_elem pr_space pr_nl pr_indent pr_outdent pr_unindent = +let mk_pretty_printers + ~pr_elem ~pr_space + ~pr_nl ~pr_indent ~pr_outdent ~pr_unindent + = let start_block () = pr_nl(); pr_indent() in let end_block () = pr_unindent(); pr_nl() in - - let indent_if_needed (s,_) f = - match s with + + let indent_if_needed st f = + match Ast_c.unwrap_st st with Compound _ -> pr_space(); f() | _ -> (*no newline at the end - someone else will do that*) start_block(); f(); pr_unindent() in - - let rec pp_expression = fun ((exp, typ), ii) -> + + + 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 - | Ident (c), [i] -> pr_elem i + | Ident (ident), [] -> pp_name ident (* only a MultiString can have multiple ii *) - | Constant (MultiString), is -> is +> List.iter pr_elem - | Constant (c), [i] -> pr_elem i - | FunCall (e, es), [i1;i2] -> - pp_expression e; pr_elem i1; + | Constant (MultiString _), is -> is +> List.iter pr_elem + | Constant (c), [i] -> pr_elem i + | FunCall (e, es), [i1;i2] -> + pp_expression e; pr_elem i1; pp_arg_list es; pr_elem i2; - - | CondExpr (e1, e2, e3), [i1;i2] -> + + | 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 - | Sequence (e1, e2), [i] -> + do_option (function x -> pp_expression x; pr_space()) e2; pr_elem i2; + 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] -> + | Assignment (e1, op, e2), [i] -> pp_expression e1; pr_space(); pr_elem i; pr_space(); pp_expression e2 - + | Postfix (e, op), [i] -> pp_expression e; pr_elem i; | Infix (e, op), [i] -> pr_elem i; pp_expression e; | Unary (e, op), [i] -> pr_elem i; pp_expression e - | Binary (e1, op, e2), [i] -> + | Binary (e1, op, e2), [i] -> pp_expression e1; pr_space(); pr_elem i; pr_space(); pp_expression e2 - - | ArrayAccess (e1, e2), [i1;i2] -> + + | ArrayAccess (e1, e2), [i1;i2] -> pp_expression e1; pr_elem i1; pp_expression e2; pr_elem i2 - | RecordAccess (e, s), [i1;i2] -> - pp_expression e; pr_elem i1; pr_elem i2 - | RecordPtAccess (e, s), [i1;i2] -> - pp_expression e; pr_elem i1; pr_elem i2 - - | SizeOfExpr (e), [i] -> pr_elem i; pp_expression e - | SizeOfType (t), [i1;i2;i3] -> + | RecordAccess (e, name), [i1] -> + pp_expression e; pr_elem i1; pp_name name; + | RecordPtAccess (e, name), [i1] -> + pp_expression e; pr_elem i1; pp_name name; + + | SizeOfExpr (e), [i] -> + pr_elem i; + (match Ast_c.unwrap e with + ParenExpr (e), _ -> () + | _ -> pr_space()); + pp_expression e + | SizeOfType (t), [i1;i2;i3] -> pr_elem i1; pr_elem i2; pp_type t; pr_elem i3 - | Cast (t, e), [i1;i2] -> + | Cast (t, e), [i1;i2] -> pr_elem i1; pp_type t; pr_elem i2; pp_expression e - - | StatementExpr (statxs, [ii1;ii2]), [i1;i2] -> + + | StatementExpr (statxs, [ii1;ii2]), [i1;i2] -> pr_elem i1; pr_elem ii1; statxs +> List.iter pp_statement_seq; pr_elem ii2; pr_elem i2; - | Constructor (t, xs), lp::rp::i1::i2::iicommaopt -> + | Constructor (t, xs), lp::rp::i1::i2::iicommaopt -> pr_elem lp; pp_type t; pr_elem rp; pr_elem i1; - xs +> List.iter (fun (x, ii) -> + 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; - + | ParenExpr (e), [i1;i2] -> pr_elem i1; pp_expression e; pr_elem i2; - - | (Ident (_) | Constant _ | FunCall (_,_) | CondExpr (_,_,_) + + | New (t), [i1] -> pr_elem i1; pp_argument t + | Delete(t), [i1] -> pr_elem i1; pp_expression t + + | (Ident (_) | Constant _ | FunCall (_,_) | CondExpr (_,_,_) | Sequence (_,_) - | Assignment (_,_,_) + | Assignment (_,_,_) | Postfix (_,_) | Infix (_,_) | Unary (_,_) | Binary (_,_,_) | ArrayAccess (_,_) | RecordAccess (_,_) | RecordPtAccess (_,_) - | SizeOfExpr (_) | SizeOfType (_) | Cast (_,_) + | SizeOfExpr (_) | SizeOfType (_) | Cast (_,_) | StatementExpr (_) | Constructor _ - | ParenExpr (_)),_ -> raise Impossible + | ParenExpr (_) | New (_) | Delete (_)),_ -> raise Impossible ); - + if !Flag_parsing_c.pretty_print_type_info then begin pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "/*"); @@ -155,31 +177,51 @@ let pretty_print_c pr_elem pr_space pr_nl pr_indent pr_outdent pr_unindent = pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str s))); 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_argument argument = + + 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 match argument with | Left e -> pp_expression e - | Right wierd -> - (match wierd with + | Right weird -> + (match weird with | ArgType param -> pp_param param | ArgAction action -> pp_action action) - + +(* ---------------------- *) + and pp_name = function + | RegularName (s, ii) -> + let (i1) = Common.tuple_of_list1 ii in + pr_elem i1 + | CppConcatenatedName xs -> + xs +> List.iter (fun ((x,ii1), ii2) -> + ii2 +> List.iter pr_elem; + ii1 +> List.iter pr_elem; + ) + | CppVariadicName (s, ii) -> + ii +> List.iter pr_elem + | CppIdentBuilder ((s,iis), xs) -> + let (iis, iop, icp) = Common.tuple_of_list3 iis in + pr_elem iis; + pr_elem iop; + xs +> List.iter (fun ((x,iix), iicomma) -> + iicomma +> List.iter pr_elem; + iix +> List.iter pr_elem; + ); + pr_elem icp + (* ---------------------- *) - and pp_statement = function - | Labeled (Label (s, st)), [i1;i2] -> - pr_outdent(); pr_elem i1; pr_elem i2; pr_nl(); pp_statement st - | Labeled (Case (e, st)), [i1;i2] -> + and pp_statement = fun st -> + match Ast_c.get_st_and_ii st with + | Labeled (Label (name, st)), ii -> + let (i2) = Common.tuple_of_list1 ii in + pr_outdent(); pp_name name; pr_elem i2; pr_nl(); pp_statement st + | Labeled (Case (e, st)), [i1;i2] -> pr_unindent(); pr_elem i1; pp_expression e; pr_elem i2; pr_nl(); pr_indent(); pp_statement st - | Labeled (CaseRange (e, e2, st)), [i1;i2;i3] -> + | Labeled (CaseRange (e, e2, st)), [i1;i2;i3] -> pr_unindent(); pr_elem i1; pp_expression e; pr_elem i2; pp_expression e2; pr_elem i3; pr_nl(); pr_indent(); @@ -187,155 +229,168 @@ let pretty_print_c pr_elem pr_space pr_nl pr_indent pr_outdent pr_unindent = | Labeled (Default st), [i1;i2] -> pr_unindent(); pr_elem i1; pr_elem i2; pr_nl(); pr_indent(); pp_statement st - | Compound statxs, [i1;i2] -> + | Compound statxs, [i1;i2] -> pr_elem i1; start_block(); statxs +> Common.print_between pr_nl pp_statement_seq; end_block(); pr_elem i2; - + | ExprStatement (None), [i] -> pr_elem i; | ExprStatement (None), [] -> () | ExprStatement (Some e), [i] -> pp_expression e; pr_elem i (* the last ExprStatement of a for does not have a trailing ';' hence the [] for ii *) - | ExprStatement (Some e), [] -> pp_expression e; - | Selection (If (e, st1, st2)), i1::i2::i3::is -> + | ExprStatement (Some e), [] -> pp_expression e; + | Selection (If (e, st1, st2)), i1::i2::i3::is -> pr_elem i1; pr_space(); pr_elem i2; pp_expression e; pr_elem i3; indent_if_needed st1 (function _ -> pp_statement st1); - (match (st2, is) with + (match (Ast_c.get_st_and_ii st2, is) with | ((ExprStatement None, []), []) -> () | ((ExprStatement None, []), [iifakend]) -> pr_elem iifakend - | st2, [i4;iifakend] -> pr_elem i4; + | _st2, [i4;iifakend] -> pr_elem i4; indent_if_needed st2 (function _ -> pp_statement st2); pr_elem iifakend | x -> raise Impossible ) - | Selection (Switch (e, st)), [i1;i2;i3;iifakend] -> + | Selection (Switch (e, st)), [i1;i2;i3;iifakend] -> pr_elem i1; pr_space(); pr_elem i2; pp_expression e; pr_elem i3; indent_if_needed st (function _-> pp_statement st); pr_elem iifakend - | Iteration (While (e, st)), [i1;i2;i3;iifakend] -> + | Iteration (While (e, st)), [i1;i2;i3;iifakend] -> pr_elem i1; pr_space(); pr_elem i2; pp_expression e; pr_elem i3; indent_if_needed st (function _-> pp_statement st); pr_elem iifakend - | Iteration (DoWhile (st, e)), [i1;i2;i3;i4;i5;iifakend] -> + | Iteration (DoWhile (st, e)), [i1;i2;i3;i4;i5;iifakend] -> pr_elem i1; indent_if_needed st (function _ -> pp_statement st); - pr_elem i2; pr_elem i3; pp_expression e; + pr_elem i2; pr_elem i3; pp_expression e; pr_elem i4; pr_elem i5; pr_elem iifakend - - + + | Iteration (For ((e1opt,il1),(e2opt,il2),(e3opt, il3),st)), [i1;i2;i3;iifakend] -> - + pr_elem i1; pr_space(); pr_elem i2; - pp_statement (ExprStatement e1opt, il1); - pp_statement (ExprStatement e2opt, il2); + pp_statement (Ast_c.mk_st (ExprStatement e1opt) il1); + pp_statement (Ast_c.mk_st (ExprStatement e2opt) il2); assert (null il3); - pp_statement (ExprStatement e3opt, il3); + pp_statement (Ast_c.mk_st (ExprStatement e3opt) il3); pr_elem i3; indent_if_needed st (function _ -> pp_statement st); pr_elem iifakend - + | Iteration (MacroIteration (s,es,st)), [i1;i2;i3;iifakend] -> pr_elem i1; pr_space(); pr_elem i2; - - es +> List.iter (fun (e, opt) -> + + es +> List.iter (fun (e, opt) -> assert (List.length opt <= 1); opt +> List.iter pr_elem; pp_argument e; ); - + pr_elem i3; indent_if_needed st (function _ -> pp_statement st); pr_elem iifakend - - | Jump (Goto s), [i1;i2;i3] -> - pr_elem i1; pr_space(); pr_elem i2; pr_elem i3; + + | Jump (Goto name), ii -> + let (i1, i3) = Common.tuple_of_list2 ii in + pr_elem i1; pr_space(); pp_name name; pr_elem i3; | Jump ((Continue|Break|Return)), [i1;i2] -> pr_elem i1; pr_elem i2; | Jump (ReturnExpr e), [i1;i2] -> pr_elem i1; pr_space(); pp_expression e; pr_elem i2 - | Jump (GotoComputed e), [i1;i2;i3] -> + | Jump (GotoComputed e), [i1;i2;i3] -> pr_elem i1; pr_elem i2; pp_expression e; pr_elem i3 - + | Decl decl, [] -> pp_decl decl - | Asm asmbody, ii -> + | Asm asmbody, ii -> (match ii with - | [iasm;iopar;icpar;iptvirg] -> + | [iasm;iopar;icpar;iptvirg] -> pr_elem iasm; pr_elem iopar; pp_asmbody asmbody; pr_elem icpar; pr_elem iptvirg - | [iasm;ivolatile;iopar;icpar;iptvirg] -> - pr_elem iasm; pr_elem ivolatile; pr_elem iopar; + | [iasm;ivolatile;iopar;icpar;iptvirg] -> + pr_elem iasm; pr_elem ivolatile; pr_elem iopar; pp_asmbody asmbody; pr_elem icpar; pr_elem iptvirg | _ -> raise Impossible ) - - | NestedFunc def, ii -> + + | NestedFunc def, ii -> assert (null ii); pp_def def - | MacroStmt, ii -> + | MacroStmt, ii -> ii +> List.iter pr_elem ; - - | ( Labeled (Label (_,_)) | Labeled (Case (_,_)) + + | (Labeled (Case (_,_)) | Labeled (CaseRange (_,_,_)) | Labeled (Default _) - | Compound _ | ExprStatement _ + | Compound _ | ExprStatement _ | Selection (If (_, _, _)) | Selection (Switch (_, _)) - | Iteration (While (_, _)) | Iteration (DoWhile (_, _)) + | Iteration (While (_, _)) | Iteration (DoWhile (_, _)) | Iteration (For ((_,_), (_,_), (_, _), _)) | Iteration (MacroIteration (_,_,_)) - | Jump (Goto _) | Jump ((Continue|Break|Return)) | Jump (ReturnExpr _) + | Jump ((Continue|Break|Return)) | Jump (ReturnExpr _) | Jump (GotoComputed _) - | Decl _ + | Decl _ ), _ -> raise Impossible - + and pp_statement_seq = function | StmtElem st -> pp_statement st | IfdefStmt ifdef -> pp_ifdef ifdef | CppDirectiveStmt cpp -> pp_directive cpp | IfdefStmt2 (ifdef, xxs) -> pp_ifdef_tree_sequence ifdef xxs - + (* ifdef XXX elsif YYY elsif ZZZ endif *) - and pp_ifdef_tree_sequence ifdef xxs = + and pp_ifdef_tree_sequence ifdef xxs = match ifdef with - | if1::ifxs -> + | if1::ifxs -> pp_ifdef if1; pp_ifdef_tree_sequence_aux ifxs xxs | _ -> raise Impossible - + (* XXX elsif YYY elsif ZZZ endif *) - and pp_ifdef_tree_sequence_aux ifdefs xxs = - Common.zip ifdefs xxs +> List.iter (fun (ifdef, xs) -> + and pp_ifdef_tree_sequence_aux ifdefs xxs = + Common.zip ifdefs xxs +> List.iter (fun (ifdef, xs) -> xs +> List.iter pp_statement_seq; pp_ifdef ifdef ) - - - - - + + + + + (* ---------------------- *) - and pp_asmbody (string_list, colon_list) = + and pp_asmbody (string_list, colon_list) = string_list +> List.iter pr_elem ; - colon_list +> List.iter (fun (Colon xs, ii) -> + colon_list +> List.iter (fun (Colon xs, ii) -> ii +> List.iter pr_elem; - xs +> List.iter (fun (x,iicomma) -> + xs +> List.iter (fun (x,iicomma) -> assert ((List.length iicomma) <= 1); iicomma +> List.iter (function x -> pr_elem x; pr_space()); - (match x with + (match x with | ColonMisc, ii -> ii +> List.iter pr_elem; - | ColonExpr e, [istring;iopar;icpar] -> + | ColonExpr e, [istring;iopar;icpar] -> pr_elem istring; 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)) )) - - + + (* ---------------------- *) - + (* pp_type_with_ident pp_base_type @@ -343,41 +398,41 @@ let pretty_print_c pr_elem pr_space pr_nl pr_indent pr_outdent pr_unindent = pp_type_left pp_type_right pp_type - + pp_decl *) - and (pp_type_with_ident: - (string * info) option -> (storage * il) option -> + and (pp_type_with_ident: + (string * info) option -> (storage * il) option -> fullType -> attribute list -> - unit) = - fun ident sto ((qu, iiqu), (ty, iity)) attrs -> - pp_base_type ((qu, iiqu), (ty, iity)) sto; - (match (ident,ty) with + unit) = + fun ident sto ft attrs -> + pp_base_type ft sto; + (match (ident, Ast_c.unwrap_typeC ft) with (Some _,_) | (_,Pointer _) -> pr_space() | _ -> ()); - pp_type_with_ident_rest ident ((qu, iiqu), (ty, iity)) attrs - - - and (pp_base_type: fullType -> (storage * il) option -> unit) = - fun (qu, (ty, iity)) sto -> - let get_sto sto = - match sto with + pp_type_with_ident_rest ident ft attrs + + + and (pp_base_type: fullType -> (storage * il) option -> unit) = + fun (qu, (ty, iity)) sto -> + let get_sto sto = + match sto with | None -> [] | Some (s, iis) -> (*assert (List.length iis = 1);*) iis in - let print_sto_qu (sto, (qu, iiqu)) = + let print_sto_qu (sto, (qu, iiqu)) = let all_ii = get_sto sto ++ iiqu in - all_ii + all_ii +> List.sort Ast_c.compare_pos +> Common.print_between pr_space pr_elem - + in - let print_sto_qu_ty (sto, (qu, iiqu), iity) = + let print_sto_qu_ty (sto, (qu, iiqu), iity) = let all_ii = get_sto sto ++ iiqu ++ iity in let all_ii2 = all_ii +> List.sort Ast_c.compare_pos in - + if all_ii <> all_ii2 - then begin - (* TODO in fact for pointer, the qualifier is after the type + then begin + (* TODO in fact for pointer, the qualifier is after the type * cf -test strangeorder *) pr2 "STRANGEORDER"; @@ -385,429 +440,502 @@ let pretty_print_c pr_elem pr_space pr_nl pr_indent pr_outdent pr_unindent = end else all_ii2 +> Common.print_between pr_space pr_elem 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 - - - | (StructUnion (su, sopt, fields),iis) -> + | (FunctionType (returnt, paramst), [i1;i2]) -> + pp_base_type returnt sto; + + + | (StructUnion (su, sopt, fields),iis) -> print_sto_qu (sto, qu); - + (match sopt,iis with - | Some s , [i1;i2;i3;i4] -> - pr_elem i1; pr_elem i2; pr_elem i3; - | None, [i1;i2;i3] -> - pr_elem i1; pr_elem i2; + | Some s , [i1;i2;i3;i4] -> + pr_elem i1; pr_elem i2; pr_elem i3; + | None, [i1;i2;i3] -> + pr_elem i1; pr_elem i2; | x -> raise Impossible ); - - fields +> List.iter - (fun (xfield, iipttvirg_when_emptyfield) -> - - match xfield 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 (sopt, typ), iis), iivirg -> - (* first var cant have a preceding ',' *) - assert (List.length iivirg = 0); - let identinfo = - (match sopt, iis with - None,_ -> None - | (Some s, [iis]) -> Some (s, iis) - | x -> raise Impossible) in - pp_type_with_ident identinfo None typ Ast_c.noattr; - - | (BitField (sopt, typ, expr), ii), iivirg -> - (* first var cant have a preceding ',' *) - assert (List.length iivirg = 0); - (match sopt, ii with - | (None , [idot]) -> - pp_type typ; - pr_elem idot; - pp_expression expr - | (Some s, [is;idot]) -> - pp_type_with_ident - (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 - | (Simple (sopt, typ), iis), iivirg -> - iivirg +> List.iter pr_elem; - let identinfo = - (match sopt, iis with - | None,_ -> None - | (Some s, [iis]) -> Some (s, iis) - | x -> raise Impossible) - in - pp_type_with_ident_rest 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 - (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" - - - | EmptyField -> iipttvirg_when_emptyfield +> List.iter pr_elem - - | 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 - | None, [i1;i2;i3] -> pr_elem i3; + | None, [i1;i2;i3] -> pr_elem i3; | x -> raise Impossible ); - - - - | (Enum (sopt, enumt), iis) -> + + + + | (Enum (sopt, enumt), iis) -> print_sto_qu (sto, qu); - + (match sopt, iis with - | (Some s, ([i1;i2;i3;i4]|[i1;i2;i3;i4;_])) -> + | (Some s, ([i1;i2;i3;i4]|[i1;i2;i3;i4;_])) -> pr_elem i1; pr_elem i2; pr_elem i3; - | (None, ([i1;i2;i3]|[i1;i2;i3;_])) -> + | (None, ([i1;i2;i3]|[i1;i2;i3;_])) -> pr_elem i1; pr_elem i2 | x -> raise Impossible ); - - enumt +> List.iter (fun (((s, eopt),ii_s_eq), iicomma) -> + + enumt +> List.iter (fun ((name, eopt), iicomma) -> assert (List.length iicomma <= 1); iicomma +> List.iter (function x -> pr_elem x; pr_space()); - (match eopt, ii_s_eq with - | None, [is] -> pr_elem is; - | Some e, [is;ieq] -> pr_elem is; pr_elem ieq; pp_expression e - | _ -> raise Impossible + pp_name name; + eopt +> Common.do_option (fun (ieq, e) -> + pr_elem ieq; + pp_expression e; )); - + (match sopt, iis with | (Some s, [i1;i2;i3;i4]) -> pr_elem i4 - | (Some s, [i1;i2;i3;i4;i5]) -> + | (Some s, [i1;i2;i3;i4;i5]) -> pr_elem i5; pr_elem i4 (* trailing comma *) | (None, [i1;i2;i3]) -> pr_elem i3 - | (None, [i1;i2;i3;i4]) -> + | (None, [i1;i2;i3;i4]) -> pr_elem i4; pr_elem i3 (* trailing comma *) - - + + | x -> raise Impossible ); - - - | (BaseType _, iis) -> - print_sto_qu_ty (sto, qu, iis); - - | (StructUnionName (s, structunion), iis) -> - assert (List.length iis = 2); + + + | (BaseType _, iis) -> print_sto_qu_ty (sto, qu, iis); - - | (EnumName s, iis) -> - assert (List.length iis = 2); + + | (StructUnionName (s, structunion), iis) -> + assert (List.length iis =|= 2); print_sto_qu_ty (sto, qu, iis); - - | (TypeName (s,_typ), iis) -> - assert (List.length iis = 1); + + | (EnumName s, iis) -> + assert (List.length iis =|= 2); print_sto_qu_ty (sto, qu, iis); - - | (TypeOfExpr (e), iis) -> + + | (TypeName (name,typ), noii) -> + assert (null noii); + let (_s, iis) = get_s_and_info_of_name name in + print_sto_qu_ty (sto, qu, [iis]); + + if !Flag_parsing_c.pretty_print_typedef_value + then begin + pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "{*"); + typ +> Common.do_option (fun typ -> + pp_type typ; + ); + pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "*}"); + end; + + | (TypeOfExpr (e), iis) -> print_sto_qu (sto, qu); (match iis with - | [itypeof;iopar;icpar] -> + | [itypeof;iopar;icpar] -> pr_elem itypeof; pr_elem iopar; pp_expression e; pr_elem icpar; | _ -> raise Impossible ) - - | (TypeOfType (t), iis) -> + + | (TypeOfType (t), iis) -> print_sto_qu (sto, qu); (match iis with - | [itypeof;iopar;icpar] -> + | [itypeof;iopar;icpar] -> pr_elem itypeof; pr_elem iopar; - pp_type t; + pp_type t; pr_elem icpar; | _ -> raise Impossible ) - - | (Pointer _ | (*ParenType _ |*) Array _ | FunctionType _ + + | (Pointer _ | (*ParenType _ |*) Array _ | FunctionType _ (* | StructUnion _ | Enum _ | BaseType _ *) (* | StructUnionName _ | EnumName _ | TypeName _ *) (* | 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; - - -(* 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 -> - fullType -> attribute list -> unit) = - - fun ident (((qu, iiqu), (ty, iity)) as fullt) attrs -> - let print_ident ident = Common.do_option (fun (s, iis) -> + | (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 -> + fullType -> attribute list -> unit) = + + 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 (* 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 | (StructUnionName (s, structunion), iis) -> print_ident ident | (EnumName s, iis) -> print_ident ident - | (TypeName (s,_typ), iis) -> print_ident ident + | (TypeName (_name,_typ), iis) -> print_ident ident | (TypeOfExpr (e), iis) -> print_ident ident | (TypeOfType (e), iis) -> print_ident ident - - - - | (Pointer t, [i]) -> - (* subtil: void ( *done)(int i) is a Pointer + + + + | (Pointer t, [i]) -> + (* subtil: void ( *done)(int i) is a Pointer (FunctionType (return=void, params=int i) *) (*WRONG I THINK, use left & right function *) (* bug: pp_type_with_ident_rest None t; print_ident ident *) - pr_elem i; + pr_elem i; iiqu +> List.iter pr_elem; (* le const est forcement apres le '*' *) pp_type_with_ident_rest ident t attrs; - - (* ugly special case ... todo? maybe sufficient in practice *) - | (ParenType (q1, (Pointer (q2, (FunctionType t, ii3)) , - [ipointer]) ), [i1;i2]) -> - pp_type_left (q2, (FunctionType t, ii3)); - pr_elem i1; - pr_elem ipointer; - print_ident ident; - pr_elem i2; - pp_type_right (q2, (FunctionType t, ii3)); - - (* another ugly special case *) - | (ParenType - (q1, (Array (eopt, - (q2, (Pointer - (q3, (FunctionType t, iifunc)), - [ipointer]))), - [iarray1;iarray2])), [i1;i2]) -> - pp_type_left (q3, (FunctionType t, iifunc)); - pr_elem i1; - pr_elem ipointer; - print_ident ident; - pr_elem iarray1; - do_option pp_expression eopt; - pr_elem iarray2; - pr_elem i2; - pp_type_right (q3, (FunctionType t, iifunc)) - - - - | (ParenType t, [i1;i2]) -> - pr2 "PB PARENTYPE ZARB, I forget about the ()"; - pp_type_with_ident_rest ident t attrs; - - - | (Array (eopt, t), [i1;i2]) -> + + (* ugly special case ... todo? maybe sufficient in practice *) + | (ParenType ttop, [i1;i2]) -> + (match Ast_c.get_ty_and_ii ttop with + | (_q1, (Pointer t2, [ipointer])) -> + (match Ast_c.get_ty_and_ii t2 with + | (q2, (FunctionType t, ii3)) -> + + pp_type_left (q2, mk_tybis (FunctionType t) ii3); + pr_elem i1; + pr_elem ipointer; + print_ident ident; + pr_elem i2; + pp_type_right (q2, mk_tybis (FunctionType t) ii3); + | _ -> + pr2 "PB PARENTYPE ZARB, I forget about the ()"; + pp_type_with_ident_rest ident ttop attrs; + ) + (* another ugly special case *) + | _q1, (Array (eopt,t2 ), [iarray1;iarray2]) -> + (match Ast_c.get_ty_and_ii t2 with + | (_q2, (Pointer t3, [ipointer])) -> + (match Ast_c.get_ty_and_ii t3 with + | (q3, (FunctionType t, iifunc)) -> + + pp_type_left (q3, mk_tybis (FunctionType t) iifunc); + pr_elem i1; + pr_elem ipointer; + print_ident ident; + pr_elem iarray1; + do_option pp_expression eopt; + pr_elem iarray2; + pr_elem i2; + pp_type_right (q3, mk_tybis (FunctionType t) iifunc) + | _ -> + pr2 "PB PARENTYPE ZARB, I forget about the ()"; + pp_type_with_ident_rest ident ttop attrs; + ) + | _ -> + pr2 "PB PARENTYPE ZARB, I forget about the ()"; + pp_type_with_ident_rest ident ttop attrs; + ) + | _t -> + + pr2 "PB PARENTYPE ZARB, I forget about the ()"; + pp_type_with_ident_rest ident ttop attrs; + ) + + + | (Array (eopt, t), [i1;i2]) -> pp_type_left fullt; - + iiqu +> List.iter pr_elem; print_ident ident; - + pp_type_right fullt; - - - | (FunctionType (returnt, paramst), [i1;i2]) -> + + + | (FunctionType (returnt, paramst), [i1;i2]) -> pp_type_left fullt; - + iiqu +> List.iter pr_elem; print_ident ident; - + pp_type_right fullt; - - + + | (FunctionType _ | Array _ | ParenType _ | Pointer _), _ -> raise Impossible - - - and (pp_type_left: fullType -> unit) = - fun ((qu, iiqu), (ty, iity)) -> + + + and (pp_type_left: fullType -> unit) = + fun ((qu, iiqu), (ty, iity)) -> match ty, iity with - | (Pointer t, [i]) -> - pr_elem i; + (NoType,_) -> failwith "pp_type_left: unexpected NoType" + | (Pointer t, [i]) -> + pr_elem i; iiqu +> List.iter pr_elem; (* le const est forcement apres le '*' *) pp_type_left t - + | (Array (eopt, t), [i1;i2]) -> pp_type_left t | (FunctionType (returnt, paramst), [i1;i2]) -> pp_type_left returnt - + | (ParenType t, _) -> failwith "parenType" - - - | (BaseType _, iis) -> () - | (Enum (sopt, enumt), iis) -> () - | (StructUnion (_, sopt, fields),iis) -> () - | (StructUnionName (s, structunion), iis) -> () - | (EnumName s, iis) -> () - | (TypeName (s,_typ), iis) -> () - + + + | (BaseType _, iis) -> () + | (Enum (sopt, enumt), iis) -> () + | (StructUnion (_, sopt, fields),iis) -> () + | (StructUnionName (s, structunion), iis) -> () + | (EnumName s, iis) -> () + | (TypeName (_name,_typ), iis) -> () + | TypeOfType _, _ -> () | TypeOfExpr _, _ -> () - + | (FunctionType _ | Array _ | Pointer _), _ -> raise Impossible - - and pp_param ((b, sopt, t), ii_b_s) = - match b, sopt, ii_b_s with - | false, None, [] -> - pp_type t - | true, None, [i1] -> - pr_elem i1; - pp_type t - - | false, Some s, [i1] -> - pp_type_with_ident - (Some (s, i1)) None t Ast_c.noattr; - | true, Some s, [i1;i2] -> - pr_elem i1; + + and pp_param param = + let {p_namei = nameopt; + p_register = (b,iib); + p_type=t;} = param in + + iib +> List.iter pr_elem; + + match nameopt with + | None -> + pp_type t + | Some name -> + let (s,i1) = get_s_and_info_of_name name in pp_type_with_ident - (Some (s, i2)) None t Ast_c.noattr; - | _ -> raise Impossible - - - and pp_type_right (((qu, iiqu), (ty, iity)) : fullType) = + (Some (s, i1)) None t Ast_c.noattr + + + + + 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]) -> + + | (Array (eopt, t), [i1;i2]) -> pr_elem i1; eopt +> do_option pp_expression; pr_elem i2; pp_type_right t - + | (ParenType t, _) -> failwith "parenType" - | (FunctionType (returnt, paramst), [i1;i2]) -> + | (FunctionType (returnt, paramst), [i1;i2]) -> pr_elem i1; (match paramst with - | (ts, (b, iib)) -> - ts +> List.iter (fun (param,iicomma) -> + | (ts, (b, iib)) -> + ts +> List.iter (fun (param,iicomma) -> assert ((List.length iicomma) <= 1); iicomma +> List.iter (function x -> pr_elem x; pr_space()); - + pp_param param; ); iib +> List.iter pr_elem; ); pr_elem i2 - - | (BaseType _, iis) -> () - | (Enum (sopt, enumt), iis) -> () - | (StructUnion (_, sopt, fields),iis)-> () - | (StructUnionName (s, structunion), iis) -> () - | (EnumName s, iis) -> () - | (TypeName (s,_typ), iis) -> () - + + | (BaseType _, iis) -> () + | (Enum (sopt, enumt), iis) -> () + | (StructUnion (_, sopt, fields),iis)-> () + | (StructUnionName (s, structunion), iis) -> () + | (EnumName s, iis) -> () + | (TypeName (name,_typ), iis) -> () + | TypeOfType _, _ -> () | TypeOfExpr _, _ -> () - + | (FunctionType _ | Array _ | Pointer _), _ -> raise Impossible - + and pp_type t = pp_type_with_ident None None t Ast_c.noattr - + (* ---------------------- *) and pp_decl = function - | DeclList ((({v_namei = var; v_type = returnType; - v_storage = storage; v_attr = attrs; - },[])::xs), - iivirg::ifakestart::iisto) -> - - pr_elem ifakestart; - - (* old: iisto +> List.iter pr_elem; *) - - - (* handling the first var. Special case, we print the whole type *) - (match var with - | Some ((s, ini), iis::iini) -> - pp_type_with_ident - (Some (s, iis)) (Some (storage, iisto)) - returnType attrs; - ini +> do_option (fun init -> - List.iter pr_elem iini; pp_init init); - | None -> pp_type returnType - | _ -> raise Impossible - ); - + | DeclList ((({v_namei = var; + v_type = returnType; + v_storage = storage; + v_attr = attrs; + },[])::xs), + iivirg::ifakestart::iisto) -> + + pr_elem ifakestart; + + (* old: iisto +> List.iter pr_elem; *) + + + (* handling the first var. Special case, we print the whole type *) + (match var with + | Some (name, iniopt) -> + let (s,iis) = get_s_and_info_of_name name in + pp_type_with_ident + (Some (s, iis)) (Some (storage, iisto)) + returnType attrs; + (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 + ); + (* for other vars, we just call pp_type_with_ident_rest. *) - xs +> List.iter (function - | ({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 - (Some (s, iis)) returnType attrs; - ini +> do_option (fun (init) -> - List.iter pr_elem iini; pp_init init); - - - | x -> raise Impossible - ); - - pr_elem iivirg; - - | MacroDecl ((s, es), iis::lp::rp::iiend::ifakestart::iisto) -> + xs +> List.iter (function + | ({v_namei = Some (name, iniopt); + v_type = returnType; + v_storage = storage2; + v_attr = attrs; + }, iivirg) -> + + let (s,iis) = get_s_and_info_of_name name in + assert (storage2 =*= storage); + iivirg +> List.iter pr_elem; + pp_type_with_ident_rest + (Some (s, iis)) returnType attrs; + (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, true), iis::lp::rp::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) -> + 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; - + + | 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 - - + + (* ---------------------- *) and pp_init (init, iinit) = match init, iinit with | InitExpr e, [] -> pp_expression e; - | InitList xs, i1::i2::iicommaopt -> + | InitList xs, i1::i2::iicommaopt -> pr_elem i1; start_block(); - xs +> List.iter (fun (x, ii) -> + xs +> List.iter (fun (x, ii) -> assert (List.length ii <= 1); ii +> List.iter (function e -> pr_elem e; pr_nl()); pp_init x @@ -815,169 +943,162 @@ and pp_init (init, iinit) = iicommaopt +> List.iter pr_elem; end_block(); pr_elem i2; - + | InitDesignators (xs, initialiser), [i1] -> (* : *) xs +> List.iter pp_designator; pr_elem i1; pp_init initialiser - + (* no use of '=' in the "Old" style *) | InitFieldOld (string, initialiser), [i1;i2] -> (* label: in oldgcc *) pr_elem i1; pr_elem i2; pp_init initialiser | InitIndexOld (expression, initialiser), [i1;i2] -> (* [1] in oldgcc *) - pr_elem i1; pp_expression expression; pr_elem i2; + pr_elem i1; pp_expression expression; pr_elem i2; pp_init initialiser - - | (InitIndexOld _ | InitFieldOld _ | InitDesignators _ + + | (InitIndexOld _ | InitFieldOld _ | InitDesignators _ | InitList _ | InitExpr _ ), _ -> raise Impossible - - - + + and pp_init_list ini = pp_list pp_init ini + and pp_designator = function - | DesignatorField (s), [i1; i2] -> - pr_elem i1; pr_elem i2; - | DesignatorIndex (expression), [i1;i2] -> - pr_elem i1; pp_expression expression; pr_elem i2; - - | DesignatorRange (e1, e2), [iocro;iellipsis;iccro] -> + | DesignatorField (s), [i1; i2] -> + pr_elem i1; pr_elem i2; + | DesignatorIndex (expression), [i1;i2] -> + pr_elem i1; pp_expression expression; pr_elem i2; + + | DesignatorRange (e1, e2), [iocro;iellipsis;iccro] -> pr_elem iocro; pp_expression e1; pr_elem iellipsis; - pp_expression e2; pr_elem iccro; - + pp_expression e2; pr_elem iccro; + | (DesignatorField _ | DesignatorIndex _ | DesignatorRange _ ), _ -> raise Impossible - - + + (* ---------------------- *) and pp_attributes pr_elem pr_space attrs = - attrs +> List.iter (fun (attr, ii) -> + attrs +> List.iter (fun (attr, ii) -> ii +> List.iter pr_elem; ); - + (* ---------------------- *) - and pp_def def = + and pp_def def = 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 + match ii with + | iifunc1::iifunc2::i1::i2::ifakestart::isto -> + let {f_name = name; + f_type = (returnt, (paramst, (b, iib))); + f_storage = sto; + f_body = statxs; + f_attr = attrs; + } = defbis in - pr_elem ifakestart; - - pp_type_with_ident None (Some (sto, isto)) + + pp_type_with_ident None (Some (sto, isto)) returnt Ast_c.noattr; - + pp_attributes pr_elem pr_space attrs; - pr_elem is; - - + pr_space(); + pp_name name; + pr_elem iifunc1; - - (* not anymore, cf tests/optional_name_parameter and + + (* not anymore, cf tests/optional_name_parameter and macro_parameter_shortcut.c (match paramst with - | [(((bool, None, t), ii_b_s), iicomma)] -> - assert - (match t with + | [(((bool, None, t), ii_b_s), iicomma)] -> + assert + (match t with | qu, (BaseType Void, ii) -> true - | _ -> true + | _ -> true ); assert (null iicomma); assert (null ii_b_s); pp_type_with_ident None None t - - | paramst -> + + | paramst -> paramst +> List.iter (fun (((bool, s, t), ii_b_s), iicomma) -> iicomma +> List.iter pr_elem; - + (match b, s, ii_b_s with - | false, Some s, [i1] -> + | false, Some s, [i1] -> pp_type_with_ident (Some (s, i1)) None t; - | true, Some s, [i1;i2] -> + | true, Some s, [i1;i2] -> pr_elem i1; pp_type_with_ident (Some (s, i2)) None t; - + (* in definition we have name for params, except when f(void) *) - | _, None, _ -> raise Impossible - | false, None, [] -> - + | _, None, _ -> raise Impossible + | false, None, [] -> + | _ -> raise Impossible ))); - + (* normally ii represent the ",..." but it is also abused with the f(void) case *) (* assert (List.length iib <= 2);*) 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 i1; + + + 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_ifdef ifdef = + + and pp_ifdef ifdef = match ifdef with - | IfdefDirective (ifdef, ii) -> + | IfdefDirective (ifdef, ii) -> List.iter pr_elem ii - - + + and pp_directive = function - | Include {i_include = (s, ii);} -> + | Include {i_include = (s, ii);} -> let (i1,i2) = Common.tuple_of_list2 ii in - pr_elem i1; pr_elem i2 - | Define ((s,ii), (defkind, defval)) -> + 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; pr_elem iident; - + let define_val = function | DefineExpr e -> pp_expression e | DefineStmt st -> pp_statement st - | DefineDoWhileZero ((st,e), ii) -> + | DefineDoWhileZero ((st,e), ii) -> (match ii with - | [ido;iwhile;iopar;icpar] -> + | [ido;iwhile;iopar;icpar] -> pr_elem ido; pp_statement st; - pr_elem iwhile; pr_elem iopar; + pr_elem iwhile; pr_elem iopar; pp_expression e; pr_elem icpar | _ -> raise Impossible ) | DefineFunction def -> pp_def def - + | DefineType ty -> pp_type ty | DefineText (s, ii) -> List.iter pr_elem ii | DefineEmpty -> () | DefineInit ini -> pp_init ini - + | DefineTodo -> pr2 "DefineTodo" in (match defkind with - | DefineVar -> () - | DefineFunc (params, ii) -> + | DefineVar | Undef -> () + | DefineFunc (params, ii) -> let (i1,i2) = tuple_of_list2 ii in - pr_elem i1; - params +> List.iter (fun ((s,iis), iicomma) -> + pr_elem i1; + params +> List.iter (fun ((s,iis), iicomma) -> assert (List.length iicomma <= 1); iicomma +> List.iter pr_elem; iis +> List.iter pr_elem; @@ -986,42 +1107,40 @@ and pp_init (init, iinit) = ); define_val defval; pr_elem ieol - - | Undef (s, ii) -> - List.iter pr_elem ii - | PragmaAndCo (ii) -> + + | PragmaAndCo (ii) -> List.iter pr_elem ii in - - - - + + + + let pp_toplevel = function | Declaration decl -> pp_decl decl | Definition def -> pp_def def - | CppTop directive -> pp_directive directive - - - | MacroTop (s, es, [i1;i2;i3;i4]) -> + | CppTop directive -> pp_directive directive + + + | MacroTop (s, es, [i1;i2;i3;i4]) -> pr_elem i1; pr_elem i2; - es +> List.iter (fun (e, opt) -> + es +> List.iter (fun (e, opt) -> assert (List.length opt <= 1); opt +> List.iter pr_elem; pp_argument e; ); pr_elem i3; pr_elem i4; - - + + | EmptyDef ii -> ii +> List.iter pr_elem - | NotParsedCorrectly ii -> + | NotParsedCorrectly ii -> assert (List.length ii >= 1); - ii +> List.iter pr_elem + ii +> List.iter pr_elem | FinalDef info -> pr_elem (Ast_c.rewrap_str "" info) - + | IfdefTop ifdefdir -> pp_ifdef ifdefdir - + | (MacroTop _) -> raise Impossible in @@ -1034,7 +1153,7 @@ and pp_init (init, iinit) = f_storage = stob; f_body = body; f_attr = attrs},ii) -> - + assert(null body); (* iif ii; @@ -1049,25 +1168,25 @@ and pp_init (init, iinit) = pr2 "Def"; - | F.Decl decl -> + | F.Decl decl -> (* vk_decl bigf decl *) - pr2 "Decl" - - | F.ExprStatement (st, (eopt, ii)) -> - pp_statement (ExprStatement eopt, ii) - - | F.IfHeader (_, (e,ii)) + pr2 "Decl" + + | F.ExprStatement (st, (eopt, ii)) -> + pp_statement (Ast_c.mk_st (ExprStatement eopt) ii) + + | F.IfHeader (_, (e,ii)) | F.SwitchHeader (_, (e,ii)) | F.WhileHeader (_, (e,ii)) - | F.DoWhileTail (e,ii) -> + | F.DoWhileTail (e,ii) -> (* iif ii; vk_expr bigf e *) pr2 "XXX"; - - - | F.ForHeader (_st, (((e1opt,i1), (e2opt,i2), (e3opt,i3)), ii)) -> + + + | F.ForHeader (_st, (((e1opt,i1), (e2opt,i2), (e3opt,i3)), ii)) -> (* iif i1; iif i2; iif i3; iif ii; @@ -1076,145 +1195,161 @@ and pp_init (init, iinit) = e3opt +> do_option (vk_expr bigf); *) pr2 "XXX" - - | F.MacroIterHeader (_s, ((s,es), ii)) -> + + | F.MacroIterHeader (_s, ((s,es), ii)) -> (* iif ii; vk_argument_list bigf es; *) pr2 "XXX" - - - | F.ReturnExpr (_st, (e,ii)) -> + + + | F.ReturnExpr (_st, (e,ii)) -> (* iif ii; vk_expr bigf e*) pr2 "XXX" - - - | F.Case (_st, (e,ii)) -> + + + | F.Case (_st, (e,ii)) -> (* iif ii; vk_expr bigf e *) pr2 "XXX" - - | F.CaseRange (_st, ((e1, e2),ii)) -> + + | F.CaseRange (_st, ((e1, e2),ii)) -> (* iif ii; vk_expr bigf e1; vk_expr bigf e2 *) pr2 "XXX" - - - + + + | F.CaseNode i -> () - - | F.DefineExpr e -> + + | F.DefineExpr e -> (* vk_expr bigf e *) pr2 "XXX" - - | F.DefineType ft -> + + | F.DefineType ft -> (* vk_type bigf ft *) pr2 "XXX" - - | F.DefineHeader ((s,ii), (defkind)) -> + + | F.DefineHeader ((s,ii), (defkind)) -> (* iif ii; vk_define_kind bigf defkind; *) pr2 "XXX" - - - | F.DefineDoWhileZeroHeader (((),ii)) -> + + + | F.DefineDoWhileZeroHeader (((),ii)) -> (* iif ii *) pr2 "XXX" - - - | F.Include {i_include = (s, ii);} -> + + + | F.Include {i_include = (s, ii);} -> (* iif ii; *) pr2 "XXX" - - - | F.MacroTop (s, args, ii) -> + + + | F.MacroTop (s, args, ii) -> (* iif ii; vk_argument_list bigf args *) pr2 "XXX" - - - | F.Break (st,((),ii)) -> + + + | F.Break (st,((),ii)) -> (* iif ii *) pr2 "XXX" - | F.Continue (st,((),ii)) -> + | F.Continue (st,((),ii)) -> (* iif ii *) pr2 "XXX" - | F.Default (st,((),ii)) -> + | F.Default (st,((),ii)) -> (* iif ii *) pr2 "XXX" - | F.Return (st,((),ii)) -> + | F.Return (st,((),ii)) -> (* iif ii *) pr2 "XXX" - | F.Goto (st, (s,ii)) -> + | F.Goto (st, name, ((),ii)) -> (* iif ii *) pr2 "XXX" - | F.Label (st, (s,ii)) -> + | F.Label (st, name, ((),ii)) -> (* iif ii *) pr2 "XXX" - | F.EndStatement iopt -> + | F.EndStatement iopt -> (* do_option infof iopt *) pr2 "XXX" - | F.DoHeader (st, info) -> + | F.DoHeader (st, info) -> (* infof info *) pr2 "XXX" - | F.Else info -> + | F.Else info -> (* infof info *) pr2 "XXX" - | F.SeqEnd (i, info) -> + | F.SeqEnd (i, info) -> (* infof info *) pr2 "XXX" - | F.SeqStart (st, i, info) -> + | F.SeqStart (st, i, info) -> (* infof info *) pr2 "XXX" - - | F.MacroStmt (st, ((),ii)) -> + + | F.MacroStmt (st, ((),ii)) -> (* iif ii *) pr2 "XXX" - | F.Asm (st, (asmbody,ii)) -> + | F.Asm (st, (asmbody,ii)) -> (* iif ii; vk_asmbody bigf asmbody *) pr2 "XXX" - - - | F.IfdefHeader (info) -> + + + | F.IfdefHeader (info) -> pp_ifdef info - | F.IfdefElse (info) -> + | F.IfdefElse (info) -> pp_ifdef info - | F.IfdefEndif (info) -> + | F.IfdefEndif (info) -> pp_ifdef info - - | F.DefineTodo -> + + | F.DefineTodo -> pr2 "XXX" - - + + | (F.TopNode|F.EndNode| - F.ErrorExit|F.Exit|F.Enter| - F.FallThroughNode|F.AfterNode|F.FalseNode|F.TrueNode|F.InLoopNode| + F.ErrorExit|F.Exit|F.Enter|F.LoopFallThroughNode|F.FallThroughNode| + F.AfterNode|F.FalseNode|F.TrueNode|F.InLoopNode| F.Fake) -> pr2 "YYY" in - {expression = pp_expression; - arg_list = pp_arg_list; - statement = pp_statement; - decl = pp_decl; - init = pp_init; - param = pp_param; - ty = pp_type; + { expression = pp_expression; + 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; + } + (*****************************************************************************) - + (* Here we do not use (mcode, env). It is a simple C pretty printer. *) let pr_elem info = let s = Ast_c.str_of_info info in + if !Flag_parsing_c.pretty_print_comment_info then begin + let before = !(info.comments_tag).mbefore in + if not (null before) then begin + pp "-->"; + before +> List.iter (fun (comment_like, pinfo) -> + let s = pinfo.Common.str in + pp s + ); + pp "<--"; + end; + end; pp s - + let pr_space _ = Format.print_space() let pr_nl _ = () @@ -1222,60 +1357,83 @@ let pr_indent _ = () let pr_outdent _ = () let pr_unindent _ = () + let ppc = - pretty_print_c pr_elem pr_space pr_nl pr_outdent pr_indent pr_unindent - + mk_pretty_printers + ~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_toplevel_simple = ppc.toplevel let pp_flow_simple = ppc.flow -let pp_elem_sp pr_elem pr_space = - pretty_print_c pr_elem pr_space pr_nl pr_outdent pr_indent pr_unindent -let pp_expression_gen pr_elem pr_space = +let pp_elem_sp ~pr_elem ~pr_space = + mk_pretty_printers + ~pr_elem ~pr_space + ~pr_nl ~pr_outdent ~pr_indent ~pr_unindent + +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 = +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_init_gen pr_elem pr_space = +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_param_gen pr_elem pr_space = +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_type_gen pr_elem pr_space = +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 let pp_type_with_ident_gen pr_elem pr_space = (pp_elem_sp pr_elem pr_space).type_with_ident -let pp_program_gen pr_elem pr_space = +let pp_program_gen ~pr_elem ~pr_space = (pp_elem_sp pr_elem pr_space).toplevel - -let string_of_expression e = +let string_of_expression e = Common.format_to_string (fun () -> pp_expression_simple e - ) - + ) + +let string_of_toplevel top = + Common.format_to_string (fun () -> + pp_toplevel_simple top + ) + let (debug_info_of_node: - Ograph_extended.nodei -> Control_flow_c.cflow -> string) = - fun nodei flow -> + Ograph_extended.nodei -> Control_flow_c.cflow -> string) = + fun nodei flow -> let node = flow#nodes#assoc nodei in let s = Common.format_to_string (fun () -> pp_flow_simple node ) in let pos = Lib_parsing_c.min_pinfo_of_node node in (spf "%s(n%d)--> %s" (Common.string_of_parse_info_bis pos) nodei s) - +