parsing_cocci/.#insert_plus.ml.1.69

   1 (*
   2 * Copyright 2005-2008, Ecole des Mines de Nantes, University of Copenhagen
   3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
   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 (* The error message "no available token to attach to" often comes in an
  24 argument list of unbounded length.  In this case, one should move a comma so
  25 that there is a comma after the + code. *)
  26
  27 (* Start at all of the corresponding BindContext nodes in the minus and
  28 plus trees, and traverse their children.  We take the same strategy as
  29 before: collect the list of minus/context nodes/tokens and the list of plus
  30 tokens, and then merge them. *)
  31
  32 module Ast = Ast_cocci
  33 module Ast0 = Ast0_cocci
  34 module V0 = Visitor_ast0
  35 module CN = Context_neg
  36
  37 let get_option f = function
  38     None -> []
  39   | Some x -> f x
  40
  41 (* --------------------------------------------------------------------- *)
  42 (* Collect root and all context nodes in a tree *)
  43
  44 let collect_context e =
  45   let bind x y = x @ y in
  46   let option_default = [] in
  47
  48   let mcode _ = [] in
  49
  50   let donothing builder r k e =
  51     match Ast0.get_mcodekind e with
  52       Ast0.CONTEXT(_) -> (builder e) :: (k e)
  53     | _ -> k e in
  54
  55 (* special case for everything that contains whencode, so that we skip over
  56 it *)
  57   let expression r k e =
  58     donothing Ast0.expr r k
  59       (Ast0.rewrap e
  60          (match Ast0.unwrap e with
  61            Ast0.NestExpr(starter,exp,ender,whencode,multi) ->
  62              Ast0.NestExpr(starter,exp,ender,None,multi)
  63          | Ast0.Edots(dots,whencode) -> Ast0.Edots(dots,None)
  64          | Ast0.Ecircles(dots,whencode) -> Ast0.Ecircles(dots,None)
  65          | Ast0.Estars(dots,whencode) -> Ast0.Estars(dots,None)
  66          | e -> e)) in
  67
  68   let initialiser r k i =
  69     donothing Ast0.ini r k
  70       (Ast0.rewrap i
  71          (match Ast0.unwrap i with
  72            Ast0.Idots(dots,whencode) -> Ast0.Idots(dots,None)
  73          | i -> i)) in
  74
  75   let statement r k s =
  76     donothing Ast0.stmt r k
  77       (Ast0.rewrap s
  78          (match Ast0.unwrap s with
  79            Ast0.Nest(started,stm_dots,ender,whencode,multi) ->
  80              Ast0.Nest(started,stm_dots,ender,[],multi)
  81          | Ast0.Dots(dots,whencode) -> Ast0.Dots(dots,[])
  82          | Ast0.Circles(dots,whencode) -> Ast0.Circles(dots,[])
  83          | Ast0.Stars(dots,whencode) -> Ast0.Stars(dots,[])
  84          | s -> s)) in
  85
  86   let topfn r k e = Ast0.TopTag(e) :: (k e) in
  87
  88   let res =
  89     V0.combiner bind option_default
  90       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
  91       mcode
  92       (donothing Ast0.dotsExpr) (donothing Ast0.dotsInit)
  93       (donothing Ast0.dotsParam) (donothing Ast0.dotsStmt)
  94       (donothing Ast0.dotsDecl) (donothing Ast0.dotsCase)
  95       (donothing Ast0.ident) expression (donothing Ast0.typeC) initialiser
  96       (donothing Ast0.param) (donothing Ast0.decl) statement
  97       (donothing Ast0.case_line) topfn in
  98   res.V0.combiner_top_level e
  99
 100 (* --------------------------------------------------------------------- *)
 101 (* --------------------------------------------------------------------- *)
 102 (* collect the possible join points, in order, among the children of a
 103 BindContext.  Dots are not allowed.  Nests and disjunctions are no problem,
 104 because their delimiters take up a line by themselves *)
 105
 106 (* An Unfavored token is one that is in a BindContext node; using this causes
 107   the node to become Neither, meaning that isomorphisms can't be applied *)
 108 (* Toplevel is for the bef token of a function declaration and is for
 109 attaching top-level definitions that should come before the complete
 110 declaration *)
 111 type minus_join_point = Favored | Unfavored | Toplevel | Decl
 112
 113 (* Maps the index of a node to the indices of the mcodes it contains *)
 114 let root_token_table = (Hashtbl.create(50) : (int, int list) Hashtbl.t)
 115
 116 let create_root_token_table minus =
 117   Hashtbl.iter
 118     (function tokens ->
 119       function (node,_) ->
 120         let key =
 121           match node with
 122             Ast0.DotsExprTag(d) -> Ast0.get_index d
 123           | Ast0.DotsInitTag(d) -> Ast0.get_index d
 124           | Ast0.DotsParamTag(d) -> Ast0.get_index d
 125           | Ast0.DotsStmtTag(d) -> Ast0.get_index d
 126           | Ast0.DotsDeclTag(d) -> Ast0.get_index d
 127           | Ast0.DotsCaseTag(d) -> Ast0.get_index d
 128           | Ast0.IdentTag(d) -> Ast0.get_index d
 129           | Ast0.ExprTag(d) -> Ast0.get_index d
 130           | Ast0.ArgExprTag(d) | Ast0.TestExprTag(d) ->
 131               failwith "not possible - iso only"
 132           | Ast0.TypeCTag(d) -> Ast0.get_index d
 133           | Ast0.ParamTag(d) -> Ast0.get_index d
 134           | Ast0.InitTag(d) -> Ast0.get_index d
 135           | Ast0.DeclTag(d) -> Ast0.get_index d
 136           | Ast0.StmtTag(d) -> Ast0.get_index d
 137           | Ast0.CaseLineTag(d) -> Ast0.get_index d
 138           | Ast0.TopTag(d) -> Ast0.get_index d
 139           | Ast0.IsoWhenTag(_) -> failwith "only within iso phase"
 140           | Ast0.IsoWhenTTag(_) -> failwith "only within iso phase"
 141           | Ast0.IsoWhenFTag(_) -> failwith "only within iso phase"
 142           | Ast0.MetaPosTag(p) -> failwith "metapostag only within iso phase"
 143         in
 144         Hashtbl.add root_token_table key tokens)
 145     CN.minus_table;
 146   List.iter
 147     (function r ->
 148       let index = Ast0.get_index r in
 149       try let _ = Hashtbl.find root_token_table index in ()
 150       with Not_found -> Hashtbl.add root_token_table index [])
 151     minus
 152
 153 let collect_minus_join_points root =
 154   let root_index = Ast0.get_index root in
 155   let unfavored_tokens = Hashtbl.find root_token_table root_index in
 156   let bind x y = x @ y in
 157   let option_default = [] in
 158
 159   let mcode (_,_,info,mcodekind,_) =
 160     if List.mem (info.Ast0.offset) unfavored_tokens
 161     then [(Unfavored,info,mcodekind)]
 162     else [(Favored,info,mcodekind)] in
 163
 164   let do_nothing r k e =
 165     let info = Ast0.get_info e in
 166     let index = Ast0.get_index e in
 167     match Ast0.get_mcodekind e with
 168       (Ast0.MINUS(_)) as mc -> [(Favored,info,mc)]
 169     | (Ast0.CONTEXT(_)) as mc when not(index = root_index) ->
 170         (* This was unfavored at one point, but I don't remember why *)
 171       [(Favored,info,mc)]
 172     | _ -> k e in
 173
 174 (* don't want to attach to the outside of DOTS, because metavariables can't
 175 bind to that; not good for isomorphisms *)
 176
 177   let dots f k d =
 178     let multibind l =
 179       let rec loop = function
 180           [] -> option_default
 181         | [x] -> x
 182         | x::xs -> bind x (loop xs) in
 183       loop l in
 184
 185     match Ast0.unwrap d with
 186       Ast0.DOTS(l) -> multibind (List.map f l)
 187     | Ast0.CIRCLES(l) -> multibind (List.map f l)
 188     | Ast0.STARS(l) -> multibind (List.map f l) in
 189
 190   let edots r k d = dots r.V0.combiner_expression k d in
 191   let idots r k d = dots r.V0.combiner_initialiser k d in
 192   let pdots r k d = dots r.V0.combiner_parameter k d in
 193   let sdots r k d = dots r.V0.combiner_statement k d in
 194   let ddots r k d = dots r.V0.combiner_declaration k d in
 195   let cdots r k d = dots r.V0.combiner_case_line k d in
 196
 197   (* a case for everything that has a Opt *)
 198
 199   let statement r k s =
 200     (*
 201     let redo_branched res (ifinfo,aftmc) =
 202       let redo fv info mc rest =
 203         let new_info = {info with Ast0.attachable_end = false} in
 204         List.rev ((Favored,ifinfo,aftmc)::(fv,new_info,mc)::rest) in
 205       match List.rev res with
 206         [(fv,info,mc)] ->
 207           (match mc with
 208             Ast0.MINUS(_) | Ast0.CONTEXT(_) ->
 209                 (* even for -, better for isos not to integrate code after an
 210                    if into the if body.
 211                    but the problem is that this can extend the region in
 212                    which a variable is bound, because a variable bound in the
 213                    aft node would seem to have to be live in the whole if,
 214                    whereas we might like it to be live in only one branch.
 215                    ie ideally, if we can keep the minus code in the right
 216                    order, we would like to drop it as close to the bindings
 217                    of its free variables.  This could be anywhere in the minus
 218                    code.  Perhaps we would like to do this after the
 219                    application of isomorphisms, though.
 220                 *)
 221               redo fv info mc []
 222           | _ -> res)
 223       | (fv,info,mc)::rest ->
 224           (match mc with
 225             Ast0.CONTEXT(_) -> redo fv info mc rest
 226           | _ -> res)
 227       | _ -> failwith "unexpected empty code" in *)
 228     match Ast0.unwrap s with
 229  (*     Ast0.IfThen(_,_,_,_,_,aft)
 230     | Ast0.IfThenElse(_,_,_,_,_,_,_,aft)
 231     | Ast0.While(_,_,_,_,_,aft)
 232     | Ast0.For(_,_,_,_,_,_,_,_,_,aft)
 233     | Ast0.Iterator(_,_,_,_,_,aft) ->
 234         redo_branched (do_nothing r k s) aft*)
 235     | Ast0.FunDecl((info,bef),fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
 236         (Toplevel,info,bef)::(k s)
 237     | Ast0.Decl((info,bef),decl) -> (Decl,info,bef)::(k s)
 238     | Ast0.Nest(starter,stmt_dots,ender,whencode,multi) ->
 239         mcode starter @ r.V0.combiner_statement_dots stmt_dots @ mcode ender
 240     | Ast0.Dots(d,whencode) | Ast0.Circles(d,whencode)
 241     | Ast0.Stars(d,whencode) -> mcode d (* ignore whencode *)
 242     | Ast0.OptStm s | Ast0.UniqueStm s ->
 243         (* put the + code on the thing, not on the opt *)
 244         r.V0.combiner_statement s
 245     | _ -> do_nothing r k s in
 246
 247   let expression r k e =
 248     match Ast0.unwrap e with
 249       Ast0.NestExpr(starter,expr_dots,ender,whencode,multi) ->
 250         mcode starter @
 251         r.V0.combiner_expression_dots expr_dots @ mcode ender
 252     | Ast0.Edots(d,whencode) | Ast0.Ecircles(d,whencode)
 253     | Ast0.Estars(d,whencode) -> mcode d (* ignore whencode *)
 254     | Ast0.OptExp e | Ast0.UniqueExp e ->
 255         (* put the + code on the thing, not on the opt *)
 256         r.V0.combiner_expression e
 257     | _ -> do_nothing r k e in
 258
 259   let ident r k e =
 260     match Ast0.unwrap e with
 261       Ast0.OptIdent i | Ast0.UniqueIdent i ->
 262         (* put the + code on the thing, not on the opt *)
 263         r.V0.combiner_ident i
 264     | _ -> do_nothing r k e in
 265
 266   let typeC r k e =
 267     match Ast0.unwrap e with
 268       Ast0.OptType t | Ast0.UniqueType t ->
 269         (* put the + code on the thing, not on the opt *)
 270         r.V0.combiner_typeC t
 271     | _ -> do_nothing r k e in
 272
 273   let decl r k e =
 274     match Ast0.unwrap e with
 275       Ast0.OptDecl d | Ast0.UniqueDecl d ->
 276         (* put the + code on the thing, not on the opt *)
 277         r.V0.combiner_declaration d
 278     | _ -> do_nothing r k e in
 279
 280   let initialiser r k e =
 281     match Ast0.unwrap e with
 282       Ast0.Idots(d,whencode) -> mcode d (* ignore whencode *)
 283     | Ast0.OptIni i | Ast0.UniqueIni i ->
 284         (* put the + code on the thing, not on the opt *)
 285         r.V0.combiner_initialiser i
 286     | _ -> do_nothing r k e in
 287
 288   let param r k e =
 289     match Ast0.unwrap e with
 290       Ast0.OptParam p | Ast0.UniqueParam p ->
 291         (* put the + code on the thing, not on the opt *)
 292         r.V0.combiner_parameter p
 293     | _ -> do_nothing r k e in
 294
 295   let case_line r k e =
 296     match Ast0.unwrap e with
 297       Ast0.OptCase c ->
 298         (* put the + code on the thing, not on the opt *)
 299         r.V0.combiner_case_line c
 300     | _ -> do_nothing r k e in
 301
 302   let do_top r k (e: Ast0.top_level) = k e in
 303
 304   V0.combiner bind option_default
 305     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 306     mcode
 307     edots idots pdots sdots ddots cdots
 308     ident expression typeC initialiser param decl statement case_line do_top
 309
 310
 311 let call_collect_minus context_nodes :
 312     (int * (minus_join_point * Ast0.info * Ast0.mcodekind) list) list =
 313   List.map
 314     (function e ->
 315       match e with
 316         Ast0.DotsExprTag(e) ->
 317           (Ast0.get_index e,
 318            (collect_minus_join_points e).V0.combiner_expression_dots e)
 319       | Ast0.DotsInitTag(e) ->
 320           (Ast0.get_index e,
 321            (collect_minus_join_points e).V0.combiner_initialiser_list e)
 322       | Ast0.DotsParamTag(e) ->
 323           (Ast0.get_index e,
 324            (collect_minus_join_points e).V0.combiner_parameter_list e)
 325       | Ast0.DotsStmtTag(e) ->
 326           (Ast0.get_index e,
 327            (collect_minus_join_points e).V0.combiner_statement_dots e)
 328       | Ast0.DotsDeclTag(e) ->
 329           (Ast0.get_index e,
 330            (collect_minus_join_points e).V0.combiner_declaration_dots e)
 331       | Ast0.DotsCaseTag(e) ->
 332           (Ast0.get_index e,
 333            (collect_minus_join_points e).V0.combiner_case_line_dots e)
 334       | Ast0.IdentTag(e) ->
 335           (Ast0.get_index e,
 336            (collect_minus_join_points e).V0.combiner_ident e)
 337       | Ast0.ExprTag(e) ->
 338           (Ast0.get_index e,
 339            (collect_minus_join_points e).V0.combiner_expression e)
 340       | Ast0.ArgExprTag(e) | Ast0.TestExprTag(e) ->
 341           failwith "not possible - iso only"
 342       | Ast0.TypeCTag(e) ->
 343           (Ast0.get_index e,
 344            (collect_minus_join_points e).V0.combiner_typeC e)
 345       | Ast0.ParamTag(e) ->
 346           (Ast0.get_index e,
 347            (collect_minus_join_points e).V0.combiner_parameter e)
 348       | Ast0.InitTag(e) ->
 349           (Ast0.get_index e,
 350            (collect_minus_join_points e).V0.combiner_initialiser e)
 351       | Ast0.DeclTag(e) ->
 352           (Ast0.get_index e,
 353            (collect_minus_join_points e).V0.combiner_declaration e)
 354       | Ast0.StmtTag(e) ->
 355           (Ast0.get_index e,
 356            (collect_minus_join_points e).V0.combiner_statement e)
 357       | Ast0.CaseLineTag(e) ->
 358           (Ast0.get_index e,
 359            (collect_minus_join_points e).V0.combiner_case_line e)
 360       | Ast0.TopTag(e) ->
 361           (Ast0.get_index e,
 362            (collect_minus_join_points e).V0.combiner_top_level e)
 363       | Ast0.IsoWhenTag(_) -> failwith "only within iso phase"
 364       | Ast0.IsoWhenTTag(_) -> failwith "only within iso phase"
 365       | Ast0.IsoWhenFTag(_) -> failwith "only within iso phase"
 366       | Ast0.MetaPosTag(p) -> failwith "metapostag only within iso phase")
 367     context_nodes
 368
 369 (* result of collecting the join points should be sorted in nondecreasing
 370    order by line *)
 371 let verify l =
 372   let get_info = function
 373       (Favored,info,_) | (Unfavored,info,_) | (Toplevel,info,_)
 374     | (Decl,info,_) -> info in
 375   let token_start_line      x = (get_info x).Ast0.logical_start in
 376   let token_end_line        x = (get_info x).Ast0.logical_end in
 377   let token_real_start_line x = (get_info x).Ast0.line_start in
 378   let token_real_end_line   x = (get_info x).Ast0.line_end in
 379   List.iter
 380     (function
 381         (index,((_::_) as l1)) ->
 382           let _ =
 383             List.fold_left
 384               (function (prev,real_prev) ->
 385                 function cur ->
 386                   let ln = token_start_line cur in
 387                   if ln < prev
 388                   then
 389                     failwith
 390                       (Printf.sprintf
 391                          "error in collection of - tokens %d less than %d"
 392                          (token_real_start_line cur) real_prev);
 393                   (token_end_line cur,token_real_end_line cur))
 394               (token_end_line (List.hd l1), token_real_end_line (List.hd l1))
 395               (List.tl l1) in
 396           ()
 397       | _ -> ()) (* dots, in eg f() has no join points *)
 398     l
 399
 400 let process_minus minus =
 401   create_root_token_table minus;
 402   List.concat
 403     (List.map
 404        (function x ->
 405          let res = call_collect_minus (collect_context x) in
 406          verify res;
 407          res)
 408        minus)
 409
 410 (* --------------------------------------------------------------------- *)
 411 (* --------------------------------------------------------------------- *)
 412 (* collect the plus tokens *)
 413
 414 let mk_baseType x         = Ast.BaseTypeTag x
 415 let mk_structUnion x      = Ast.StructUnionTag x
 416 let mk_sign x             = Ast.SignTag x
 417 let mk_ident x            = Ast.IdentTag (Ast0toast.ident x)
 418 let mk_expression x       = Ast.ExpressionTag (Ast0toast.expression x)
 419 let mk_constant x         = Ast.ConstantTag x
 420 let mk_unaryOp x          = Ast.UnaryOpTag x
 421 let mk_assignOp x         = Ast.AssignOpTag x
 422 let mk_fixOp x            = Ast.FixOpTag x
 423 let mk_binaryOp x         = Ast.BinaryOpTag x
 424 let mk_arithOp x          = Ast.ArithOpTag x
 425 let mk_logicalOp x        = Ast.LogicalOpTag x
 426 let mk_declaration x      = Ast.DeclarationTag (Ast0toast.declaration x)
 427 let mk_topdeclaration x   = Ast.DeclarationTag (Ast0toast.declaration x)
 428 let mk_storage x          = Ast.StorageTag x
 429 let mk_inc_file x         = Ast.IncFileTag x
 430 let mk_statement x        = Ast.StatementTag (Ast0toast.statement x)
 431 let mk_case_line x        = Ast.CaseLineTag (Ast0toast.case_line x)
 432 let mk_const_vol x        = Ast.ConstVolTag x
 433 let mk_token x info       = Ast.Token (x,Some info)
 434 let mk_meta (_,x) info    = Ast.Token (x,Some info)
 435 let mk_code x             = Ast.Code (Ast0toast.top_level x)
 436
 437 let mk_exprdots x  = Ast.ExprDotsTag (Ast0toast.expression_dots x)
 438 let mk_paramdots x = Ast.ParamDotsTag (Ast0toast.parameter_list x)
 439 let mk_stmtdots x  = Ast.StmtDotsTag (Ast0toast.statement_dots x)
 440 let mk_decldots x  = Ast.DeclDotsTag (Ast0toast.declaration_dots x)
 441 let mk_casedots x  = failwith "+ case lines not supported"
 442 let mk_typeC x     = Ast.FullTypeTag (Ast0toast.typeC x)
 443 let mk_init x      = Ast.InitTag (Ast0toast.initialiser x)
 444 let mk_param x     = Ast.ParamTag (Ast0toast.parameterTypeDef x)
 445
 446 let collect_plus_nodes root =
 447   let root_index = Ast0.get_index root in
 448
 449   let bind x y = x @ y in
 450   let option_default = [] in
 451
 452   let mcode fn (term,_,info,mcodekind,_) =
 453     match mcodekind with Ast0.PLUS -> [(info,fn term)] | _ -> [] in
 454
 455   let imcode fn (term,_,info,mcodekind,_) =
 456     match mcodekind with
 457       Ast0.PLUS -> [(info,fn term (Ast0toast.convert_info info))]
 458     | _ -> [] in
 459
 460   let do_nothing fn r k e =
 461     match Ast0.get_mcodekind e with
 462       (Ast0.CONTEXT(_)) when not(Ast0.get_index e = root_index) -> []
 463     | Ast0.PLUS -> [(Ast0.get_info e,fn e)]
 464     | _ -> k e in
 465
 466   (* case for everything that is just a wrapper for a simpler thing *)
 467   let stmt r k e =
 468     match Ast0.unwrap e with
 469       Ast0.Exp(exp) -> r.V0.combiner_expression exp
 470     | Ast0.TopExp(exp) -> r.V0.combiner_expression exp
 471     | Ast0.Ty(ty) -> r.V0.combiner_typeC ty
 472     | Ast0.Decl(_,decl) -> r.V0.combiner_declaration decl
 473     | _ -> do_nothing mk_statement r k e in
 474
 475   (* statementTag is preferred, because it indicates that one statement is
 476   replaced by one statement, in single_statement *)
 477   let stmt_dots r k e =
 478     match Ast0.unwrap e with
 479       Ast0.DOTS([s]) | Ast0.CIRCLES([s]) | Ast0.STARS([s]) ->
 480         r.V0.combiner_statement s
 481     | _ -> do_nothing mk_stmtdots r k e in
 482
 483   let toplevel r k e =
 484     match Ast0.unwrap e with
 485       Ast0.DECL(s) -> r.V0.combiner_statement s
 486     | Ast0.CODE(sdots) -> r.V0.combiner_statement_dots sdots
 487     | _ -> do_nothing mk_code r k e in
 488
 489   let initdots r k e = k e in
 490
 491   V0.combiner bind option_default
 492     (imcode mk_meta) (imcode mk_token) (mcode mk_constant) (mcode mk_assignOp)
 493     (mcode mk_fixOp)
 494     (mcode mk_unaryOp) (mcode mk_binaryOp) (mcode mk_const_vol)
 495     (mcode mk_baseType) (mcode mk_sign) (mcode mk_structUnion)
 496     (mcode mk_storage) (mcode mk_inc_file)
 497     (do_nothing mk_exprdots) initdots
 498     (do_nothing mk_paramdots) stmt_dots (do_nothing mk_decldots)
 499     (do_nothing mk_casedots)
 500     (do_nothing mk_ident) (do_nothing mk_expression)
 501     (do_nothing mk_typeC) (do_nothing mk_init) (do_nothing mk_param)
 502     (do_nothing mk_declaration)
 503     stmt (do_nothing mk_case_line) toplevel
 504
 505 let call_collect_plus context_nodes :
 506     (int * (Ast0.info * Ast.anything) list) list =
 507   List.map
 508     (function e ->
 509       match e with
 510         Ast0.DotsExprTag(e) ->
 511           (Ast0.get_index e,
 512            (collect_plus_nodes e).V0.combiner_expression_dots e)
 513       | Ast0.DotsInitTag(e) ->
 514           (Ast0.get_index e,
 515            (collect_plus_nodes e).V0.combiner_initialiser_list e)
 516       | Ast0.DotsParamTag(e) ->
 517           (Ast0.get_index e,
 518            (collect_plus_nodes e).V0.combiner_parameter_list e)
 519       | Ast0.DotsStmtTag(e) ->
 520           (Ast0.get_index e,
 521            (collect_plus_nodes e).V0.combiner_statement_dots e)
 522       | Ast0.DotsDeclTag(e) ->
 523           (Ast0.get_index e,
 524            (collect_plus_nodes e).V0.combiner_declaration_dots e)
 525       | Ast0.DotsCaseTag(e) ->
 526           (Ast0.get_index e,
 527            (collect_plus_nodes e).V0.combiner_case_line_dots e)
 528       | Ast0.IdentTag(e) ->
 529           (Ast0.get_index e,
 530            (collect_plus_nodes e).V0.combiner_ident e)
 531       | Ast0.ExprTag(e) ->
 532           (Ast0.get_index e,
 533            (collect_plus_nodes e).V0.combiner_expression e)
 534       | Ast0.ArgExprTag(_) | Ast0.TestExprTag(_) ->
 535           failwith "not possible - iso only"
 536       | Ast0.TypeCTag(e) ->
 537           (Ast0.get_index e,
 538            (collect_plus_nodes e).V0.combiner_typeC e)
 539       | Ast0.InitTag(e) ->
 540           (Ast0.get_index e,
 541            (collect_plus_nodes e).V0.combiner_initialiser e)
 542       | Ast0.ParamTag(e) ->
 543           (Ast0.get_index e,
 544            (collect_plus_nodes e).V0.combiner_parameter e)
 545       | Ast0.DeclTag(e) ->
 546           (Ast0.get_index e,
 547            (collect_plus_nodes e).V0.combiner_declaration e)
 548       | Ast0.StmtTag(e) ->
 549           (Ast0.get_index e,
 550            (collect_plus_nodes e).V0.combiner_statement e)
 551       | Ast0.CaseLineTag(e) ->
 552           (Ast0.get_index e,
 553            (collect_plus_nodes e).V0.combiner_case_line e)
 554       | Ast0.TopTag(e) ->
 555           (Ast0.get_index e,
 556            (collect_plus_nodes e).V0.combiner_top_level e)
 557       | Ast0.IsoWhenTag(_) -> failwith "only within iso phase"
 558       | Ast0.IsoWhenTTag(_) -> failwith "only within iso phase"
 559       | Ast0.IsoWhenFTag(_) -> failwith "only within iso phase"
 560       | Ast0.MetaPosTag(p) -> failwith "metapostag only within iso phase")
 561     context_nodes
 562
 563 (* The plus fragments are converted to a list of lists of lists.
 564 Innermost list: Elements have type anything.  For any pair of successive
 565 elements, n and n+1, the ending line of n is the same as the starting line
 566 of n+1.
 567 Middle lists: For any pair of successive elements, n and n+1, the ending
 568 line of n is one less than the starting line of n+1.
 569 Outer list: For any pair of successive elements, n and n+1, the ending
 570 line of n is more than one less than the starting line of n+1. *)
 571
 572 let logstart info = info.Ast0.logical_start
 573 let logend info = info.Ast0.logical_end
 574
 575 let redo info start finish =
 576   {{info with Ast0.logical_start = start} with Ast0.logical_end = finish}
 577
 578 let rec find_neighbors (index,l) :
 579     int * (Ast0.info * (Ast.anything list list)) list =
 580   let rec loop = function
 581       [] -> []
 582     | (i,x)::rest ->
 583         (match loop rest with
 584           ((i1,(x1::rest_inner))::rest_middle)::rest_outer ->
 585             let finish1 = logend i in
 586             let start2 = logstart i1 in
 587             if finish1 = start2
 588             then
 589               ((redo i (logstart i) (logend i1),(x::x1::rest_inner))
 590                ::rest_middle)
 591               ::rest_outer
 592             else if finish1 + 1 = start2
 593             then ((i,[x])::(i1,(x1::rest_inner))::rest_middle)::rest_outer
 594             else [(i,[x])]::((i1,(x1::rest_inner))::rest_middle)::rest_outer
 595         | _ -> [[(i,[x])]]) (* rest must be [] *) in
 596   let res =
 597     List.map
 598       (function l ->
 599         let (start_info,_) = List.hd l in
 600         let (end_info,_) = List.hd (List.rev l) in
 601         (redo start_info (logstart start_info) (logend end_info),
 602          List.map (function (_,x) -> x) l))
 603       (loop l) in
 604   (index,res)
 605
 606 let process_plus plus :
 607     (int * (Ast0.info * Ast.anything list list) list) list =
 608   List.concat
 609     (List.map
 610        (function x ->
 611          List.map find_neighbors (call_collect_plus (collect_context x)))
 612        plus)
 613
 614 (* --------------------------------------------------------------------- *)
 615 (* --------------------------------------------------------------------- *)
 616 (* merge *)
 617 (*
 618 let merge_one = function
 619     (m1::m2::minus_info,p::plus_info) ->
 620       if p < m1, then
 621          attach p to the beginning of m1.bef if m1 is Good, fail if it is bad
 622       if p > m1 && p < m2, then consider the following possibilities, in order
 623          m1 is Good and favored: attach to the beginning of m1.aft
 624          m2 is Good and favored: attach to the beginning of m2.bef; drop m1
 625          m1 is Good and unfavored: attach to the beginning of m1.aft
 626          m2 is Good and unfavored: attach to the beginning of m2.bef; drop m1
 627          also flip m1.bef if the first where > m1
 628          if we drop m1, then flip m1.aft first
 629       if p > m2
 630          m2 is Good and favored: attach to the beginning of m2.aft; drop m1
 631 *)
 632
 633 (* end of first argument < start/end of second argument *)
 634 let less_than_start info1 info2 =
 635   info1.Ast0.logical_end < info2.Ast0.logical_start
 636 let less_than_end info1 info2 =
 637   info1.Ast0.logical_end < info2.Ast0.logical_end
 638 let greater_than_end info1 info2 =
 639   info1.Ast0.logical_start > info2.Ast0.logical_end
 640 let good_start info = info.Ast0.attachable_start
 641 let good_end info = info.Ast0.attachable_end
 642
 643 let toplevel = function Toplevel -> true | Favored | Unfavored | Decl -> false
 644 let decl = function Decl -> true | Favored | Unfavored | Toplevel -> false
 645 let favored = function Favored -> true | Unfavored | Toplevel | Decl -> false
 646
 647 let top_code =
 648   List.for_all (List.for_all (function Ast.Code _ -> true | _ -> false))
 649
 650 (* The following is probably not correct.  The idea is to detect what
 651 should be placed completely before the declaration.  So type/storage
 652 related things do not fall into this category, and complete statements do
 653 fall into this category.  But perhaps other things should be in this
 654 category as well, such as { or ;? *)
 655 let predecl_code =
 656   let tester = function
 657       (* the following should definitely be true *)
 658       Ast.DeclarationTag _
 659     | Ast.StatementTag _
 660     | Ast.Rule_elemTag _
 661     | Ast.StmtDotsTag _
 662     | Ast.Code _ -> true
 663       (* the following should definitely be false *)
 664     | Ast.FullTypeTag _ | Ast.BaseTypeTag _ | Ast.StructUnionTag _
 665     | Ast.SignTag _
 666     | Ast.StorageTag _ | Ast.ConstVolTag _ | Ast.TypeCTag _ -> false
 667       (* not sure about the rest *)
 668     | _ -> false in
 669   List.for_all (List.for_all tester)
 670
 671 let pr = Printf.sprintf
 672
 673 let insert thing thinginfo into intoinfo =
 674   let get_last l = let l = List.rev l in (List.rev(List.tl l),List.hd l) in
 675   let get_first l = (List.hd l,List.tl l) in
 676   let thing_start = thinginfo.Ast0.logical_start in
 677   let thing_end = thinginfo.Ast0.logical_end in
 678   let thing_offset = thinginfo.Ast0.offset in
 679   let into_start = intoinfo.Ast0.tline_start in
 680   let into_end = intoinfo.Ast0.tline_end in
 681   let into_left_offset = intoinfo.Ast0.left_offset in
 682   let into_right_offset = intoinfo.Ast0.right_offset in
 683   if thing_end < into_start && thing_start < into_start
 684   then (thing@into,
 685         {{intoinfo with Ast0.tline_start = thing_start}
 686         with Ast0.left_offset = thing_offset})
 687   else if thing_end = into_start && thing_offset < into_left_offset
 688   then
 689     let (prev,last) = get_last thing in
 690     let (first,rest) = get_first into in
 691     (prev@[last@first]@rest,
 692      {{intoinfo with Ast0.tline_start = thing_start}
 693      with Ast0.left_offset = thing_offset})
 694   else if thing_start > into_end && thing_end > into_end
 695   then (into@thing,
 696         {{intoinfo with Ast0.tline_end = thing_end}
 697         with Ast0.right_offset = thing_offset})
 698   else if thing_start = into_end && thing_offset > into_right_offset
 699   then
 700     let (first,rest) = get_first thing in
 701     let (prev,last) = get_last into in
 702     (prev@[last@first]@rest,
 703      {{intoinfo with Ast0.tline_end = thing_end}
 704      with Ast0.right_offset = thing_offset})
 705   else
 706     begin
 707       Printf.printf "thing start %d thing end %d into start %d into end %d\n"
 708         thing_start thing_end into_start into_end;
 709       Printf.printf "thing offset %d left offset %d right offset %d\n"
 710         thing_offset into_left_offset into_right_offset;
 711       Pretty_print_cocci.print_anything "" thing;
 712       Pretty_print_cocci.print_anything "" into;
 713       failwith "can't figure out where to put the + code"
 714     end
 715
 716 let init thing info =
 717   (thing,
 718    {Ast0.tline_start = info.Ast0.logical_start;
 719      Ast0.tline_end = info.Ast0.logical_end;
 720      Ast0.left_offset = info.Ast0.offset;
 721      Ast0.right_offset = info.Ast0.offset})
 722
 723 let attachbefore (infop,p) = function
 724     Ast0.MINUS(replacements) ->
 725       (match !replacements with
 726         ([],ti) -> replacements := init p infop
 727       | (repl,ti) -> replacements := insert p infop repl ti)
 728   | Ast0.CONTEXT(neighbors) ->
 729       let (repl,ti1,ti2) = !neighbors in
 730       (match repl with
 731         Ast.BEFORE(bef) ->
 732           let (bef,ti1) = insert p infop bef ti1 in
 733           neighbors := (Ast.BEFORE(bef),ti1,ti2)
 734       | Ast.AFTER(aft) ->
 735           let (bef,ti1) = init p infop in
 736           neighbors := (Ast.BEFOREAFTER(bef,aft),ti1,ti2)
 737       | Ast.BEFOREAFTER(bef,aft) ->
 738           let (bef,ti1) = insert p infop bef ti1 in
 739           neighbors := (Ast.BEFOREAFTER(bef,aft),ti1,ti2)
 740       | Ast.NOTHING ->
 741           let (bef,ti1) = init p infop in
 742           neighbors := (Ast.BEFORE(bef),ti1,ti2))
 743   | _ -> failwith "not possible for attachbefore"
 744
 745 let attachafter (infop,p) = function
 746     Ast0.MINUS(replacements) ->
 747       (match !replacements with
 748         ([],ti) -> replacements := init p infop
 749       | (repl,ti) -> replacements := insert p infop repl ti)
 750   | Ast0.CONTEXT(neighbors) ->
 751       let (repl,ti1,ti2) = !neighbors in
 752       (match repl with
 753         Ast.BEFORE(bef) ->
 754           let (aft,ti2) = init p infop in
 755           neighbors := (Ast.BEFOREAFTER(bef,aft),ti1,ti2)
 756       | Ast.AFTER(aft) ->
 757           let (aft,ti2) = insert p infop aft ti2 in
 758           neighbors := (Ast.AFTER(aft),ti1,ti2)
 759       | Ast.BEFOREAFTER(bef,aft) ->
 760           let (aft,ti2) = insert p infop aft ti2 in
 761           neighbors := (Ast.BEFOREAFTER(bef,aft),ti1,ti2)
 762       | Ast.NOTHING ->
 763           let (aft,ti2) = init p infop in
 764           neighbors := (Ast.AFTER(aft),ti1,ti2))
 765   | _ -> failwith "not possible for attachbefore"
 766
 767 let attach_all_before ps m =
 768   List.iter (function x -> attachbefore x m) ps
 769
 770 let attach_all_after ps m =
 771   List.iter (function x -> attachafter x m) ps
 772
 773 let split_at_end info ps =
 774   let split_point =  info.Ast0.logical_end in
 775   List.partition
 776     (function (info,_) -> info.Ast0.logical_end < split_point)
 777     ps
 778
 779 let allminus = function
 780     Ast0.MINUS(_) -> true
 781   | _ -> false
 782
 783 let rec before_m1 ((f1,infom1,m1) as x1) ((f2,infom2,m2) as x2) rest = function
 784     [] -> ()
 785   | (((infop,_) as p) :: ps) as all ->
 786       if less_than_start infop infom1 or
 787         (allminus m1 && less_than_end infop infom1) (* account for trees *)
 788       then
 789         if good_start infom1
 790         then (attachbefore p m1; before_m1 x1 x2 rest ps)
 791         else
 792           failwith
 793             (pr "%d: no available token to attach to" infop.Ast0.line_start)
 794       else after_m1 x1 x2 rest all
 795
 796 and after_m1 ((f1,infom1,m1) as x1) ((f2,infom2,m2) as x2) rest = function
 797     [] -> ()
 798   | (((infop,pcode) as p) :: ps) as all ->
 799       (* if the following is false, then some + code is stuck in the middle
 800          of some context code (m1).  could drop down to the token level.
 801          this might require adjustments in ast0toast as well, when + code on
 802          expressions is dropped down to + code on expressions.  it might
 803          also break some invariants on which iso depends, particularly on
 804          what it can infer from something being CONTEXT with no top-level
 805          modifications.  for the moment, we thus give an error, asking the
 806          user to rewrite the semantic patch. *)
 807       if greater_than_end infop infom1
 808       then
 809         if less_than_start infop infom2
 810         then
 811           if predecl_code pcode && good_end infom1 && decl f1
 812           then (attachafter p m1; after_m1 x1 x2 rest ps)
 813           else if predecl_code pcode && good_start infom2 && decl f2
 814           then before_m2 x2 rest all
 815           else if top_code pcode && good_end infom1 && toplevel f1
 816           then (attachafter p m1; after_m1 x1 x2 rest ps)
 817           else if top_code pcode && good_start infom2 && toplevel f2
 818           then before_m2 x2 rest all
 819           else if good_end infom1 && favored f1
 820           then (attachafter p m1; after_m1 x1 x2 rest ps)
 821           else if good_start infom2 && favored f2
 822           then before_m2 x2 rest all
 823           else if good_end infom1
 824           then (attachafter p m1; after_m1 x1 x2 rest ps)
 825           else if good_start infom2
 826           then before_m2 x2 rest all
 827           else
 828             failwith
 829               (pr "%d: no available token to attach to" infop.Ast0.line_start)
 830         else after_m2 x2 rest all
 831       else
 832         begin
 833           Printf.printf "between: p start %d p end %d m1 start %d m1 end %d m2 start %d m2 end %d\n"
 834             infop.Ast0.line_start infop.Ast0.line_end
 835             infom1.Ast0.line_start infom1.Ast0.line_end
 836             infom2.Ast0.line_start infom2.Ast0.line_end;
 837           Pretty_print_cocci.print_anything "" pcode;
 838           failwith
 839             "The semantic patch is structured in a way that may give bad results with isomorphisms.  Please try to rewrite it by moving + code out from -/context terms."
 840         end
 841
 842 and before_m2 ((f2,infom2,m2) as x2) rest
 843     (p : (Ast0.info * Ast.anything list list) list) =
 844   match (rest,p) with
 845     (_,[]) -> ()
 846   | ([],((infop,_)::_)) ->
 847       let (bef_m2,aft_m2) = split_at_end infom2 p in (* bef_m2 isn't empty *)
 848       if good_start infom2
 849       then (attach_all_before bef_m2 m2; after_m2 x2 rest aft_m2)
 850       else
 851         failwith
 852           (pr "%d: no available token to attach to" infop.Ast0.line_start)
 853   | (m::ms,_) -> before_m1 x2 m ms p
 854
 855 and after_m2 ((f2,infom2,m2) as x2) rest
 856     (p : (Ast0.info * Ast.anything list list) list) =
 857   match (rest,p) with
 858     (_,[]) -> ()
 859   | ([],((infop,_)::_)) ->
 860       if good_end infom2
 861       then attach_all_after p m2
 862       else
 863         failwith
 864           (pr "%d: no available token to attach to" infop.Ast0.line_start)
 865   | (m::ms,_) -> after_m1 x2 m ms p
 866
 867 let merge_one : (minus_join_point * Ast0.info * 'a) list *
 868     (Ast0.info * Ast.anything list list) list -> unit = function (m,p) ->
 869   (*
 870   Printf.printf "minus code\n";
 871   List.iter
 872     (function (_,info,_) ->
 873       Printf.printf "start %d end %d real_start %d real_end %d\n"
 874         info.Ast0.logical_start info.Ast0.logical_end
 875         info.Ast0.line_start info.Ast0.line_end)
 876     m;
 877   Printf.printf "plus code\n";
 878   List.iter
 879     (function (info,p) ->
 880       Printf.printf "start %d end %d real_start %d real_end %d\n"
 881         info.Ast0.logical_start info.Ast0.logical_end
 882         info.Ast0.line_end info.Ast0.line_end;
 883       Pretty_print_cocci.print_anything "" p;
 884       Format.print_newline())
 885     p;
 886   *)
 887   match (m,p) with
 888     (_,[]) -> ()
 889   | (m1::m2::restm,p) -> before_m1 m1 m2 restm p
 890   | ([m],p) -> before_m2 m [] p
 891   | ([],_) -> failwith "minus tree ran out before the plus tree"
 892
 893 let merge minus_list plus_list =
 894   (*
 895   Printf.printf "minus list %s\n"
 896     (String.concat " "
 897        (List.map (function (x,_) -> string_of_int x) minus_list));
 898   Printf.printf "plus list %s\n"
 899     (String.concat " "
 900        (List.map (function (x,_) -> string_of_int x) plus_list));
 901   *)
 902   List.iter
 903     (function (index,minus_info) ->
 904       let plus_info = List.assoc index plus_list in
 905       merge_one (minus_info,plus_info))
 906     minus_list
 907
 908 (* --------------------------------------------------------------------- *)
 909 (* --------------------------------------------------------------------- *)
 910 (* Need to check that CONTEXT nodes have nothing attached to their tokens.
 911 If they do, they become MIXED *)
 912
 913 let reevaluate_contextness =
 914    let bind = (@) in
 915    let option_default = [] in
 916
 917    let mcode (_,_,_,mc,_) =
 918      match mc with
 919        Ast0.CONTEXT(mc) -> let (ba,_,_) = !mc in [ba]
 920      | _ -> [] in
 921
 922    let donothing r k e =
 923      match Ast0.get_mcodekind e with
 924        Ast0.CONTEXT(mc) ->
 925          if List.exists (function Ast.NOTHING -> false | _ -> true) (k e)
 926          then Ast0.set_mcodekind e (Ast0.MIXED(mc));
 927          []
 928      | _ -> let _ = k e in [] in
 929
 930   let res =
 931     V0.combiner bind option_default
 932       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 933       mcode
 934       donothing donothing donothing donothing donothing donothing donothing
 935       donothing
 936       donothing donothing donothing donothing donothing donothing donothing in
 937   res.V0.combiner_top_level
 938
 939 (* --------------------------------------------------------------------- *)
 940 (* --------------------------------------------------------------------- *)
 941
 942 let insert_plus minus plus =
 943   let minus_stream = process_minus minus in
 944   let plus_stream = process_plus plus in
 945   merge minus_stream plus_stream;
 946   List.iter (function x -> let _ =  reevaluate_contextness x in ()) minus