X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/708f4980a90e2a254d7863f875888e9f5c6db0b3..17ba07880e1838028b4516ba7a2db2147b3aa1c9:/parsing_cocci/pretty_print_cocci.ml diff --git a/parsing_cocci/pretty_print_cocci.ml b/parsing_cocci/pretty_print_cocci.ml index 918d933..96236b5 100644 --- a/parsing_cocci/pretty_print_cocci.ml +++ b/parsing_cocci/pretty_print_cocci.ml @@ -1,23 +1,27 @@ (* -* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen -* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller -* This file is part of Coccinelle. -* -* Coccinelle is free software: you can redistribute it and/or modify -* it under the terms of the GNU General Public License as published by -* the Free Software Foundation, according to version 2 of the License. -* -* Coccinelle 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 -* GNU General Public License for more details. -* -* You should have received a copy of the GNU General Public License -* along with Coccinelle. If not, see . -* -* The authors reserve the right to distribute this or future versions of -* Coccinelle under other licenses. -*) + * Copyright 2012, INRIA + * Julia Lawall, Gilles Muller + * Copyright 2010-2011, INRIA, University of Copenhagen + * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix + * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen + * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix + * This file is part of Coccinelle. + * + * Coccinelle is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, according to version 2 of the License. + * + * Coccinelle 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 + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with Coccinelle. If not, see . + * + * The authors reserve the right to distribute this or future versions of + * Coccinelle under other licenses. + *) open Format @@ -74,25 +78,27 @@ and print_anything_list = function let print_around printer term = function Ast.NOTHING -> printer term - | Ast.BEFORE(bef) -> print_anything "<<< " bef; printer term - | Ast.AFTER(aft) -> printer term; print_anything ">>> " aft - | Ast.BEFOREAFTER(bef,aft) -> + | Ast.BEFORE(bef,_) -> print_anything "<<< " bef; printer term + | Ast.AFTER(aft,_) -> printer term; print_anything ">>> " aft + | Ast.BEFOREAFTER(bef,aft,_) -> print_anything "<<< " bef; printer term; print_anything ">>> " aft let print_string_befaft fn x info = - List.iter (function (s,_,_) -> print_string s; force_newline()) - info.Ast.strbef; + let print = function + Ast.Noindent s | Ast.Indent s | Ast.Space s -> print_string s in + List.iter (function (s,_,_) -> print s; force_newline()) info.Ast.strbef; fn x; - List.iter (function (s,_,_) -> force_newline(); print_string s) - info.Ast.straft + List.iter (function (s,_,_) -> force_newline(); print s) info.Ast.straft let print_meta (r,x) = print_string r; print_string ":"; print_string x -let print_pos = function - Ast.MetaPos(name,_,_,_,_) -> - let name = Ast.unwrap_mcode name in - print_string "@"; print_meta name - | _ -> () +let print_pos l = + List.iter + (function + Ast.MetaPos(name,_,_,_,_) -> + let name = Ast.unwrap_mcode name in + print_string "@"; print_meta name) + l let mcode fn = function (x, _, Ast.MINUS(_,_,adj,plus_stream), pos) -> @@ -100,24 +106,29 @@ let mcode fn = function then print_string (if !Flag.sgrep_mode2 then "*" else "-"); fn x; print_pos pos; if !print_plus_flag - then print_anything ">>> " plus_stream + then + (match plus_stream with + Ast.NOREPLACEMENT -> () + | Ast.REPLACEMENT(plus_stream,_) -> print_anything ">>> " plus_stream) | (x, _, Ast.CONTEXT(_,plus_streams), pos) -> if !print_plus_flag then let fn x = fn x; print_pos pos in print_around fn x plus_streams else (fn x; print_pos pos) - | (x, info, Ast.PLUS, pos) -> + | (x, info, Ast.PLUS _, pos) -> let fn x = fn x; print_pos pos in print_string_befaft fn x info let print_mcodekind = function Ast.MINUS(_,_,_,plus_stream) -> print_string "MINUS"; - print_anything ">>> " plus_stream + (match plus_stream with + Ast.NOREPLACEMENT -> () + | Ast.REPLACEMENT(plus_stream,_) -> print_anything ">>> " plus_stream) | Ast.CONTEXT(_,plus_streams) -> print_around (function _ -> print_string "CONTEXT") () plus_streams - | Ast.PLUS -> print_string "PLUS" + | Ast.PLUS _ -> print_string "PLUS" (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) @@ -129,22 +140,32 @@ let dots between fn d = | Ast.CIRCLES(l) -> print_between between fn l | Ast.STARS(l) -> print_between between fn l -let nest_dots multi fn f d = - let mo s = if multi then "<+"^s else "<"^s in - let mc s = if multi then s^"+>" else s^">" in - match Ast.unwrap d with - Ast.DOTS(l) -> - print_string (mo "..."); f(); start_block(); - print_between force_newline fn l; - end_block(); print_string (mc "...") - | Ast.CIRCLES(l) -> - print_string (mo "ooo"); f(); start_block(); - print_between force_newline fn l; - end_block(); print_string (mc "ooo") - | Ast.STARS(l) -> - print_string (mo "***"); f(); start_block(); - print_between force_newline fn l; - end_block(); print_string (mc "***") +let nest_dots starter ender fn f d = + mcode print_string starter; + f(); start_block(); + (match Ast.unwrap d with + Ast.DOTS(l) -> print_between force_newline fn l + | Ast.CIRCLES(l) -> print_between force_newline fn l + | Ast.STARS(l) -> print_between force_newline fn l); + end_block(); + mcode print_string ender + +(* --------------------------------------------------------------------- *) +(* Disjunctions *) + +let print_disj_list fn l = + if !print_newlines_disj + then (force_newline(); print_string "("; force_newline()) + else print_string "("; + print_between + (function _ -> + if !print_newlines_disj + then (force_newline(); print_string "|"; force_newline()) + else print_string " | ") + fn l; + if !print_newlines_disj + then (force_newline(); print_string ")"; force_newline()) + else print_string ")" (* --------------------------------------------------------------------- *) @@ -162,6 +183,23 @@ let print_type keep info = function print_string " inherited:"; print_bool inherited;*) print_string " */"*) +(* --------------------------------------------------------------------- *) +(* Contraint on Identifier and Function *) +(* FIXME: Not called at the moment *) + +let rec idconstraint = function + Ast.IdNoConstraint -> print_string "/* No constraint */" + | Ast.IdNegIdSet (str,meta) -> + List.iter (function s -> print_string (" "^s)) str; + List.iter (function (r,n) -> print_string " "; print_meta(r,n)) meta + | Ast.IdRegExpConstraint re -> regconstraint re + +and regconstraint = function + Ast.IdRegExp (re,_) -> + print_string "~= \""; print_string re; print_string "\"" + | Ast.IdNotRegExp (re,_) -> + print_string "~!= \""; print_string re; print_string "\"" + (* --------------------------------------------------------------------- *) (* Identifier *) @@ -171,6 +209,7 @@ let rec ident i = | Ast.MetaId(name,_,keep,inherited) -> mcode print_meta name | Ast.MetaFunc(name,_,_,_) -> mcode print_meta name | Ast.MetaLocalFunc(name,_,_,_) -> mcode print_meta name + | Ast.DisjId(id_list) -> print_disj_list ident id_list | Ast.OptIdent(id) -> print_string "?"; ident id | Ast.UniqueIdent(id) -> print_string "!"; ident id @@ -182,20 +221,6 @@ and print_unitary = function (* --------------------------------------------------------------------- *) (* Expression *) -let print_disj_list fn l = - if !print_newlines_disj - then (force_newline(); print_string "("; force_newline()) - else print_string "("; - print_between - (function _ -> - if !print_newlines_disj - then (force_newline(); print_string "|"; force_newline()) - else print_string " | ") - fn l; - if !print_newlines_disj - then (force_newline(); print_string ")"; force_newline()) - else print_string ")" - let rec expression e = match Ast.unwrap e with Ast.Ident(id) -> ident id @@ -207,6 +232,9 @@ let rec expression e = | Ast.Assignment(left,op,right,simple) -> expression left; print_string " "; mcode assignOp op; print_string " "; expression right + | Ast.Sequence(left,op,right) -> + expression left; mcode print_string op; + print_string " "; expression right | Ast.CondExpr(exp1,why,exp2,colon,exp3) -> expression exp1; print_string " "; mcode print_string why; print_option (function e -> print_string " "; expression e) exp2; @@ -240,19 +268,23 @@ let rec expression e = 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 init | Ast.MetaErr(name,_,_,_) -> mcode print_meta name | Ast.MetaExpr(name,_,keep,ty,form,inherited) -> mcode print_meta name; print_type keep inherited ty | Ast.MetaExprList(name,_,_,_) -> mcode print_meta name + | Ast.AsExpr(exp,asexp) -> expression exp; print_string "@"; expression asexp | Ast.EComma(cm) -> mcode print_string cm; print_space() | Ast.DisjExpr(exp_list) -> print_disj_list expression exp_list - | Ast.NestExpr(expr_dots,Some whencode,multi) -> - nest_dots multi expression + | Ast.NestExpr(starter,expr_dots,ender,Some whencode,multi) -> + nest_dots starter ender expression (function _ -> print_string " when != "; expression whencode) expr_dots - | Ast.NestExpr(expr_dots,None,multi) -> - nest_dots multi expression (function _ -> ()) expr_dots + | Ast.NestExpr(starter,expr_dots,ender,None,multi) -> + nest_dots starter ender expression (function _ -> ()) expr_dots | Ast.Edots(dots,Some whencode) | Ast.Ecircles(dots,Some whencode) | Ast.Estars(dots,Some whencode) -> @@ -265,6 +297,7 @@ let rec 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 "-" @@ -325,9 +358,10 @@ and storage = function and fullType ft = match Ast.unwrap ft with - Ast.Type(cv,ty) -> + Ast.Type(_,cv,ty) -> print_option (function x -> mcode const_vol x; print_string " ") cv; typeC ty + | Ast.AsType(ty,asty) -> fullType ty; print_string "@"; fullType asty | Ast.DisjType(decls) -> print_disj_list fullType decls | Ast.OptType(ty) -> print_string "?"; fullType ty | Ast.UniqueType(ty) -> print_string "!"; fullType ty @@ -361,8 +395,13 @@ 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; print_string " "; - ident name + | Ast.EnumName(kind,name) -> + mcode print_string kind; + print_option (function x -> ident x; print_string " ") name + | Ast.EnumDef(ty,lb,ids,rb) -> + fullType ty; mcode print_string lb; + dots force_newline expression ids; + mcode print_string rb | Ast.StructUnionName(kind,name) -> mcode structUnion kind; print_option (function x -> ident x; print_string " ") name @@ -378,11 +417,18 @@ 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 " @@ -403,7 +449,7 @@ and const_vol = 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) @@ -416,7 +462,10 @@ 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 + (function x -> mcode const_vol x; print_string " ") + cv; loop ty (function _ -> k (); @@ -431,7 +480,12 @@ and print_named_type ty id = and declaration d = match Ast.unwrap d with - Ast.Init(stg,ty,id,eq,ini,sem) -> + Ast.MetaDecl(name,_,_) | Ast.MetaField(name,_,_) + | Ast.MetaFieldList(name,_,_,_) -> + mcode print_meta name + | Ast.AsDecl(decl,asdecl) -> declaration decl; print_string "@"; + declaration asdecl + | Ast.Init(stg,ty,id,eq,ini,sem) -> print_option (mcode storage) stg; print_named_type ty id; print_string " "; mcode print_string eq; print_string " "; initialiser ini; mcode print_string sem @@ -442,6 +496,12 @@ and declaration d = ident name; mcode print_string_box lp; dots (function _ -> ()) 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 _ -> ()) expression args; + close_box(); mcode print_string rp; + print_string " "; mcode print_string eq; + print_string " "; initialiser 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; print_string " "; fullType ty; typeC id; @@ -450,7 +510,6 @@ and declaration d = | Ast.Ddots(dots,Some whencode) -> mcode print_string dots; print_string " when != "; declaration whencode | Ast.Ddots(dots,None) -> mcode print_string dots - | Ast.MetaDecl(name,_,_) -> mcode print_meta name | Ast.OptDecl(decl) -> print_string "?"; declaration decl | Ast.UniqueDecl(decl) -> print_string "!"; declaration decl @@ -461,8 +520,16 @@ and initialiser i = match Ast.unwrap i with Ast.MetaInit(name,_,_) -> mcode print_meta name; print_string " " + | Ast.MetaInitList(name,_,_,_) -> + mcode print_meta name; print_string " " + | Ast.AsInit(ini,asini) -> initialiser ini; print_string "@"; + initialiser asini | Ast.InitExpr(exp) -> expression exp - | Ast.InitList(lb,initlist,rb,whencode) -> + | Ast.ArInitList(lb,initlist,rb) -> + mcode print_string lb; open_box 0; + dots force_newline initialiser initlist; close_box(); + mcode print_string rb + | Ast.StrInitList(allminus,lb,initlist,rb,whencode) -> mcode print_string lb; open_box 0; if not (whencode = []) then @@ -478,6 +545,9 @@ and initialiser i = | Ast.InitGccName(name,eq,ini) -> ident name; mcode print_string eq; initialiser ini | Ast.IComma(comma) -> mcode print_string comma; force_newline() + | Ast.Idots(dots,Some whencode) -> + mcode print_string dots; print_string " when != "; initialiser whencode + | Ast.Idots(dots,None) -> mcode print_string dots | Ast.OptIni(ini) -> print_string "?"; initialiser ini | Ast.UniqueIni(ini) -> print_string "!"; initialiser ini @@ -513,13 +583,13 @@ and parameter_list l = dots (function _ -> ()) parameterTypeDef l let rec rule_elem arity re = match Ast.unwrap re with Ast.FunHeader(bef,allminus,fninfo,name,lp,params,rp) -> - mcode (function _ -> ()) ((),Ast.no_info,bef,Ast.NoMetaPos); + mcode (function _ -> ()) ((),Ast.no_info,bef,[]); print_string arity; List.iter print_fninfo fninfo; ident name; mcode print_string_box lp; parameter_list params; close_box(); mcode print_string rp; print_string " " | Ast.Decl(bef,allminus,decl) -> - mcode (function _ -> ()) ((),Ast.no_info,bef,Ast.NoMetaPos); + mcode (function _ -> ()) ((),Ast.no_info,bef,[]); print_string arity; declaration decl | Ast.SeqStart(brace) -> @@ -529,7 +599,7 @@ let rec rule_elem arity re = if !print_newlines_disj then end_block(); print_string arity; mcode print_string brace | Ast.ExprStatement(exp,sem) -> - print_string arity; expression exp; mcode print_string sem + print_string arity; print_option expression exp; mcode print_string sem | Ast.IfHeader(iff,lp,exp,rp) -> print_string arity; mcode print_string iff; print_string " "; mcode print_string_box lp; @@ -587,6 +657,8 @@ let rec rule_elem arity re = | Ast.TopInit(init) -> initialiser init | Ast.Include(inc,s) -> mcode print_string inc; print_string " "; mcode inc_file s + | Ast.Undef(def,id) -> + mcode print_string def; print_string " "; ident id | Ast.DefineHeader(def,id,params) -> mcode print_string def; print_string " "; ident id; print_define_parameters params @@ -629,25 +701,26 @@ and statement arity s = rule_elem arity rbrace | Ast.IfThen(header,branch,(_,_,_,aft)) -> rule_elem arity header; statement arity branch; - mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos) + mcode (function _ -> ()) ((),Ast.no_info,aft,[]) | Ast.IfThenElse(header,branch1,els,branch2,(_,_,_,aft)) -> rule_elem arity header; statement arity branch1; print_string " "; rule_elem arity els; statement arity branch2; - mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos) + mcode (function _ -> ()) ((),Ast.no_info,aft,[]) | Ast.While(header,body,(_,_,_,aft)) -> rule_elem arity header; statement arity body; - mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos) + mcode (function _ -> ()) ((),Ast.no_info,aft,[]) | Ast.Do(header,body,tail) -> rule_elem arity header; statement arity body; rule_elem arity tail | Ast.For(header,body,(_,_,_,aft)) -> rule_elem arity header; statement arity body; - mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos) + mcode (function _ -> ()) ((),Ast.no_info,aft,[]) | Ast.Iterator(header,body,(_,_,_,aft)) -> rule_elem arity header; statement arity body; - mcode (function _ -> ()) ((),Ast.no_info,aft,Ast.NoMetaPos) - | Ast.Switch(header,lb,cases,rb) -> + mcode (function _ -> ()) ((),Ast.no_info,aft,[]) + | Ast.Switch(header,lb,decls,cases,rb) -> rule_elem arity header; rule_elem arity lb; + dots force_newline (statement arity) decls; List.iter (function x -> case_line arity x; force_newline()) cases; rule_elem arity rb | Ast.Atomic(re) -> rule_elem arity re @@ -670,9 +743,11 @@ and statement arity s = | Ast.Define(header,body) -> rule_elem arity header; print_string " "; dots force_newline (statement arity) body - | Ast.Nest(stmt_dots,whn,multi,_,_) -> + | Ast.AsStmt(stm,asstm) -> + statement arity stm; print_string "@"; statement arity asstm + | Ast.Nest(starter,stmt_dots,ender,whn,multi,_,_) -> print_string arity; - nest_dots multi (statement arity) + nest_dots starter ender (statement arity) (function _ -> open_box 0; print_between force_newline @@ -745,7 +820,7 @@ let top_level t = Ast.FILEINFO(old_file,new_file) -> print_string "--- "; mcode print_string old_file; force_newline(); print_string "+++ "; mcode print_string new_file - | Ast.DECL(stmt) -> statement "" stmt + | Ast.NONDECL(stmt) -> statement "" stmt | Ast.CODE(stmt_dots) -> dots force_newline (statement "") stmt_dots | Ast.ERRORWORDS(exps) -> @@ -783,7 +858,10 @@ let _ = | Ast.ConstVolTag(x) -> const_vol x | Ast.Token(x,Some info) -> print_string_befaft print_string x info | Ast.Token(x,None) -> print_string x - | Ast.Pragma(xs) -> print_between force_newline print_string xs + | Ast.Pragma(xs) -> + let print = function + Ast.Noindent s | Ast.Indent s | Ast.Space s -> print_string s in + print_between force_newline print xs | Ast.Code(x) -> let _ = top_level x in () | Ast.ExprDotsTag(x) -> dots (function _ -> ()) expression x | Ast.ParamDotsTag(x) -> parameter_list x @@ -809,40 +887,30 @@ let rec dep in_and = function if not in_and then print_or () else (print_string "("; print_or(); print_string ")") - | Ast.NoDep -> failwith "not possible" + | Ast.NoDep -> print_string "no_dep" + | Ast.FailDep -> print_string "fail_dep" + +let script_header str lang deps code = + print_string "@@"; + force_newline(); + print_string (str ^ ":" ^ lang); + (match deps with + Ast.NoDep -> () + | _ -> print_string " depends on "; dep true deps); + force_newline(); + print_string "@@"; + force_newline(); + print_string code; + force_newline() let unparse z = match z with - Ast.InitialScriptRule (lang,code) -> - print_string "@@"; - force_newline(); - print_string ("initialize:" ^ lang); - force_newline(); - print_string "@@"; - force_newline(); - print_string code; - force_newline() - | Ast.FinalScriptRule (lang,code) -> - print_string "@@"; - force_newline(); - print_string ("finalize:" ^ lang); - force_newline(); - print_string "@@"; - force_newline(); - print_string code; - force_newline() - | Ast.ScriptRule (lang,deps,bindings,code) -> - print_string "@@"; - force_newline(); - print_string ("script:" ^ lang); - (match deps with - Ast.NoDep -> () - | _ -> print_string " depends on "; dep true deps); - force_newline(); - print_string "@@"; - force_newline(); - print_string code; - force_newline() + Ast.InitialScriptRule (name,lang,deps,code) -> + script_header "initialize" lang deps code + | Ast.FinalScriptRule (name,lang,deps,code) -> + script_header "finalize" lang deps code + | Ast.ScriptRule (name,lang,deps,bindings,script_vars,code) -> + script_header "script" lang deps code | Ast.CocciRule (nm, (deps, drops, exists), x, _, _) -> print_string "@@"; force_newline();