Release of coccinelle 1.0.0-rc9
[bpt/coccinelle.git] / parsing_cocci / pretty_print_cocci.ml
index 947646c..7d0ab01 100644 (file)
@@ -1,27 +1,7 @@
 (*
- * Copyright 2005-2010, 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 <http://www.gnu.org/licenses/>.
- *
- * The authors reserve the right to distribute this or future versions of
- * Coccinelle under other licenses.
- *)
-
-
-(*
- * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
+ * 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.
  *
@@ -102,18 +82,21 @@ let print_around printer term = function
       print_anything "<<< " bef; printer term; print_anything ">>> " aft
 
 let print_string_befaft fn x info =
-  let print = function Ast.Noindent s | Ast.Indent s -> print_string s in
+  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 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) ->
@@ -121,7 +104,10 @@ 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
@@ -135,7 +121,9 @@ let mcode fn = function
 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"
@@ -160,6 +148,23 @@ let nest_dots starter ender fn f d =
   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 ")"
+
 (* --------------------------------------------------------------------- *)
 
 let print_type keep info = function
@@ -198,12 +203,13 @@ and regconstraint = function
 
 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.DisjId(id_list) -> print_disj_list ident id_list
+  | Ast.OptIdent(id) -> print_string "?"; ident id
+  | Ast.UniqueIdent(id) -> print_string "!"; ident id
 
 and print_unitary = function
     Type_cocci.Unitary -> print_string "unitary"
@@ -213,20 +219,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
@@ -271,6 +263,9 @@ 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) ->
@@ -296,6 +291,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 "-"
@@ -392,8 +388,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
@@ -409,11 +410,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 "
@@ -462,7 +470,10 @@ 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.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
@@ -481,7 +492,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
 
@@ -492,8 +502,14 @@ 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.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
@@ -509,6 +525,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
 
@@ -544,13 +563,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) ->
@@ -560,7 +579,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;
@@ -618,6 +637,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
@@ -660,23 +681,23 @@ 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)
+      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;
@@ -777,7 +798,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) ->
@@ -816,7 +837,8 @@ let _ =
     | 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
+       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
@@ -861,11 +883,11 @@ let script_header str lang deps code =
 
 let unparse z =
   match z with
-    Ast.InitialScriptRule (lang,deps,code) ->
+    Ast.InitialScriptRule (name,lang,deps,code) ->
       script_header "initialize" lang deps code
-  | Ast.FinalScriptRule (lang,deps,code) ->
+  | Ast.FinalScriptRule (name,lang,deps,code) ->
       script_header "finalize" lang deps code
-  | Ast.ScriptRule (lang,deps,bindings,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 "@@";