parsing_cocci/insert_plus.ml

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