Release coccinelle-0.2.4rc6
[bpt/coccinelle.git] / parsing_cocci / pretty_print_cocci.ml
index 04eed4d..237d56f 100644 (file)
@@ -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();