X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/9f8e26f459677a621822918b7539ae94214621ac..1eddfd5052863e93b723b26a1d1266471882f234:/parsing_cocci/pretty_print_cocci.ml diff --git a/parsing_cocci/pretty_print_cocci.ml b/parsing_cocci/pretty_print_cocci.ml index 04eed4d..237d56f 100644 --- a/parsing_cocci/pretty_print_cocci.ml +++ b/parsing_cocci/pretty_print_cocci.ml @@ -1,4 +1,6 @@ (* + * 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. @@ -80,11 +82,10 @@ let print_around printer term = function 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 @@ -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 (* --------------------------------------------------------------------- *) @@ -166,12 +160,18 @@ let print_type keep info = function (* Contraint on Identifier and Function *) (* FIXME: Not called at the moment *) -let idconstraint c = - match c with - Ast.IdNoConstraint -> print_string "/* No constraint */" - | Ast.IdNegIdSet ids -> List.iter (fun s -> print_string (" "^s)) ids - | Ast.IdRegExp (re,_) -> print_string "~= \""; print_string re; print_string "\"" - | Ast.IdNotRegExp (re,_) -> print_string "~!= \""; print_string re; print_string "\"" +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 *) @@ -258,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) -> @@ -372,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 @@ -394,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 " @@ -442,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 @@ -461,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 @@ -473,7 +481,11 @@ and initialiser i = Ast.MetaInit(name,_,_) -> mcode print_meta name; print_string " " | 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 @@ -489,6 +501,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 @@ -682,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 @@ -795,7 +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) -> print_between force_newline print_string xs + | 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 @@ -824,38 +841,27 @@ let rec dep in_and = function | 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();