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