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