engine/pretty_print_engine.ml

   1 (*
   2  * Copyright 2012, INRIA
   3  * Julia Lawall, Gilles Muller
   4  * Copyright 2010-2011, INRIA, University of Copenhagen
   5  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
   6  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   7  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   8  * This file is part of Coccinelle.
   9  *
  10  * Coccinelle is free software: you can redistribute it and/or modify
  11  * it under the terms of the GNU General Public License as published by
  12  * the Free Software Foundation, according to version 2 of the License.
  13  *
  14  * Coccinelle is distributed in the hope that it will be useful,
  15  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  16  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17  * GNU General Public License for more details.
  18  *
  19  * You should have received a copy of the GNU General Public License
  20  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  21  *
  22  * The authors reserve the right to distribute this or future versions of
  23  * Coccinelle under other licenses.
  24  *)
  25
  26
  27 # 0 "./pretty_print_engine.ml"
  28 open Common.Infix
  29
  30 open Lib_engine
  31
  32
  33 let pp = Common.pp
  34
  35 let pp_meta (_,x) = pp x
  36
  37 let rec pp_binding_kind = function
  38   | Ast_c.MetaIdVal        (s,_) -> pp ("id " ^ s)
  39   | Ast_c.MetaFuncVal      s -> pp ("func " ^ s)
  40   | Ast_c.MetaLocalFuncVal s -> pp ("localfunc " ^ s)
  41   | Ast_c.MetaExprVal      (expr,_) -> Pretty_print_c.pp_expression_simple expr
  42   | Ast_c.MetaExprListVal  expr_list -> pp "<<exprlist>>"
  43   | Ast_c.MetaInitVal      ini ->
  44       Pretty_print_c.pp_init_simple ini
  45   | Ast_c.MetaInitListVal      ini -> pp "<<initlist>>"
  46   | Ast_c.MetaTypeVal      typ ->
  47       Pretty_print_c.pp_type_simple typ
  48   | Ast_c.MetaDeclVal      decl ->
  49       Pretty_print_c.pp_decl_simple decl
  50   | Ast_c.MetaFieldVal      decl ->
  51       Pretty_print_c.pp_field_simple decl
  52   | Ast_c.MetaFieldListVal      decls ->
  53       List.iter Pretty_print_c.pp_field_simple decls
  54   | Ast_c.MetaStmtVal      statement ->
  55       Pretty_print_c.pp_statement_simple statement
  56   | Ast_c.MetaParamVal     params -> pp "<<param>>"
  57   | Ast_c.MetaParamListVal params -> pp "<<paramlist>>"
  58   | Ast_c.MetaListlenVal n -> pp (string_of_int n)
  59   | Ast_c.MetaPosVal (pos1, pos2) ->
  60       let print_pos = function
  61           Ast_cocci.Real x -> string_of_int x
  62         | Ast_cocci.Virt(x,off) -> Printf.sprintf "%d+%d" x off in
  63       pp (Common.sprintf ("pos(%s,%s)") (print_pos pos1) (print_pos pos2))
  64   | Ast_c.MetaPosValList l ->
  65       pp (Common.sprintf ("poss[%s]")
  66             (String.concat ", "
  67                (List.map
  68                   (function (fl,ce,(minl,minc),(maxl,maxc)) ->
  69                     Printf.sprintf "(%s,%s,(%d,%d),(%d,%d))"
  70                       fl ce minl minc maxl maxc)
  71                   l)))
  72
  73 and pp_binding subst =
  74   begin
  75     pp "[";
  76     Common.print_between (fun () -> pp ";"; Format.print_cut() )
  77       (fun ((r,s), kind) ->
  78         pp r; pp "."; pp s; pp " --> "; pp_binding_kind kind)
  79       subst;
  80     pp "]";
  81   end
  82
  83
  84 let pp_binding_kind2 = function
  85   | ParenVal s -> pp "pv("; pp_meta s; pp ")"
  86   | NormalMetaVal x -> pp_binding_kind x
  87   | LabelVal (Absolute xs) ->
  88       begin
  89         pp "labelval";
  90         pp "(";
  91         Common.print_between (fun () -> pp ",") Format.print_int xs;
  92         pp ")";
  93       end
  94   | LabelVal (Prefix xs) ->
  95       begin
  96         pp "prefixlabelval";
  97         pp "(";
  98         Common.print_between (fun () -> pp ",") Format.print_int xs;
  99         pp ")";
 100       end
 101   | GoodVal -> pp "goodval"
 102   | BadVal ->  pp "badval"
 103
 104
 105 let rec pp_predicate = function
 106   | InLoop -> pp "InLoop"
 107   | TrueBranch -> pp "TrueBranch"
 108   | FalseBranch -> pp "FalseBranch"
 109   | After -> pp "After"
 110   | FallThrough -> pp "FallThrough"
 111   | LoopFallThrough -> pp "LoopFallThrough"
 112   | Return -> pp "Return"
 113   | UnsafeBrace -> pp "UnsafeBrace"
 114   | FunHeader -> pp "FunHeader"
 115   | Top -> pp "Top"
 116   | ErrorExit -> pp "ErrorExit"
 117   | Exit -> pp "Exit"
 118   | Goto -> pp "Goto"
 119   | Paren s -> pp "Paren("; pp_meta s; pp ")"
 120   | Match (re) -> Pretty_print_cocci.print_rule_elem re
 121   | Label s -> pp "Label("; pp_meta s; pp ")"
 122   | BCLabel s -> pp "BreakContinueLabel("; pp_meta s; pp ")"
 123   | PrefixLabel s -> pp "PrefixLabel("; pp_meta s; pp ")"
 124   | BindGood s -> pp "BindGood("; pp_meta s; pp ")"
 125   | BindBad s ->  pp "BindBad(";  pp_meta s; pp ")"
 126   | FakeBrace -> pp "FakeBrace"
 127
 128 and pp_binding2 subst =
 129   begin
 130     pp "[";
 131     Common.print_between (fun () -> pp ";";Format.print_cut(); )
 132       (fun (s, kind) -> pp s; pp " --> "; pp_binding_kind2 kind)
 133       subst;
 134     pp "]";
 135   end
 136
 137 and pp_binding2_ctlsubst subst =
 138   begin
 139     pp "[";
 140     Common.print_between (fun () -> pp ";"; Format.print_cut(); )
 141       (function
 142           Ast_ctl.Subst (s, kind) ->
 143             pp_meta s; pp " --> ";  pp_binding_kind2 kind;
 144        | Ast_ctl.NegSubst (s, kind) ->
 145            pp_meta s; pp " -/-> "; pp_binding_kind2 kind;
 146       )
 147       subst;
 148     pp "]";
 149   end
 150
 151 let predicate_to_string pred =
 152   Common.format_to_string (function _ -> pp_predicate pred)
 153
 154
 155 let pp_pred_smodif = fun (pred, smodif) ->
 156   begin
 157     pp_predicate pred;
 158 (*
 159   (match smodif with
 160   |  Ast_ctl.Modif x | Ast_ctl.UnModif x -> pp " with <modifTODO>"
 161   | Ast_ctl.Control -> ()
 162   )
 163 *)
 164   end
 165
 166
 167 let pp_ctlcocci show_plus inline_let_def ctl =
 168   begin
 169     if show_plus
 170     then begin
 171       Pretty_print_cocci.print_plus_flag := true;
 172       Pretty_print_cocci.print_minus_flag := true;
 173     end
 174     else begin
 175       Pretty_print_cocci.print_plus_flag := false;
 176       Pretty_print_cocci.print_minus_flag := false;
 177     end;
 178     Common.pp_do_in_box (fun () ->
 179       Pretty_print_ctl.pp_ctl (pp_pred_smodif,(fun s -> pp_meta s))
 180         inline_let_def ctl;
 181       );
 182   end
 183
 184