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