X-Git-Url: http://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/174d164065f16d4a54fd565b9cae251e89a5095e..HEAD:/parsing_c/unparse_cocci.ml diff --git a/parsing_c/unparse_cocci.ml b/parsing_c/unparse_cocci.ml index 5fbaa8a..cc7d51c 100644 --- a/parsing_c/unparse_cocci.ml +++ b/parsing_c/unparse_cocci.ml @@ -1,4 +1,5 @@ (* + * Copyright (C) 2012, INRIA. * Copyright (C) 2010, University of Copenhagen DIKU and INRIA. * Copyright (C) 2006, 2007 Julia Lawall * @@ -35,11 +36,14 @@ exception CantBeInPlus type pos = Before | After | InPlace type nlhint = StartBox | EndBox | SpaceOrNewline of string ref +let get_string_info = function + Ast.Noindent s | Ast.Indent s | Ast.Space s -> s + let unknown = -1 let rec do_all (env, pr, pr_celem, pr_cspace, pr_space, pr_arity, pr_barrier, - indent, unindent) + indent, unindent, eatspace) generating xxs before = (* Just to be able to copy paste the code from pretty_print_cocci.ml. *) @@ -58,14 +62,20 @@ let end_block () = unindent true; force_newline () in let print_string_box s = print_string s in let print_option = Common.do_option in -let print_option_prespace fn = function - None -> () - | Some x -> pr_space(); fn x in let print_option_space fn = function None -> () | Some x -> fn x; pr_space() in +let print_option_prespace fn = function + None -> () + | Some x -> pr_space(); fn x in let print_between = Common.print_between in +let rec param_print_between between fn = function + | [] -> () + | [x] -> fn x + | x::xs -> fn x; between x; param_print_between between fn xs in + + let outdent _ = () (* should go to leftmost col, does nothing now *) in let pretty_print_c = @@ -110,8 +120,7 @@ let print_around printer term = function print_anything bef; printer term; print_anything aft in let print_string_befaft fn fn1 x info = - let print ln col = - function Ast.Noindent s | Ast.Indent s -> print_string s ln col in + let print ln col s = print_string (get_string_info s) ln col in List.iter (function (s,ln,col) -> fn1(); print ln col s; force_newline()) info.Ast.strbef; @@ -121,11 +130,13 @@ let print_string_befaft fn fn1 x info = info.Ast.straft in let print_meta (r,x) = print_text x in -let print_pos = function - Ast.MetaPos(name,_,_,_,_) -> - let name = Ast.unwrap_mcode name in - print_text "@"; print_meta name - | _ -> () in +let print_pos l = + List.iter + (function + Ast.MetaPos(name,_,_,_,_) -> + let name = Ast.unwrap_mcode name in + print_text "@"; print_meta name) + l in (* --------------------------------------------------------------------- *) @@ -145,11 +156,11 @@ let mcode fn (s,info,mc,pos) = let str = match str with Ast.Noindent s -> unindent false; s - | Ast.Indent s -> s in + | Ast.Indent s -> s + | Ast.Space s -> s in print_string str line col; Some line | Some lb when line =|= lb -> - let str = match str with Ast.Noindent s | Ast.Indent s -> s in - print_string str line col; Some line + print_string (get_string_info str) line col; Some line | _ -> force_newline(); (* not super elegant to put side-effecting unindent in a let @@ -157,7 +168,8 @@ let mcode fn (s,info,mc,pos) = let str = match str with Ast.Noindent s -> unindent false; s - | Ast.Indent s -> s in + | Ast.Indent s -> s + | Ast.Space s -> s in print_string str line col; Some line) lb comments in let line_before = print_comments None info.Ast.strbef in @@ -177,7 +189,9 @@ let mcode fn (s,info,mc,pos) = force_newline(); print_text "- "; fn s line lcol; print_pos pos; - print_anything plus_stream + (match plus_stream with + Ast.NOREPLACEMENT -> () + | Ast.REPLACEMENT(plus_stream,ct) -> print_anything plus_stream) | (true, Ast.CONTEXT(_,plus_streams)) -> let fn s = force_newline(); fn s line lcol; print_pos pos in print_around fn s plus_streams @@ -194,20 +208,24 @@ in (* --------------------------------------------------------------------- *) -let handle_metavar name fn = +let lookup_metavar name = let ((_,b) as s,info,mc,pos) = name in let line = info.Ast.line in let lcol = info.Ast.column in - match Common.optionise (fun () -> List.assoc s env) with + let rcol = if lcol = unknown then unknown else lcol + (String.length b) in + let res = Common.optionise (fun () -> List.assoc s env) in + (res,b,line,lcol,rcol) in + +let handle_metavar name fn = + let (res,name_string,line,lcol,rcol) = lookup_metavar name in + match res with None -> - let name_string (_,s) = s in if generating - then - mcode (function _ -> print_string (name_string s)) name + then mcode (function _ -> print_string name_string) name else failwith (Printf.sprintf "SP line %d: Not found a value in env for: %s" - line (name_string s)) + line name_string) | Some e -> pr_barrier line lcol; (if generating @@ -215,16 +233,14 @@ let handle_metavar name fn = (* call mcode to preserve the -+ annotation *) mcode (fun _ _ _ -> fn e) name else fn e); - let rcol = - if lcol = unknown then unknown else lcol + (String.length b) in pr_barrier line rcol in (* --------------------------------------------------------------------- *) let dots between fn d = match Ast.unwrap d with - Ast.DOTS(l) -> print_between between fn l - | Ast.CIRCLES(l) -> print_between between fn l - | Ast.STARS(l) -> print_between between fn l + Ast.DOTS(l) -> param_print_between between fn l + | Ast.CIRCLES(l) -> param_print_between between fn l + | Ast.STARS(l) -> param_print_between between fn l in let nest_dots starter ender fn f d = @@ -238,6 +254,11 @@ let nest_dots starter ender fn f d = mcode print_string ender in +let print_disj_list fn l = + print_text "\n(\n"; + print_between (function _ -> print_text "\n|\n") fn l; + print_text "\n)\n" in + (* --------------------------------------------------------------------- *) (* Identifier *) @@ -247,94 +268,219 @@ let rec ident i = | Ast.MetaId(name,_,_,_) -> handle_metavar name (function | (Ast_c.MetaIdVal (id,_)) -> print_text id - | _ -> raise Impossible + | _ -> raise (Impossible 142) ) | Ast.MetaFunc(name,_,_,_) -> handle_metavar name (function | (Ast_c.MetaFuncVal id) -> print_text id - | _ -> raise Impossible + | _ -> raise (Impossible 143) ) | Ast.MetaLocalFunc(name,_,_,_) -> handle_metavar name (function | (Ast_c.MetaLocalFuncVal id) -> print_text id - | _ -> raise Impossible + | _ -> raise (Impossible 144) ) + | Ast.AsIdent(id,asid) -> ident id + + | Ast.DisjId(id_list) -> + if generating + then print_disj_list ident id_list + else raise CantBeInPlus | Ast.OptIdent(_) | Ast.UniqueIdent(_) -> raise CantBeInPlus - in + (* --------------------------------------------------------------------- *) (* Expression *) -let print_disj_list fn l = - print_text "\n(\n"; - print_between (function _ -> print_text "\n|\n") fn l; - print_text "\n)\n" in - let rec expression e = + let top = 0 in + let assign = 1 in + let cond = 2 in + let log_or = 3 in + let log_and = 4 in + let bit_or = 5 in + let bit_xor = 6 in + let bit_and = 7 in + let equal = 8 in + let relat = 9 in + let shift = 10 in + let addit = 11 in + let mulit = 12 in + let cast = 13 in + let unary = 14 in + let postfix = 15 in + let primary = 16 in + let left_prec_of (op, _, _, _) = + match op with + | Ast.Arith Ast.Plus -> addit + | Ast.Arith Ast.Minus -> addit + | Ast.Arith Ast.Mul -> mulit + | Ast.Arith Ast.Div -> mulit + | Ast.Arith Ast.Min -> relat + | Ast.Arith Ast.Max -> relat + | Ast.Arith Ast.Mod -> mulit + | Ast.Arith Ast.DecLeft -> shift + | Ast.Arith Ast.DecRight -> shift + | Ast.Arith Ast.And -> bit_and + | Ast.Arith Ast.Or -> bit_or + | Ast.Arith Ast.Xor -> bit_xor + + | Ast.Logical Ast.Inf -> relat + | Ast.Logical Ast.Sup -> relat + | Ast.Logical Ast.InfEq -> relat + | Ast.Logical Ast.SupEq -> relat + | Ast.Logical Ast.Eq -> equal + | Ast.Logical Ast.NotEq -> equal + | Ast.Logical Ast.AndLog -> log_and + | Ast.Logical Ast.OrLog -> log_or + in + let right_prec_of (op, _, _, _) = + match op with + | Ast.Arith Ast.Plus -> mulit + | Ast.Arith Ast.Minus -> mulit + | Ast.Arith Ast.Mul -> cast + | Ast.Arith Ast.Div -> cast + | Ast.Arith Ast.Min -> shift + | Ast.Arith Ast.Max -> shift + | Ast.Arith Ast.Mod -> cast + | Ast.Arith Ast.DecLeft -> addit + | Ast.Arith Ast.DecRight -> addit + | Ast.Arith Ast.And -> equal + | Ast.Arith Ast.Or -> bit_xor + | Ast.Arith Ast.Xor -> bit_and + + | Ast.Logical Ast.Inf -> shift + | Ast.Logical Ast.Sup -> shift + | Ast.Logical Ast.InfEq -> shift + | Ast.Logical Ast.SupEq -> shift + | Ast.Logical Ast.Eq -> relat + | Ast.Logical Ast.NotEq -> relat + | Ast.Logical Ast.AndLog -> bit_or + | Ast.Logical Ast.OrLog -> log_and + in + let prec_of_c = function + | Ast_c.Ident (ident) -> primary + | Ast_c.Constant (c) -> primary + | Ast_c.FunCall (e, es) -> postfix + | Ast_c.CondExpr (e1, e2, e3) -> cond + | Ast_c.Sequence (e1, e2) -> top + | Ast_c.Assignment (e1, op, e2) -> assign + | Ast_c.Postfix(e, op) -> postfix + | Ast_c.Infix (e, op) -> unary + | Ast_c.Unary (e, op) -> unary + | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Plus, e2) -> addit + | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Minus, e2) -> addit + | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Mul, e2) -> addit + | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Div, e2) -> addit + | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Min, e2) -> relat + | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Max, e2) -> relat + | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Mod, e2) -> addit + | Ast_c.Binary (e1, Ast_c.Arith Ast_c.DecLeft, e2) -> addit + | Ast_c.Binary (e1, Ast_c.Arith Ast_c.DecRight, e2) -> addit + | Ast_c.Binary (e1, Ast_c.Arith Ast_c.And, e2) -> addit + | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Or, e2) -> addit + | Ast_c.Binary (e1, Ast_c.Arith Ast_c.Xor, e2) -> addit + | Ast_c.Binary (e1, Ast_c.Logical Ast_c.AndLog, e2) -> addit + | Ast_c.Binary (e1, Ast_c.Logical Ast_c.OrLog, e2) -> addit + | Ast_c.Binary (e1, Ast_c.Logical Ast_c.Eq, e2) -> addit + | Ast_c.Binary (e1, Ast_c.Logical Ast_c.NotEq, e2) -> addit + | Ast_c.Binary (e1, Ast_c.Logical Ast_c.Sup, e2) -> addit + | Ast_c.Binary (e1, Ast_c.Logical Ast_c.Inf, e2) -> addit + | Ast_c.Binary (e1, Ast_c.Logical Ast_c.SupEq, e2) -> addit + | Ast_c.Binary (e1, Ast_c.Logical Ast_c.InfEq, e2) -> addit + | Ast_c.ArrayAccess (e1, e2) -> postfix + | Ast_c.RecordAccess (e, name) -> postfix + | Ast_c.RecordPtAccess (e, name) -> postfix + | Ast_c.SizeOfExpr (e) -> unary + | Ast_c.SizeOfType (t) -> unary + | Ast_c.Cast (t, e) -> cast + | Ast_c.StatementExpr (statxs, _) -> top + | Ast_c.Constructor (t, init) -> unary + | Ast_c.ParenExpr (e) -> primary + | Ast_c.New (_, t) -> unary + | Ast_c.Delete(t) -> unary + in + + let rec loop e prec = match Ast.unwrap e with Ast.Ident(id) -> ident id | Ast.Constant(const) -> mcode constant const | Ast.FunCall(fn,lp,args,rp) -> - expression fn; mcode (print_string_with_hint StartBox) lp; + loop fn postfix; mcode (print_string_with_hint StartBox) lp; dots (function _ -> ()) arg_expression args; mcode (print_string_with_hint EndBox) rp | Ast.Assignment(left,op,right,_) -> - expression left; pr_space(); mcode assignOp op; - pr_space(); expression right + loop left unary; pr_space(); mcode assignOp op; + pr_space(); loop right assign + | Ast.Sequence(left,op,right) -> + loop left top; mcode print_string op; + pr_space(); loop right assign | Ast.CondExpr(exp1,why,exp2,colon,exp3) -> - expression exp1; pr_space(); mcode print_string why; - print_option (function e -> pr_space(); expression e) exp2; - pr_space(); mcode print_string colon; pr_space(); expression exp3 - | Ast.Postfix(exp,op) -> expression exp; mcode fixOp op - | Ast.Infix(exp,op) -> mcode fixOp op; expression exp - | Ast.Unary(exp,op) -> mcode unaryOp op; expression exp + loop exp1 log_or; pr_space(); mcode print_string why; + print_option (function e -> pr_space(); loop e top) exp2; + pr_space(); mcode print_string colon; pr_space(); loop exp3 cond + | Ast.Postfix(exp,op) -> loop exp postfix; mcode fixOp op + | Ast.Infix(exp,op) -> mcode fixOp op; loop exp unary + | Ast.Unary(exp,op) -> mcode unaryOp op; loop exp unary | Ast.Binary(left,op,right) -> - expression left; pr_space(); mcode binaryOp op; pr_space(); - expression right + loop left (left_prec_of op); pr_space(); mcode binaryOp op; pr_space(); + loop right (right_prec_of op) | Ast.Nested(left,op,right) -> failwith "nested only in minus code" | Ast.Paren(lp,exp,rp) -> - mcode print_string_box lp; expression exp; close_box(); + mcode print_string_box lp; loop exp top; close_box(); mcode print_string rp | Ast.ArrayAccess(exp1,lb,exp2,rb) -> - expression exp1; mcode print_string_box lb; expression exp2; close_box(); + loop exp1 postfix; mcode print_string_box lb; loop exp2 top; close_box(); mcode print_string rb | Ast.RecordAccess(exp,pt,field) -> - expression exp; mcode print_string pt; ident field + loop exp postfix; mcode print_string pt; ident field | Ast.RecordPtAccess(exp,ar,field) -> - expression exp; mcode print_string ar; ident field + loop exp postfix; mcode print_string ar; ident field | Ast.Cast(lp,ty,rp,exp) -> mcode print_string_box lp; fullType ty; close_box(); - mcode print_string rp; expression exp + mcode print_string rp; loop exp cast | Ast.SizeOfExpr(sizeof,exp) -> - mcode print_string sizeof; expression exp + mcode print_string sizeof; loop exp unary | Ast.SizeOfType(sizeof,lp,ty,rp) -> mcode print_string sizeof; mcode print_string_box lp; fullType ty; close_box(); mcode print_string rp | Ast.TypeExp(ty) -> fullType ty + | Ast.Constructor(lp,ty,rp,init) -> + mcode print_string_box lp; fullType ty; close_box(); + mcode print_string rp; initialiser true init | Ast.MetaErr(name,_,_,_) -> failwith "metaErr not handled" | Ast.MetaExpr (name,_,_,_typedontcare,_formdontcare,_) -> - handle_metavar name (function - | Ast_c.MetaExprVal (exp,_) -> - pretty_print_c.Pretty_print_c.expression exp - | _ -> raise Impossible + handle_metavar name (function + | Ast_c.MetaExprVal ((((e, _), _) as exp),_) -> + if prec_of_c e < prec then + begin + print_text "("; + pretty_print_c.Pretty_print_c.expression exp; + print_text ")" + end + else + pretty_print_c.Pretty_print_c.expression exp + | _ -> raise (Impossible 145) ) | Ast.MetaExprList (name,_,_,_) -> - handle_metavar name (function + handle_metavar name (function | Ast_c.MetaExprListVal args -> pretty_print_c.Pretty_print_c.arg_list args | Ast_c.MetaParamListVal _ -> failwith "have meta param list matching meta exp list\n"; - | _ -> raise Impossible + | _ -> raise (Impossible 146) ) + | Ast.AsExpr(expr,asexpr) -> loop expr prec + | Ast.EComma(cm) -> mcode print_string cm | Ast.DisjExpr(exp_list) -> @@ -367,6 +513,8 @@ let rec expression e = | Ast.OptExp(exp) | Ast.UniqueExp(exp) -> raise CantBeInPlus + in + loop e top and arg_expression e = match Ast.unwrap e with @@ -378,6 +526,7 @@ and arg_expression e = and unaryOp = function Ast.GetRef -> print_string "&" + | Ast.GetRefLabel -> print_string "&&" | Ast.DeRef -> print_string "*" | Ast.UnPlus -> print_string "+" | Ast.UnMinus -> print_string "-" @@ -399,10 +548,12 @@ and binaryOp = function | Ast.Logical(lop) -> logicalOp lop and arithOp = function - Ast.Plus -> print_string "+" + Ast.Plus -> print_string "+" | Ast.Minus -> print_string "-" | Ast.Mul -> print_string "*" | Ast.Div -> print_string "/" + | Ast.Max -> print_string ">?" + | Ast.Min -> print_string " print_string "%" | Ast.DecLeft -> print_string "<<" | Ast.DecRight -> print_string ">>" @@ -432,7 +583,13 @@ and constant = function and fullType ft = match Ast.unwrap ft with - Ast.Type(cv,ty) -> print_option_space (mcode const_vol) cv; typeC ty + Ast.Type(_,cv,ty) -> + (match Ast.unwrap ty with + Ast.Pointer(_,_) -> + typeC ty; print_option_prespace (mcode const_vol) cv + | _ -> print_option_space (mcode const_vol) cv; typeC ty) + + | Ast.AsType(ty, asty) -> fullType ty | Ast.DisjType _ -> failwith "can't be in plus" | Ast.OptType(_) | Ast.UniqueType(_) -> raise CantBeInPlus @@ -451,7 +608,8 @@ and typeC ty = Ast.BaseType(ty,strings) -> print_between pr_space (mcode print_string) strings | Ast.SignedT(sgn,ty) -> mcode sign sgn; print_option_prespace typeC ty - | Ast.Pointer(ty,star) -> fullType ty; ft_space ty; mcode print_string star + | Ast.Pointer(ty,star) -> + fullType ty; ft_space ty; mcode print_string star; eatspace() | Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2) (function _ -> ()) @@ -460,8 +618,14 @@ and typeC ty = | Ast.Array(ty,lb,size,rb) -> fullType ty; mcode print_string lb; print_option expression size; mcode print_string rb - | Ast.EnumName(kind,name) -> mcode print_string kind; pr_space(); - ident name + | Ast.EnumName(kind,name) -> + mcode print_string kind; + print_option_prespace ident name + | Ast.EnumDef(ty,lb,ids,rb) -> + fullType ty; ft_space ty; + mcode print_string lb; + dots force_newline expression ids; + mcode print_string rb | Ast.StructUnionName(kind,name) -> mcode structUnion kind; print_option_prespace ident name | Ast.StructUnionDef(ty,lb,decls,rb) -> @@ -474,17 +638,24 @@ and typeC ty = handle_metavar name (function Ast_c.MetaTypeVal exp -> pretty_print_c.Pretty_print_c.ty exp - | _ -> raise Impossible) + | _ -> raise (Impossible 147)) and baseType = function Ast.VoidType -> print_string "void" | Ast.CharType -> print_string "char" | Ast.ShortType -> print_string "short" + | Ast.ShortIntType -> print_string "short int" | Ast.IntType -> print_string "int" | Ast.DoubleType -> print_string "double" + | Ast.LongDoubleType -> print_string "long double" | Ast.FloatType -> print_string "float" | Ast.LongType -> print_string "long" + | Ast.LongIntType -> print_string "long int" | Ast.LongLongType -> print_string "long long" + | Ast.LongLongIntType -> print_string "long long int" + | Ast.SizeType -> print_string "size_t " + | Ast.SSizeType -> print_string "ssize_t " + | Ast.PtrDiffType -> print_string "ptrdiff_t " and structUnion = function Ast.Struct -> print_string "struct" @@ -513,7 +684,7 @@ and storage = function and print_named_type ty id = match Ast.unwrap ty with - Ast.Type(None,ty1) -> + Ast.Type(_,None,ty1) -> (match Ast.unwrap ty1 with Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> print_function_pointer (ty,lp1,star,rp1,lp2,params,rp2) @@ -526,7 +697,8 @@ and print_named_type ty id = match Ast.unwrap ty with Ast.Array(ty,lb,size,rb) -> (match Ast.unwrap ty with - Ast.Type(None,ty) -> + Ast.Type(_,cv,ty) -> + print_option_space (mcode const_vol) cv; loop ty (function _ -> k (); @@ -549,22 +721,51 @@ and ty_space ty = and ft_space ty = match Ast.unwrap ty with - Ast.Type(cv,ty) -> - (match Ast.unwrap ty with - Ast.Pointer(_,_) -> () - | Ast.MetaType(name,_,_) -> - (match List.assoc (Ast.unwrap_mcode name) env with - Ast_c.MetaTypeVal (tq,ty) -> - (match Ast_c.unwrap ty with - Ast_c.Pointer(_,_) -> () - | _ -> pr_space()) - | _ -> pr_space()) - | _ -> pr_space()) + Ast.Type(_,cv,ty) -> + let isptr = + match Ast.unwrap ty with + Ast.Pointer(_,_) -> true + | Ast.MetaType(name,_,_) -> + let (res,name_string,line,lcol,rcol) = lookup_metavar name in + (match res with + None -> + failwith + (Printf.sprintf "variable %s not known on SP line %d\n" + name_string line) + | Some (Ast_c.MetaTypeVal (tq,ty)) -> + (match Ast_c.unwrap ty with + Ast_c.Pointer(_,_) -> true + | _ -> false) + | _ -> false) + | _ -> false in + if isptr then () else pr_space() | _ -> pr_space() - + and declaration d = match Ast.unwrap d with - Ast.Init(stg,ty,id,eq,ini,sem) -> + Ast.MetaDecl(name,_,_) -> + handle_metavar name + (function + Ast_c.MetaDeclVal d -> + pretty_print_c.Pretty_print_c.decl d + | _ -> raise (Impossible 148)) + | Ast.MetaField(name,_,_) -> + handle_metavar name + (function + Ast_c.MetaFieldVal f -> + pretty_print_c.Pretty_print_c.field f + | _ -> raise (Impossible 149)) + + | Ast.MetaFieldList(name,_,_,_) -> + handle_metavar name + (function + Ast_c.MetaFieldListVal f -> + print_between force_newline pretty_print_c.Pretty_print_c.field f + | _ -> raise (Impossible 150)) + + | Ast.AsDecl(decl,asdecl) -> declaration decl + + | Ast.Init(stg,ty,id,eq,ini,sem) -> print_option (mcode storage) stg; print_option (function _ -> pr_space()) stg; print_named_type ty id; @@ -577,14 +778,20 @@ and declaration d = mcode print_string sem | Ast.MacroDecl(name,lp,args,rp,sem) -> ident name; mcode print_string_box lp; - dots (function _ -> ()) expression args; + dots (function _ -> ()) arg_expression args; close_box(); mcode print_string rp; mcode print_string sem + | Ast.MacroDeclInit(name,lp,args,rp,eq,ini,sem) -> + ident name; mcode print_string_box lp; + dots (function _ -> ()) arg_expression args; + close_box(); mcode print_string rp; + pr_space(); mcode print_string eq; + pr_space(); initialiser true ini; mcode print_string sem | Ast.TyDecl(ty,sem) -> fullType ty; mcode print_string sem | Ast.Typedef(stg,ty,id,sem) -> mcode print_string stg; fullType ty; typeC id; mcode print_string sem - | Ast.DisjDecl(_) | Ast.MetaDecl(_,_,_) -> raise CantBeInPlus + | Ast.DisjDecl(_) -> raise CantBeInPlus | Ast.Ddots(_,_) -> raise CantBeInPlus | Ast.OptDecl(decl) | Ast.UniqueDecl(decl) -> raise CantBeInPlus @@ -598,18 +805,29 @@ and initialiser nlcomma i = handle_metavar name (function Ast_c.MetaInitVal ini -> pretty_print_c.Pretty_print_c.init ini - | _ -> raise Impossible) + | _ -> raise (Impossible 151)) + | Ast.MetaInitList(name,_,_,_) -> + handle_metavar name (function + Ast_c.MetaInitListVal ini -> + pretty_print_c.Pretty_print_c.init_list ini + | _ -> raise (Impossible 152)) + | Ast.AsInit(init,asinit) -> initialiser nlcomma init | Ast.InitExpr(exp) -> expression exp - | Ast.InitList(_,lb,initlist,rb,[]) -> + | Ast.ArInitList(lb,initlist,rb) -> + (match Ast.undots initlist with + [] -> mcode print_string lb; mcode print_string rb + | lst -> + mcode print_string lb; start_block(); + initialiser_list nlcomma lst; + end_block(); mcode print_string rb) + | Ast.StrInitList(_,lb,[],rb,[]) -> + mcode print_string lb; mcode print_string rb + | Ast.StrInitList(_,lb,initlist,rb,[]) -> mcode print_string lb; start_block(); - (* awkward, because the comma is separate from the initialiser *) - let rec loop = function - [] -> () - | [x] -> initialiser false x - | x::xs -> initialiser nlcomma x; loop xs in - loop initlist; + initialiser_list nlcomma initlist; end_block(); mcode print_string rb - | Ast.InitList(_,lb,initlist,rb,_) -> failwith "unexpected whencode in plus" + | Ast.StrInitList(_,lb,initlist,rb,_) -> + failwith "unexpected whencode in plus" | Ast.InitGccExt(designators,eq,ini) -> List.iter designator designators; pr_space(); mcode print_string eq; pr_space(); initialiser nlcomma ini @@ -617,10 +835,27 @@ and initialiser nlcomma i = ident name; mcode print_string eq; initialiser nlcomma ini | Ast.IComma(comma) -> mcode print_string comma; - if nlcomma then force_newline() + if nlcomma then force_newline() else pr_space() + | Ast.Idots(dots,Some whencode) -> + if generating + then + (mcode print_string dots; + print_text " when != "; + initialiser nlcomma whencode) + else raise CantBeInPlus + | Ast.Idots(dots,None) -> + if generating + then mcode print_string dots + else raise CantBeInPlus | Ast.OptIni(ini) | Ast.UniqueIni(ini) -> raise CantBeInPlus +and initialiser_list nlcomma = function + (* awkward, because the comma is separate from the initialiser *) + [] -> () + | [x] -> initialiser false x + | x::xs -> initialiser nlcomma x; initialiser_list nlcomma xs + and designator = function Ast.DesignatorField(dot,id) -> mcode print_string dot; ident id | Ast.DesignatorIndex(lb,exp,rb) -> @@ -643,9 +878,15 @@ and parameterTypeDef p = (function Ast_c.MetaParamVal p -> pretty_print_c.Pretty_print_c.param p - | _ -> raise Impossible) + | _ -> raise (Impossible 153)) | Ast.MetaParamList(name,_,_,_) -> - failwith "not handling MetaParamList" + handle_metavar name + (function + Ast_c.MetaParamListVal p -> + pretty_print_c.Pretty_print_c.paramlist p + | _ -> raise (Impossible 154)) + + | Ast.AsParam(p,e) -> raise CantBeInPlus | Ast.PComma(cm) -> mcode print_string cm | Ast.Pdots(dots) | Ast.Pcircles(dots) when generating -> @@ -694,7 +935,7 @@ and rule_elem arity re = end_block(); pr_arity arity; mcode print_string brace | Ast.ExprStatement(exp,sem) -> - pr_arity arity; expression exp; mcode print_string sem + pr_arity arity; print_option expression exp; mcode print_string sem | Ast.IfHeader(iff,lp,exp,rp) -> pr_arity arity; @@ -714,17 +955,16 @@ and rule_elem arity re = mcode print_string whl; pr_space(); mcode print_string_box lp; expression exp; close_box(); mcode print_string rp; mcode print_string sem - | Ast.ForHeader(fr,lp,e1,sem1,e2,sem2,e3,rp) -> + | Ast.ForHeader(fr,lp,first,e2,sem2,e3,rp) -> pr_arity arity; - mcode print_string fr; mcode print_string_box lp; - print_option expression e1; mcode print_string sem1; + mcode print_string fr; mcode print_string_box lp; forinfo first; print_option expression e2; mcode print_string sem2; print_option expression e3; close_box(); mcode print_string rp | Ast.IteratorHeader(nm,lp,args,rp) -> pr_arity arity; ident nm; pr_space(); mcode print_string_box lp; - dots (function _ -> ()) expression args; close_box(); + dots (function _ -> ()) arg_expression args; close_box(); mcode print_string rp | Ast.SwitchHeader(switch,lp,exp,rp) -> @@ -752,6 +992,8 @@ and rule_elem arity re = | Ast.TopInit(init) -> initialiser false init | Ast.Include(inc,s) -> mcode print_string inc; print_text " "; mcode inc_file s + | Ast.Undef(def,id) -> + mcode print_string def; pr_space(); ident id | Ast.DefineHeader(def,id,params) -> mcode print_string def; pr_space(); ident id; print_define_parameters params @@ -770,18 +1012,23 @@ and rule_elem arity re = else raise CantBeInPlus | Ast.MetaRuleElem(name,_,_) -> - raise Impossible + raise (Impossible 155) | Ast.MetaStmt(name,_,_,_) -> handle_metavar name (function | Ast_c.MetaStmtVal stm -> pretty_print_c.Pretty_print_c.statement stm - | _ -> raise Impossible + | _ -> raise (Impossible 156) ) | Ast.MetaStmtList(name,_,_) -> failwith "MetaStmtList not supported (not even in ast_c metavars binding)" +and forinfo = function + Ast.ForExp(e1,sem1) -> + print_option expression e1; mcode print_string sem1 + | Ast.ForDecl (_,_,decl) -> declaration decl + and print_define_parameters params = match Ast.unwrap params with Ast.NoParams -> () @@ -805,11 +1052,32 @@ and print_fninfo = function | Ast.FAttr(attr) -> mcode print_string attr; pr_space() in let indent_if_needed s f = - match Ast.unwrap s with - Ast.Seq(lbrace,body,rbrace) -> pr_space(); f() - | _ -> + let isseq = + match Ast.unwrap s with + Ast.Seq(lbrace,body,rbrace) -> true + | Ast.Atomic s -> + (match Ast.unwrap s with + | Ast.MetaStmt(name,_,_,_) -> + let (res,name_string,line,lcol,rcol) = lookup_metavar name in + (match res with + None -> + failwith + (Printf.sprintf "variable %s not known on SP line %d\n" + name_string line) + | Some (Ast_c.MetaStmtVal stm) -> + (match Ast_c.unwrap stm with + Ast_c.Compound _ -> true + | _ -> false) + | _ -> failwith "bad metavariable value") + | _ -> false) + | _ -> false in + if isseq + then begin pr_space(); f() end + else + begin (*no newline at the end - someone else will do that*) - start_block(); f(); unindent true in + start_block(); f(); unindent true + end in let rec statement arity s = match Ast.unwrap s with @@ -840,7 +1108,7 @@ let rec statement arity s = | Ast.Iterator(header,body,(_,_,_,aft)) -> rule_elem arity header; indent_if_needed body (function _ -> statement arity body); - mcode (fun _ _ _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos) + mcode (fun _ _ _ -> ()) ((),Ast.no_info,aft,[]) | Ast.Switch(header,lb,decls,cases,rb) -> rule_elem arity header; pr_space(); rule_elem arity lb; @@ -858,6 +1126,8 @@ let rec statement arity s = rule_elem arity header; pr_space(); dots force_newline (statement arity) body + | Ast.AsStmt(stmt,asstmt) -> statement arity stmt + | Ast.Disj([stmt_dots]) -> if generating then @@ -921,7 +1191,7 @@ and case_line arity c = let top_level t = match Ast.unwrap t with Ast.FILEINFO(old_file,new_file) -> raise CantBeInPlus - | Ast.DECL(stmt) -> statement "" stmt + | Ast.NONDECL(stmt) -> statement "" stmt | Ast.CODE(stmt_dots) -> dots force_newline (statement "") stmt_dots | Ast.ERRORWORDS(exps) -> raise CantBeInPlus in @@ -962,12 +1232,24 @@ let rec pp_any = function | Ast.Rule_elemTag(x) -> rule_elem "" x; false | Ast.StatementTag(x) -> statement "" x; false + | Ast.ForInfoTag(x) -> forinfo x; false | Ast.CaseLineTag(x) -> case_line "" x; false | Ast.ConstVolTag(x) -> const_vol x unknown unknown; false | Ast.Pragma(xs) -> - let print = function Ast.Noindent s | Ast.Indent s -> print_text s in - print_between force_newline print xs; false + (match xs with (Ast.Space s)::_ -> pr_space() | _ -> ()); + let rec loop = function + [] -> () + | [Ast.Noindent s] -> unindent false; print_text s + | [Ast.Indent s] -> print_text s + | (Ast.Space s) :: (((Ast.Indent _ | Ast.Noindent _) :: _) as rest) -> + print_text s; force_newline(); loop rest + | (Ast.Space s) :: rest -> print_text s; pr_space(); loop rest + | Ast.Noindent s :: rest -> + unindent false; print_text s; force_newline(); loop rest + | Ast.Indent s :: rest -> + print_text s; force_newline(); loop rest in + loop xs; false | Ast.Token(x,None) -> print_text x; if_open_brace x | Ast.Token(x,Some info) -> mcode @@ -977,14 +1259,19 @@ let rec pp_any = function | _ -> ()); print_string x line lcol) (let nomcodekind = Ast.CONTEXT(Ast.DontCarePos,Ast.NOTHING) in - (x,info,nomcodekind,Ast.NoMetaPos)); + (x,info,nomcodekind,[])); if_open_brace x | Ast.Code(x) -> let _ = top_level x in false (* this is not '...', but a list of expr/statement/params, and normally there should be no '...' inside them *) - | Ast.ExprDotsTag(x) -> dots (function _ -> ()) expression x; false + | Ast.ExprDotsTag(x) -> + let check_comma cm = + match Ast.unwrap cm with + Ast.EComma(cm) -> pr_space() + | _ -> () in + dots check_comma expression x; false | Ast.ParamDotsTag(x) -> parameter_list x; false | Ast.StmtDotsTag(x) -> dots force_newline (statement "") x; false | Ast.DeclDotsTag(x) -> dots force_newline declaration x; false @@ -995,6 +1282,8 @@ let rec pp_any = function | Ast.SgrepEndTag(x) -> failwith "unexpected end tag" in +(*Printf.printf "start of the function\n";*) + anything := (function x -> let _ = pp_any x in ()); (* todo? imitate what is in pretty_print_cocci ? *) @@ -1016,7 +1305,10 @@ in then let hd = List.hd xxs in match hd with - (Ast.StatementTag s::_) when isfn s -> + (Ast.Pragma l::_) + when List.for_all (function Ast.Space x -> true | _ -> false) l -> + () + | (Ast.StatementTag s::_) when isfn s -> force_newline(); force_newline() | (Ast.Pragma _::_) | (Ast.Rule_elemTag _::_) | (Ast.StatementTag _::_) @@ -1061,10 +1353,12 @@ in (match Ast.unwrap x with Ast.IComma _ -> false | _ -> true) - | Ast.Token(t,_) when List.mem t [",";";";"(";")"] -> false + | Ast.Token(t,_) when List.mem t [",";";";"(";")";".";"->"] -> + false | _ -> true in let space_needed_after = function - Ast.Token(t,_) when List.mem t ["("] -> (*never needed*) false + Ast.Token(t,_) + when List.mem t ["(";".";"->"] -> (*never needed*) false | Ast.Token(t,_) when List.mem t ["if";"for";"while";"do"] -> (* space always needed *) pr_space(); false @@ -1091,11 +1385,11 @@ in newline_after() let rec pp_list_list_any (envs, pr, pr_celem, pr_cspace, pr_space, pr_arity, - pr_barrier, indent, unindent) + pr_barrier, indent, unindent, eatspace) generating xxs before = List.iter (function env -> do_all (env, pr, pr_celem, pr_cspace, pr_space, pr_arity, pr_barrier, - indent, unindent) + indent, unindent, eatspace) generating xxs before) envs