engine/transformation_c.ml

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