engine/transformation_c.ml

   1 (*
   2  * Copyright 2010, INRIA, University of Copenhagen
   3  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
   4  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   5  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   6  * This file is part of Coccinelle.
   7  *
   8  * Coccinelle is free software: you can redistribute it and/or modify
   9  * it under the terms of the GNU General Public License as published by
  10  * the Free Software Foundation, according to version 2 of the License.
  11  *
  12  * Coccinelle is distributed in the hope that it will be useful,
  13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  19  *
  20  * The authors reserve the right to distribute this or future versions of
  21  * Coccinelle under other licenses.
  22  *)
  23
  24
  25 open Common
  26
  27 module F = Control_flow_c
  28
  29 (*****************************************************************************)
  30 (* The functor argument  *)
  31 (*****************************************************************************)
  32
  33 (* info passed recursively in monad in addition to binding *)
  34 type xinfo = {
  35   optional_storage_iso : bool;
  36   optional_qualifier_iso : bool;
  37   value_format_iso : bool;
  38   optional_declarer_semicolon_iso : bool;
  39   current_rule_name : string; (* used for errors *)
  40   index : int list (* witness tree indices *)
  41 }
  42
  43 module XTRANS = struct
  44
  45   (* ------------------------------------------------------------------------*)
  46   (* Combinators history *)
  47   (* ------------------------------------------------------------------------*)
  48   (*
  49    * version0:
  50    *  type ('a, 'b) transformer =
  51    *    'a -> 'b -> Lib_engine.metavars_binding -> 'b
  52    *  exception NoMatch
  53    *
  54    * version1:
  55    *   type ('a, 'b) transformer =
  56    *    'a -> 'b -> Lib_engine.metavars_binding -> 'b option
  57    * use an exception monad
  58    *
  59    * version2:
  60    *    type tin = Lib_engine.metavars_binding
  61    *)
  62
  63   (* ------------------------------------------------------------------------*)
  64   (* Standard type and operators  *)
  65   (* ------------------------------------------------------------------------*)
  66
  67   type tin = {
  68     extra: xinfo;
  69     binding: Lib_engine.metavars_binding;
  70     binding0: Lib_engine.metavars_binding; (* inherited variable *)
  71   }
  72   type 'x tout = 'x option
  73
  74   type ('a, 'b) matcher = 'a -> 'b  -> tin -> ('a * 'b) tout
  75
  76   let (>>=) m f = fun tin ->
  77      match m tin with
  78      | None -> None
  79      | Some (a,b) -> f a b tin
  80
  81   let return = fun x -> fun tin ->
  82     Some x
  83
  84   (* can have fail in transform now that the process is deterministic ? *)
  85   let fail = fun tin ->
  86     None
  87
  88   let (>||>) m1 m2 = fun tin ->
  89     match m1 tin with
  90     | None -> m2 tin
  91     | Some x -> Some x (* stop as soon as have found something *)
  92
  93   let (>|+|>) m1 m2 = m1 >||> m2
  94
  95   let (>&&>) f m = fun tin ->
  96     if f tin then m tin else fail tin
  97
  98   let optional_storage_flag f = fun tin ->
  99     f (tin.extra.optional_storage_iso) tin
 100
 101   let optional_qualifier_flag f = fun tin ->
 102     f (tin.extra.optional_qualifier_iso) tin
 103
 104   let value_format_flag f = fun tin ->
 105     f (tin.extra.value_format_iso) tin
 106
 107   let optional_declarer_semicolon_flag f = fun tin ->
 108     f (tin.extra.optional_declarer_semicolon_iso) tin
 109
 110   let mode = Cocci_vs_c.TransformMode
 111
 112   (* ------------------------------------------------------------------------*)
 113   (* Env *)
 114   (* ------------------------------------------------------------------------*)
 115
 116   (* When env is used in + code, have to strip it more to avoid circular
 117   references due to local variable information *)
 118
 119   let clean_env env =
 120     List.map
 121       (function (v,vl) ->
 122         match vl with
 123         | Ast_c.MetaExprVal(e,ml) ->
 124             (v,Ast_c.MetaExprVal(Lib_parsing_c.real_al_expr e,ml))
 125         | Ast_c.MetaExprListVal(es) ->
 126             (v,Ast_c.MetaExprListVal(Lib_parsing_c.real_al_arguments es))
 127         | Ast_c.MetaTypeVal(ty) ->
 128             (v,Ast_c.MetaTypeVal(Lib_parsing_c.real_al_type ty))
 129         | Ast_c.MetaInitVal(i) ->
 130             (v,Ast_c.MetaInitVal(Lib_parsing_c.real_al_init i))
 131         | Ast_c.MetaInitListVal(is) ->
 132             (v,Ast_c.MetaInitListVal(Lib_parsing_c.real_al_inits is))
 133         | Ast_c.MetaDeclVal(d) ->
 134             (v,Ast_c.MetaDeclVal(Lib_parsing_c.real_al_decl d))
 135         | Ast_c.MetaStmtVal(s) ->
 136             (v,Ast_c.MetaStmtVal(Lib_parsing_c.real_al_statement s))
 137         | _ -> (v,vl))
 138       env
 139
 140
 141   (* ------------------------------------------------------------------------*)
 142   (* Exp  *)
 143   (* ------------------------------------------------------------------------*)
 144   let cocciExp = fun expf expa node -> fun tin ->
 145
 146     let bigf = {
 147       Visitor_c.default_visitor_c_s with
 148       Visitor_c.kexpr_s = (fun (k, bigf) expb ->
 149         match expf expa expb tin with
 150         | None -> (* failed *) k expb
 151         | Some (x, expb) -> expb);
 152     }
 153     in
 154     Some (expa, Visitor_c.vk_node_s bigf node)
 155
 156
 157   (* same as cocciExp, but for expressions in an expression, not expressions
 158      in a node *)
 159   let cocciExpExp = fun expf expa expb -> fun tin ->
 160
 161     let bigf = {
 162       Visitor_c.default_visitor_c_s with
 163       Visitor_c.kexpr_s = (fun (k, bigf) expb ->
 164         match expf expa expb tin with
 165         | None -> (* failed *) k expb
 166         | Some (x, expb) -> expb);
 167     }
 168     in
 169     Some (expa, Visitor_c.vk_expr_s bigf expb)
 170
 171
 172   let cocciTy = fun expf expa node -> fun tin ->
 173
 174     let bigf = {
 175       Visitor_c.default_visitor_c_s with
 176       Visitor_c.ktype_s = (fun (k, bigf) expb ->
 177         match expf expa expb tin with
 178         | None -> (* failed *) k expb
 179         | Some (x, expb) -> expb);
 180     }
 181     in
 182     Some (expa, Visitor_c.vk_node_s bigf node)
 183
 184   let cocciInit = fun expf expa node -> fun tin ->
 185
 186     let bigf = {
 187       Visitor_c.default_visitor_c_s with
 188       Visitor_c.kini_s = (fun (k, bigf) expb ->
 189         match expf expa expb tin with
 190         | None -> (* failed *) k expb
 191         | Some (x, expb) -> expb);
 192     }
 193     in
 194     Some (expa, Visitor_c.vk_node_s bigf node)
 195
 196
 197   (* ------------------------------------------------------------------------*)
 198   (* Tokens *)
 199   (* ------------------------------------------------------------------------*)
 200    let check_pos info mck pos =
 201      match mck with
 202      | Ast_cocci.PLUS _ -> raise Impossible
 203      | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_)
 204      | Ast_cocci.MINUS   (Ast_cocci.FixPos (i1,i2),_,_,_) ->
 205          pos <= i2 && pos >= i1
 206      | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_)
 207      | Ast_cocci.MINUS   (Ast_cocci.DontCarePos,_,_,_) ->
 208          true
 209      | _ ->
 210          match info with
 211            Some info ->
 212              failwith
 213                (Printf.sprintf
 214                   "weird: dont have position info for the mcodekind in line %d column %d"
 215                   info.Ast_cocci.line info.Ast_cocci.column)
 216          | None ->
 217              failwith "weird: dont have position info for the mcodekind"
 218
 219
 220   let tag_with_mck mck ib = fun tin ->
 221
 222     let cocciinforef = ib.Ast_c.cocci_tag in
 223     let (oldmcode, oldenvs) = Ast_c.mcode_and_env_of_cocciref cocciinforef in
 224
 225     let mck =
 226       (* coccionly:
 227       if !Flag_parsing_cocci.sgrep_mode
 228       then Sgrep.process_sgrep ib mck
 229       else
 230       *)
 231         mck
 232     in
 233     (match mck, Ast_c.pinfo_of_info ib with
 234     | _,                  Ast_c.AbstractLineTok _ -> raise Impossible
 235     | Ast_cocci.MINUS(_), Ast_c.ExpandedTok _ ->
 236         failwith
 237           (Printf.sprintf
 238              "%s: %d: try to delete an expanded token: %s"
 239              (Ast_c.file_of_info ib)
 240              (Ast_c.line_of_info ib) (Ast_c.str_of_info ib))
 241     | _ -> ()
 242     );
 243
 244     let many_context_count = function
 245         Ast_cocci.BEFORE(_,Ast_cocci.MANY) | Ast_cocci.AFTER(_,Ast_cocci.MANY)
 246       |  Ast_cocci.BEFOREAFTER(_,_,Ast_cocci.MANY) -> true
 247       | _ -> false in
 248
 249     let many_minus_count = function
 250         Ast_cocci.REPLACEMENT(_,Ast_cocci.MANY) -> true
 251       | _ -> false in
 252
 253     (match (oldmcode,mck) with
 254     | (Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING),      _) ->
 255         (* nothing there, so take the new stuff *)
 256         let update_inst inst = function
 257             Ast_cocci.MINUS (pos,_,adj,any_xxs) ->
 258               Ast_cocci.MINUS (pos,inst,adj,any_xxs)
 259           | mck -> mck in
 260         (* clean_env actually only needed if there is an addition
 261            not sure the extra efficiency would be worth duplicating the code *)
 262         cocciinforef :=
 263           Some (update_inst tin.extra.index mck, [clean_env tin.binding])
 264     | (_,   Ast_cocci.CONTEXT(_,Ast_cocci.NOTHING)) ->
 265         (* can this case occur? stay with the old stuff *)
 266         ()
 267     | (Ast_cocci.MINUS(old_pos,old_inst,old_adj,Ast_cocci.NOREPLACEMENT),
 268        Ast_cocci.MINUS(new_pos,new_inst,new_adj,Ast_cocci.NOREPLACEMENT))
 269         when old_pos = new_pos
 270             (* not sure why the following condition is useful.
 271                should be ok to double remove even if the environments are
 272                different *)
 273           (* &&
 274           (List.mem tin.binding oldenvs or !Flag.sgrep_mode2) *)
 275             (* no way to combine adjacency information, just drop one *)
 276       ->
 277         cocciinforef := Some
 278           (Ast_cocci.MINUS
 279              (old_pos,Common.union_set old_inst new_inst,old_adj,
 280               Ast_cocci.NOREPLACEMENT),
 281            [tin.binding]);
 282         (if !Flag_matcher.show_misc
 283         then pr2_once "already tagged but only removed, so safe")
 284
 285     (* ++ cases *)
 286     | (Ast_cocci.MINUS(old_pos,old_inst,old_adj,old_modif),
 287        Ast_cocci.MINUS(new_pos,new_inst,new_adj,new_modif))
 288         when old_pos = new_pos &&
 289           old_modif = new_modif && many_minus_count old_modif ->
 290
 291           cocciinforef :=
 292             Some(Ast_cocci.MINUS(old_pos,Common.union_set old_inst new_inst,
 293                                  old_adj,old_modif),
 294                  (clean_env tin.binding)::oldenvs)
 295
 296     | (Ast_cocci.CONTEXT(old_pos,old_modif),
 297        Ast_cocci.CONTEXT(new_pos,new_modif))
 298         when old_pos = new_pos &&
 299           old_modif = new_modif && many_context_count old_modif ->
 300             (* iteration only allowed on context; no way to replace something
 301                more than once; now no need for iterable; just check a flag *)
 302
 303           cocciinforef :=
 304             Some(Ast_cocci.CONTEXT(old_pos,old_modif),
 305                  (clean_env tin.binding)::oldenvs)
 306
 307     | _ ->
 308           (* coccionly:
 309           if !Flag.sgrep_mode2
 310           then ib (* safe *)
 311           else
 312           *)
 313              begin
 314             (* coccionly:
 315                pad: if dont want cocci write:
 316                 failwith
 317                 (match Ast_c.pinfo_of_info ib with
 318                   Ast_c.FakeTok _ -> "already tagged fake token"
 319              *)
 320                let pm str mcode env =
 321                  Printf.sprintf
 322                    "%s modification:\n%s\nAccording to environment %d:\n%s\n"
 323                    str
 324                    (Common.format_to_string
 325                       (function _ ->
 326                         Pretty_print_cocci.print_mcodekind mcode))
 327                    (List.length env)
 328                    (String.concat "\n"
 329                       (List.map
 330                          (function ((r,vr),vl) ->
 331                            Printf.sprintf "   %s.%s -> %s" r vr
 332                              (Common.format_to_string
 333                                 (function _ ->
 334                                   Pretty_print_engine.pp_binding_kind vl)))
 335                          env)) in
 336                flush stdout; flush stderr;
 337                Common.pr2
 338                  ("\n"^ (String.concat "\n"
 339                            (List.map (pm "previous" oldmcode) oldenvs)) ^ "\n"
 340                   ^ (pm "current" mck tin.binding));
 341                failwith
 342                  (match Ast_c.pinfo_of_info ib with
 343                    Ast_c.FakeTok _ ->
 344                      Common.sprintf "%s: already tagged fake token\n"
 345                        tin.extra.current_rule_name
 346                 | _ ->
 347                     Printf.sprintf
 348                       "%s: already tagged token:\nC code context\n%s"
 349                       tin.extra.current_rule_name
 350                       (Common.error_message (Ast_c.file_of_info ib)
 351                          (Ast_c.str_of_info ib, Ast_c.opos_of_info ib)))
 352             end);
 353     ib
 354
 355   let tokenf ia ib = fun tin ->
 356     let (_,i,mck,_) = ia in
 357     let pos = Ast_c.info_to_fixpos ib in
 358     if check_pos (Some i) mck pos
 359     then return (ia, tag_with_mck mck ib tin) tin
 360     else fail tin
 361
 362   let tokenf_mck mck ib = fun tin ->
 363     let pos = Ast_c.info_to_fixpos ib in
 364     if check_pos None mck pos
 365     then return (mck, tag_with_mck mck ib tin) tin
 366     else fail tin
 367
 368
 369   (* ------------------------------------------------------------------------*)
 370   (* Distribute mcode *)
 371   (* ------------------------------------------------------------------------*)
 372
 373   (* When in the SP we attach something to a metavariable, or delete it, as in
 374    * - S
 375    * + foo();
 376    * we have to minusize all the token that compose S in the C code, and
 377    * attach the 'foo();'  to the right token, the one at the very right.
 378    *)
 379
 380   type 'a distributer =
 381       (Ast_c.info -> Ast_c.info) *  (* what to do on left *)
 382       (Ast_c.info -> Ast_c.info) *  (* what to do on middle *)
 383       (Ast_c.info -> Ast_c.info) *  (* what to do on right *)
 384       (Ast_c.info -> Ast_c.info) -> (* what to do on both *)
 385       'a -> 'a
 386
 387   let distribute_mck mcodekind distributef expr tin =
 388     match mcodekind with
 389     | Ast_cocci.MINUS (pos,_,adj,any_xxs) ->
 390         let inst = tin.extra.index in
 391         distributef (
 392           (fun ib ->
 393             tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,any_xxs)) ib tin),
 394           (fun ib ->
 395             tag_with_mck
 396               (Ast_cocci.MINUS (pos,inst,adj,Ast_cocci.NOREPLACEMENT)) ib tin),
 397           (fun ib ->
 398             tag_with_mck
 399               (Ast_cocci.MINUS (pos,inst,adj,Ast_cocci.NOREPLACEMENT)) ib tin),
 400           (fun ib ->
 401             tag_with_mck (Ast_cocci.MINUS (pos,inst,adj,any_xxs)) ib tin)
 402         ) expr
 403     | Ast_cocci.CONTEXT (pos,any_befaft) ->
 404         (match any_befaft with
 405         | Ast_cocci.NOTHING -> expr
 406
 407         | Ast_cocci.BEFORE (xxs,c) ->
 408             distributef (
 409               (fun ib -> tag_with_mck
 410                 (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE (xxs,c))) ib tin),
 411               (fun x -> x),
 412               (fun x -> x),
 413               (fun ib -> tag_with_mck
 414                 (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE (xxs,c))) ib tin)
 415             ) expr
 416         | Ast_cocci.AFTER (xxs,c) ->
 417             distributef (
 418               (fun x -> x),
 419               (fun x -> x),
 420               (fun ib -> tag_with_mck
 421                 (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER (xxs,c))) ib tin),
 422               (fun ib -> tag_with_mck
 423                 (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER (xxs,c))) ib tin)
 424             ) expr
 425
 426         | Ast_cocci.BEFOREAFTER (xxs, yys, c) ->
 427             distributef (
 428               (fun ib -> tag_with_mck
 429                 (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFORE (xxs,c))) ib tin),
 430               (fun x -> x),
 431               (fun ib -> tag_with_mck
 432                 (Ast_cocci.CONTEXT (pos,Ast_cocci.AFTER (yys,c))) ib tin),
 433               (fun ib -> tag_with_mck
 434                 (Ast_cocci.CONTEXT (pos,Ast_cocci.BEFOREAFTER (xxs,yys,c)))
 435                 ib tin)
 436             ) expr
 437
 438         )
 439     | Ast_cocci.PLUS _ -> raise Impossible
 440
 441
 442   (* use new strategy, collect ii, sort, recollect and tag *)
 443
 444   let mk_bigf (maxpos, minpos) (lop,mop,rop,bop) =
 445     let bigf = {
 446       Visitor_c.default_visitor_c_s with
 447         Visitor_c.kinfo_s = (fun (k,bigf) i ->
 448           let pos = Ast_c.info_to_fixpos i in
 449           match () with
 450           | _ when Ast_cocci.equal_pos pos maxpos &&
 451               Ast_cocci.equal_pos pos minpos -> bop i
 452           | _ when Ast_cocci.equal_pos pos maxpos -> rop i
 453           | _ when Ast_cocci.equal_pos pos minpos -> lop i
 454           | _ -> mop i
 455         )
 456     } in
 457     bigf
 458
 459   let distribute_mck_expr (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
 460     Visitor_c.vk_expr_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x
 461
 462   let distribute_mck_args (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
 463     Visitor_c.vk_args_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x
 464
 465   let distribute_mck_type (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
 466     Visitor_c.vk_type_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x
 467
 468   let distribute_mck_decl (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
 469     Visitor_c.vk_decl_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x
 470
 471   let distribute_mck_field (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
 472     Visitor_c.vk_struct_field_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x
 473
 474   let distribute_mck_ini (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
 475     Visitor_c.vk_ini_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x
 476
 477   let distribute_mck_inis (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
 478     Visitor_c.vk_inis_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x
 479
 480   let distribute_mck_param (maxpos, minpos) = fun (lop,mop,rop,bop) -> fun x ->
 481     Visitor_c.vk_param_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop)) x
 482
 483   let distribute_mck_params (maxpos, minpos) = fun (lop,mop,rop,bop) ->fun x ->
 484     Visitor_c.vk_params_splitted_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
 485       x
 486
 487   let distribute_mck_node (maxpos, minpos) = fun (lop,mop,rop,bop) ->fun x ->
 488     Visitor_c.vk_node_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
 489       x
 490
 491   let distribute_mck_enum_fields (maxpos, minpos) =
 492     fun (lop,mop,rop,bop) ->fun x ->
 493       Visitor_c.vk_enum_fields_splitted_s
 494         (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
 495         x
 496
 497   let distribute_mck_struct_fields (maxpos, minpos) =
 498     fun (lop,mop,rop,bop) ->fun x ->
 499       Visitor_c.vk_struct_fields_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
 500         x
 501
 502   let distribute_mck_cst (maxpos, minpos) =
 503     fun (lop,mop,rop,bop) ->fun x ->
 504       Visitor_c.vk_cst_s (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
 505         x
 506
 507
 508   let distribute_mck_define_params (maxpos, minpos) = fun (lop,mop,rop,bop) ->
 509    fun x ->
 510     Visitor_c.vk_define_params_splitted_s
 511       (mk_bigf (maxpos, minpos) (lop,mop,rop,bop))
 512       x
 513
 514    let get_pos mck =
 515      match mck with
 516      | Ast_cocci.PLUS _ -> raise Impossible
 517      | Ast_cocci.CONTEXT (Ast_cocci.FixPos (i1,i2),_)
 518      | Ast_cocci.MINUS   (Ast_cocci.FixPos (i1,i2),_,_,_) ->
 519          Ast_cocci.FixPos (i1,i2)
 520      | Ast_cocci.CONTEXT (Ast_cocci.DontCarePos,_)
 521      | Ast_cocci.MINUS   (Ast_cocci.DontCarePos,_,_,_) ->
 522          Ast_cocci.DontCarePos
 523      | _ -> failwith "weird: dont have position info for the mcodekind 2"
 524
 525   let distrf (ii_of_x_f, distribute_mck_x_f) =
 526     fun ia x -> fun tin ->
 527     let mck = Ast_cocci.get_mcodekind ia in
 528     let (max, min) = Lib_parsing_c.max_min_by_pos (ii_of_x_f x)
 529     in
 530     if
 531       (* bug: check_pos mck max && check_pos mck min
 532        *
 533        * if do that then if have - f(...); and in C f(1,2); then we
 534        * would get a "already tagged" because the '...' would sucess in
 535        * transformaing both '1' and '1,2'. So being in the range is not
 536        * enough. We must be equal exactly to the range!
 537        *)
 538       (match get_pos mck with
 539       | Ast_cocci.DontCarePos -> true
 540       | Ast_cocci.FixPos (i1, i2) ->
 541           i1 =*= min && i2 =*= max
 542       | _ -> raise Impossible
 543       )
 544
 545     then
 546       return (
 547         ia,
 548         distribute_mck mck (distribute_mck_x_f (max,min))  x tin
 549       ) tin
 550     else fail tin
 551
 552
 553   let distrf_e    = distrf (Lib_parsing_c.ii_of_expr,  distribute_mck_expr)
 554   let distrf_args = distrf (Lib_parsing_c.ii_of_args,  distribute_mck_args)
 555   let distrf_type = distrf (Lib_parsing_c.ii_of_type,  distribute_mck_type)
 556   let distrf_param  = distrf (Lib_parsing_c.ii_of_param, distribute_mck_param)
 557   let distrf_params = distrf (Lib_parsing_c.ii_of_params,distribute_mck_params)
 558   let distrf_ini = distrf (Lib_parsing_c.ii_of_ini,distribute_mck_ini)
 559   let distrf_inis = distrf (Lib_parsing_c.ii_of_inis,distribute_mck_inis)
 560   let distrf_decl = distrf (Lib_parsing_c.ii_of_decl,distribute_mck_decl)
 561   let distrf_field = distrf (Lib_parsing_c.ii_of_field,distribute_mck_field)
 562   let distrf_node = distrf (Lib_parsing_c.ii_of_node,distribute_mck_node)
 563   let distrf_enum_fields =
 564     distrf (Lib_parsing_c.ii_of_enum_fields, distribute_mck_enum_fields)
 565   let distrf_struct_fields =
 566     distrf (Lib_parsing_c.ii_of_struct_fields, distribute_mck_struct_fields)
 567   let distrf_cst =
 568     distrf (Lib_parsing_c.ii_of_cst, distribute_mck_cst)
 569   let distrf_define_params =
 570     distrf (Lib_parsing_c.ii_of_define_params,distribute_mck_define_params)
 571
 572
 573   (* ------------------------------------------------------------------------*)
 574   (* Environment *)
 575   (* ------------------------------------------------------------------------*)
 576   let meta_name_to_str (s1, s2) = s1 ^ "." ^ s2
 577
 578   let envf keep inherited = fun (s, value, _) f tin ->
 579     let s = Ast_cocci.unwrap_mcode s in
 580     let v =
 581       if keep =*= Type_cocci.Saved
 582       then (
 583         try Some (List.assoc s tin.binding)
 584         with Not_found ->
 585           pr2(sprintf
 586                 "Don't find value for metavariable %s in the environment"
 587                 (meta_name_to_str s));
 588           None)
 589       else
 590         (* not raise Impossible! *)
 591         Some (value)
 592     in
 593     match v with
 594     | None -> fail tin
 595     | Some (value') ->
 596
 597         (* Ex: in cocci_vs_c someone wants to add a binding. Here in
 598          * transformation3 the value for this var may be already in the
 599          * env, because for instance its value were fixed in a previous
 600          * SmPL rule. So here we want to check that this is the same value.
 601          * If forget to do the check, what can happen ? Because of Exp
 602          * and other disjunctive feature of cocci_vs_c (>||>), we
 603          * may accept a match at a wrong position. Maybe later this
 604          * will be detected via the pos system on tokens, but maybe
 605          * not. So safer to keep the check.
 606          *)
 607
 608         (*f () tin*)
 609         let equal =
 610           if inherited
 611           then Cocci_vs_c.equal_inh_metavarval
 612           else Cocci_vs_c.equal_metavarval in
 613         if equal value value'
 614         then f () tin
 615         else fail tin
 616
 617
 618   let check_idconstraint matcher c id = fun f tin -> f () tin
 619   let check_constraints_ne matcher constraints exp = fun f tin -> f () tin
 620
 621   (* ------------------------------------------------------------------------*)
 622   (* Environment, allbounds *)
 623   (* ------------------------------------------------------------------------*)
 624   let (all_bound : Ast_cocci.meta_name list -> tin -> bool) = fun l tin ->
 625     true (* in transform we don't care ? *)
 626
 627 end
 628
 629 (*****************************************************************************)
 630 (* Entry point  *)
 631 (*****************************************************************************)
 632 module TRANS  = Cocci_vs_c.COCCI_VS_C (XTRANS)
 633
 634
 635 let transform_re_node a b tin =
 636   match TRANS.rule_elem_node a b tin with
 637   | None -> raise Impossible
 638   | Some (_sp, b') -> b'
 639
 640 let (transform2: string (* rule name *) -> string list (* dropped_isos *) ->
 641   Lib_engine.metavars_binding (* inherited bindings *) ->
 642   Lib_engine.numbered_transformation_info -> F.cflow -> F.cflow) =
 643  fun rule_name dropped_isos binding0 xs cflow ->
 644    let extra = {
 645      optional_storage_iso   = not(List.mem "optional_storage" dropped_isos);
 646      optional_qualifier_iso = not(List.mem "optional_qualifier" dropped_isos);
 647      value_format_iso = not(List.mem "value_format" dropped_isos);
 648      optional_declarer_semicolon_iso =
 649        not(List.mem "optional_declarer_semicolon"   dropped_isos);
 650      current_rule_name = rule_name;
 651      index = [];
 652    } in
 653
 654   (* find the node, transform, update the node,  and iter for all elements *)
 655
 656    xs +> List.fold_left (fun acc (index, (nodei, binding, rule_elem)) ->
 657       (* subtil: not cflow#nodes but acc#nodes *)
 658       let node  = acc#nodes#assoc nodei in
 659
 660       if !Flag.show_transinfo
 661       then pr2 (Printf.sprintf "transform one node: %d" nodei);
 662
 663       let tin = {
 664         XTRANS.extra = {extra with index = index};
 665         XTRANS.binding = binding0@binding;
 666         XTRANS.binding0 = []; (* not used - everything constant for trans *)
 667       } in
 668
 669       let node' = transform_re_node rule_elem node tin in
 670
 671       (* assert that have done something. But with metaruleElem sometimes
 672          dont modify fake nodes. So special case before on Fake nodes. *)
 673       (match F.unwrap node with
 674       | F.Enter | F.Exit | F.ErrorExit
 675       | F.EndStatement _ | F.CaseNode _
 676       | F.Fake
 677       | F.TrueNode | F.FalseNode | F.AfterNode | F.FallThroughNode
 678           -> ()
 679       | _ -> () (* assert (not (node =*= node')); *)
 680       );
 681
 682       (* useless, we dont go back from flow to ast now *)
 683       (* let node' = lastfix_comma_struct node' in *)
 684
 685       acc#replace_node (nodei, node');
 686       acc
 687    ) cflow
 688
 689
 690
 691 let transform a b c d e =
 692   Common.profile_code "Transformation3.transform"
 693     (fun () -> transform2 a b c d e)