X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/faf9a90c4f9e1e85931cb6b01de660587416eb97..1eddfd5052863e93b723b26a1d1266471882f234:/parsing_cocci/pretty_print_cocci.ml diff --git a/parsing_cocci/pretty_print_cocci.ml b/parsing_cocci/pretty_print_cocci.ml index 0928872..237d56f 100644 --- a/parsing_cocci/pretty_print_cocci.ml +++ b/parsing_cocci/pretty_print_cocci.ml @@ -1,23 +1,25 @@ (* -* 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 2010, 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,17 +76,16 @@ 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 -> 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 @@ -95,7 +96,7 @@ let print_pos = function | _ -> () let mcode fn = function - (x, _, Ast.MINUS(_,plus_stream), pos) -> + (x, _, Ast.MINUS(_,_,adj,plus_stream), pos) -> if !print_minus_flag then print_string (if !Flag.sgrep_mode2 then "*" else "-"); fn x; print_pos pos; @@ -107,17 +108,17 @@ let mcode fn = function 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) -> + Ast.MINUS(_,_,_,plus_stream) -> print_string "MINUS"; 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 +130,15 @@ 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 (* --------------------------------------------------------------------- *) @@ -162,17 +156,34 @@ 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 *) let rec ident i = match Ast.unwrap i with - Ast.Id(name) -> mcode print_string name - | Ast.MetaId(name,_,keep,inherited) -> mcode print_meta name - | Ast.MetaFunc(name,_,_,_) -> mcode print_meta name - | Ast.MetaLocalFunc(name,_,_,_) -> mcode print_meta name - | Ast.OptIdent(id) -> print_string "?"; ident id - | Ast.UniqueIdent(id) -> print_string "!"; ident id + Ast.Id(name) -> mcode print_string name + | Ast.MetaId(name,_,keep,inherited) -> mcode print_meta name + | Ast.MetaFunc(name,_,_,_) -> mcode print_meta name + | Ast.MetaLocalFunc(name,_,_,_) -> mcode print_meta name + | Ast.OptIdent(id) -> print_string "?"; ident id + | Ast.UniqueIdent(id) -> print_string "!"; ident id and print_unitary = function Type_cocci.Unitary -> print_string "unitary" @@ -247,12 +258,12 @@ let rec expression e = | Ast.MetaExprList(name,_,_,_) -> mcode print_meta name | 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) -> @@ -361,8 +372,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 @@ -383,6 +399,9 @@ and baseType = function | Ast.FloatType -> print_string "float " | Ast.LongType -> print_string "long " | Ast.LongLongType -> print_string "long long " + | 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 " @@ -431,7 +450,8 @@ 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,_,_) -> mcode print_meta name + | 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 @@ -450,7 +470,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 @@ -459,8 +478,14 @@ and declaration d = and initialiser i = match Ast.unwrap i with - Ast.InitExpr(exp) -> expression exp - | Ast.InitList(lb,initlist,rb,whencode) -> + Ast.MetaInit(name,_,_) -> + mcode print_meta name; print_string " " + | Ast.InitExpr(exp) -> expression exp + | 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 @@ -470,24 +495,26 @@ and initialiser i = force_newline()); List.iter initialiser initlist; close_box(); mcode print_string rb - | Ast.InitGccDotName(dot,name,eq,ini) -> - mcode print_string dot; ident name; print_string " "; + | Ast.InitGccExt(designators,eq,ini) -> + List.iter designator designators; print_string " "; mcode print_string eq; print_string " "; initialiser ini | Ast.InitGccName(name,eq,ini) -> ident name; mcode print_string eq; initialiser ini - | Ast.InitGccIndex(lb,exp,rb,eq,ini) -> - mcode print_string lb; expression exp; mcode print_string rb; - print_string " "; mcode print_string eq; print_string " "; - initialiser ini - | Ast.InitGccRange(lb,exp1,dots,exp2,rb,eq,ini) -> - mcode print_string lb; expression exp1; mcode print_string dots; - expression exp2; mcode print_string rb; - print_string " "; mcode print_string eq; print_string " "; - 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 +and designator = function + Ast.DesignatorField(dot,id) -> mcode print_string dot; ident id + | Ast.DesignatorIndex(lb,exp,rb) -> + mcode print_string lb; expression exp; mcode print_string rb + | Ast.DesignatorRange(lb,min,dots,max,rb) -> + mcode print_string lb; expression min; mcode print_string dots; + expression max; mcode print_string rb + (* --------------------------------------------------------------------- *) (* Parameter *) @@ -622,9 +649,8 @@ and print_define_param param = and statement arity s = match Ast.unwrap s with - Ast.Seq(lbrace,decls,body,rbrace) -> + Ast.Seq(lbrace,body,rbrace) -> rule_elem arity lbrace; - dots force_newline (statement arity) decls; dots force_newline (statement arity) body; rule_elem arity rbrace | Ast.IfThen(header,branch,(_,_,_,aft)) -> @@ -646,14 +672,14 @@ and statement arity s = | 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) -> + | 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 - | Ast.FunDecl(header,lbrace,decls,body,rbrace) -> + | Ast.FunDecl(header,lbrace,body,rbrace) -> rule_elem arity header; rule_elem arity lbrace; - dots force_newline (statement arity) decls; dots force_newline (statement arity) body; rule_elem arity rbrace | Ast.Disj([stmt_dots]) -> @@ -671,9 +697,9 @@ 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.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 @@ -784,6 +810,9 @@ 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) -> + let print = function Ast.Noindent s | Ast.Indent 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 +838,48 @@ 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.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(); - print_string nm; - (match deps with - Ast.NoDep -> () - | _ -> print_string " depends on "; dep true deps); + print_string "@@"; + force_newline(); + print_string nm; + (match deps with + Ast.NoDep -> () + | _ -> print_string " depends on "; dep true deps); (* print_string "line "; print_int (Ast.get_line (List.hd x)); *) - force_newline(); - print_string "@@"; - print_newlines_disj := true; - force_newline(); - force_newline(); - rule x; - force_newline() + force_newline(); + print_string "@@"; + print_newlines_disj := true; + force_newline(); + force_newline(); + rule x; + force_newline() let rule_elem_to_string x = print_newlines_disj := true;