parsing_cocci/.#insert_plus.ml.1.74

   1 (*
   2 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
   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 empty_isos = ref false
  38
  39 let get_option f = function
  40     None -> []
  41   | Some x -> f x
  42
  43 (* --------------------------------------------------------------------- *)
  44 (* Collect root and all context nodes in a tree *)
  45
  46 let collect_context e =
  47   let bind x y = x @ y in
  48   let option_default = [] in
  49
  50   let mcode _ = [] in
  51
  52   let donothing builder r k e =
  53     match Ast0.get_mcodekind e with
  54       Ast0.CONTEXT(_) -> (builder e) :: (k e)
  55     | _ -> k e in
  56
  57 (* special case for everything that contains whencode, so that we skip over
  58 it *)
  59   let expression r k e =
  60     donothing Ast0.expr r k
  61       (Ast0.rewrap e
  62          (match Ast0.unwrap e with
  63            Ast0.NestExpr(starter,exp,ender,whencode,multi) ->
  64              Ast0.NestExpr(starter,exp,ender,None,multi)
  65          | Ast0.Edots(dots,whencode) -> Ast0.Edots(dots,None)
  66          | Ast0.Ecircles(dots,whencode) -> Ast0.Ecircles(dots,None)
  67          | Ast0.Estars(dots,whencode) -> Ast0.Estars(dots,None)
  68          | e -> e)) in
  69
  70   let initialiser r k i =
  71     donothing Ast0.ini r k
  72       (Ast0.rewrap i
  73          (match Ast0.unwrap i with
  74            Ast0.Idots(dots,whencode) -> Ast0.Idots(dots,None)
  75          | i -> i)) in
  76
  77   let statement r k s =
  78     donothing Ast0.stmt r k
  79       (Ast0.rewrap s
  80          (match Ast0.unwrap s with
  81            Ast0.Nest(started,stm_dots,ender,whencode,multi) ->
  82              Ast0.Nest(started,stm_dots,ender,[],multi)
  83          | Ast0.Dots(dots,whencode) -> Ast0.Dots(dots,[])
  84          | Ast0.Circles(dots,whencode) -> Ast0.Circles(dots,[])
  85          | Ast0.Stars(dots,whencode) -> Ast0.Stars(dots,[])
  86          | s -> s)) in
  87
  88   let topfn r k e = Ast0.TopTag(e) :: (k e) in
  89
  90   let res =
  91     V0.combiner bind option_default
  92       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
  93       (donothing Ast0.dotsExpr) (donothing Ast0.dotsInit)
  94       (donothing Ast0.dotsParam) (donothing Ast0.dotsStmt)
  95       (donothing Ast0.dotsDecl) (donothing Ast0.dotsCase)
  96       (donothing Ast0.ident) expression (donothing Ast0.typeC) initialiser
  97       (donothing Ast0.param) (donothing Ast0.decl) statement
  98       (donothing Ast0.case_line) topfn in
  99   res.V0.combiner_top_level e
 100
 101 (* --------------------------------------------------------------------- *)
 102 (* --------------------------------------------------------------------- *)
 103 (* collect the possible join points, in order, among the children of a
 104 BindContext.  Dots are not allowed.  Nests and disjunctions are no problem,
 105 because their delimiters take up a line by themselves *)
 106
 107 (* An Unfavored token is one that is in a BindContext node; using this causes
 108   the node to become Neither, meaning that isomorphisms can't be applied *)
 109 (* Toplevel is for the bef token of a function declaration and is for
 110 attaching top-level definitions that should come before the complete
 111 declaration *)
 112 type minus_join_point = Favored | Unfavored | Toplevel | Decl
 113
 114 (* Maps the index of a node to the indices of the mcodes it contains *)
 115 let root_token_table = (Hashtbl.create(50) : (int, int list) Hashtbl.t)
 116
 117 let create_root_token_table minus =
 118   Hashtbl.iter
 119     (function tokens ->
 120       function (node,_) ->
 121         let key =
 122           match node with
 123             Ast0.DotsExprTag(d) -> Ast0.get_index d
 124           | Ast0.DotsInitTag(d) -> Ast0.get_index d
 125           | Ast0.DotsParamTag(d) -> Ast0.get_index d
 126           | Ast0.DotsStmtTag(d) -> Ast0.get_index d
 127           | Ast0.DotsDeclTag(d) -> Ast0.get_index d
 128           | Ast0.DotsCaseTag(d) -> Ast0.get_index d
 129           | Ast0.IdentTag(d) -> Ast0.get_index d
 130           | Ast0.ExprTag(d) -> Ast0.get_index d
 131           | Ast0.ArgExprTag(d) | Ast0.TestExprTag(d) ->
 132               failwith "not possible - iso only"
 133           | Ast0.TypeCTag(d) -> Ast0.get_index d
 134           | Ast0.ParamTag(d) -> Ast0.get_index d
 135           | Ast0.InitTag(d) -> Ast0.get_index d
 136           | Ast0.DeclTag(d) -> Ast0.get_index d
 137           | Ast0.StmtTag(d) -> Ast0.get_index d
 138           | Ast0.CaseLineTag(d) -> Ast0.get_index d
 139           | Ast0.TopTag(d) -> Ast0.get_index d
 140           | Ast0.IsoWhenTag(_) -> failwith "only within iso phase"
 141           | Ast0.IsoWhenTTag(_) -> failwith "only within iso phase"
 142           | Ast0.IsoWhenFTag(_) -> failwith "only within iso phase"
 143           | Ast0.MetaPosTag(p) -> failwith "metapostag only within iso phase"
 144         in
 145         Hashtbl.add root_token_table key tokens)
 146     CN.minus_table;
 147   List.iter
 148     (function r ->
 149       let index = Ast0.get_index r in
 150       try let _ = Hashtbl.find root_token_table index in ()
 151       with Not_found -> Hashtbl.add root_token_table index [])
 152     minus
 153
 154 let collect_minus_join_points root =
 155   let root_index = Ast0.get_index root in
 156   let unfavored_tokens = Hashtbl.find root_token_table root_index in
 157   let bind x y = x @ y in
 158   let option_default = [] in
 159
 160   let mcode (_,_,info,mcodekind,_) =
 161     if List.mem (info.Ast0.offset) unfavored_tokens
 162     then [(Unfavored,info,mcodekind)]
 163     else [(Favored,info,mcodekind)] in
 164
 165   let do_nothing r k e =
 166     let info = Ast0.get_info e in
 167     let index = Ast0.get_index e in
 168     match Ast0.get_mcodekind e with
 169       (Ast0.MINUS(_)) as mc -> [(Favored,info,mc)]
 170     | (Ast0.CONTEXT(_)) as mc when not(index = root_index) ->
 171         (* This was unfavored at one point, but I don't remember why *)
 172       [(Favored,info,mc)]
 173     | _ -> k e in
 174
 175 (* don't want to attach to the outside of DOTS, because metavariables can't
 176 bind to that; not good for isomorphisms *)
 177
 178   let dots f k d =
 179     let multibind l =
 180       let rec loop = function
 181           [] -> option_default
 182         | [x] -> x
 183         | x::xs -> bind x (loop xs) in
 184       loop l in
 185
 186     match Ast0.unwrap d with
 187       Ast0.DOTS(l) -> multibind (List.map f l)
 188     | Ast0.CIRCLES(l) -> multibind (List.map f l)
 189     | Ast0.STARS(l) -> multibind (List.map f l) in
 190
 191   let edots r k d = dots r.V0.combiner_expression k d in
 192   let idots r k d = dots r.V0.combiner_initialiser k d in
 193   let pdots r k d = dots r.V0.combiner_parameter k d in
 194   let sdots r k d = dots r.V0.combiner_statement k d in
 195   let ddots r k d = dots r.V0.combiner_declaration k d in
 196   let cdots r k d = dots r.V0.combiner_case_line k d in
 197
 198   (* a case for everything that has a Opt *)
 199
 200   let statement r k s =
 201     (*
 202     let redo_branched res (ifinfo,aftmc) =
 203       let redo fv info mc rest =
 204         let new_info = {info with Ast0.attachable_end = false} in
 205         List.rev ((Favored,ifinfo,aftmc)::(fv,new_info,mc)::rest) in
 206       match List.rev res with
 207         [(fv,info,mc)] ->
 208           (match mc with
 209             Ast0.MINUS(_) | Ast0.CONTEXT(_) ->
 210                 (* even for -, better for isos not to integrate code after an
 211                    if into the if body.
 212                    but the problem is that this can extend the region in
 213                    which a variable is bound, because a variable bound in the
 214                    aft node would seem to have to be live in the whole if,
 215                    whereas we might like it to be live in only one branch.
 216                    ie ideally, if we can keep the minus code in the right
 217                    order, we would like to drop it as close to the bindings
 218                    of its free variables.  This could be anywhere in the minus
 219                    code.  Perhaps we would like to do this after the
 220                    application of isomorphisms, though.
 221                 *)
 222               redo fv info mc []
 223           | _ -> res)
 224       | (fv,info,mc)::rest ->
 225           (match mc with
 226             Ast0.CONTEXT(_) -> redo fv info mc rest
 227           | _ -> res)
 228       | _ -> failwith "unexpected empty code" in *)
 229     match Ast0.unwrap s with
 230  (*     Ast0.IfThen(_,_,_,_,_,aft)
 231     | Ast0.IfThenElse(_,_,_,_,_,_,_,aft)
 232     | Ast0.While(_,_,_,_,_,aft)
 233     | Ast0.For(_,_,_,_,_,_,_,_,_,aft)
 234     | Ast0.Iterator(_,_,_,_,_,aft) ->
 235         redo_branched (do_nothing r k s) aft*)
 236     | Ast0.FunDecl((info,bef),fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
 237         (Toplevel,info,bef)::(k s)
 238     | Ast0.Decl((info,bef),decl) -> (Decl,info,bef)::(k s)
 239     | Ast0.Nest(starter,stmt_dots,ender,whencode,multi) ->
 240         mcode starter @ r.V0.combiner_statement_dots stmt_dots @ mcode ender
 241     | Ast0.Dots(d,whencode) | Ast0.Circles(d,whencode)
 242     | Ast0.Stars(d,whencode) -> mcode d (* ignore whencode *)
 243     | Ast0.OptStm s | Ast0.UniqueStm s ->
 244         (* put the + code on the thing, not on the opt *)
 245         r.V0.combiner_statement s
 246     | _ -> do_nothing r k s in
 247
 248   let expression r k e =
 249     match Ast0.unwrap e with
 250       Ast0.NestExpr(starter,expr_dots,ender,whencode,multi) ->
 251         mcode starter @
 252         r.V0.combiner_expression_dots expr_dots @ mcode ender
 253     | Ast0.Edots(d,whencode) | Ast0.Ecircles(d,whencode)
 254     | Ast0.Estars(d,whencode) -> mcode d (* ignore whencode *)
 255     | Ast0.OptExp e | Ast0.UniqueExp e ->
 256         (* put the + code on the thing, not on the opt *)
 257         r.V0.combiner_expression e
 258     | _ -> do_nothing r k e in
 259
 260   let ident r k e =
 261     match Ast0.unwrap e with
 262       Ast0.OptIdent i | Ast0.UniqueIdent i ->
 263         (* put the + code on the thing, not on the opt *)
 264         r.V0.combiner_ident i
 265     | _ -> do_nothing r k e in
 266
 267   let typeC r k e =
 268     match Ast0.unwrap e with
 269       Ast0.OptType t | Ast0.UniqueType t ->
 270         (* put the + code on the thing, not on the opt *)
 271         r.V0.combiner_typeC t
 272     | _ -> do_nothing r k e in
 273
 274   let decl r k e =
 275     match Ast0.unwrap e with
 276       Ast0.OptDecl d | Ast0.UniqueDecl d ->
 277         (* put the + code on the thing, not on the opt *)
 278         r.V0.combiner_declaration d
 279     | _ -> do_nothing r k e in
 280
 281   let initialiser r k e =
 282     match Ast0.unwrap e with
 283       Ast0.Idots(d,whencode) -> mcode d (* ignore whencode *)
 284     | Ast0.OptIni i | Ast0.UniqueIni i ->
 285         (* put the + code on the thing, not on the opt *)
 286         r.V0.combiner_initialiser i
 287     | _ -> do_nothing r k e in
 288
 289   let param r k e =
 290     match Ast0.unwrap e with
 291       Ast0.OptParam p | Ast0.UniqueParam p ->
 292         (* put the + code on the thing, not on the opt *)
 293         r.V0.combiner_parameter p
 294     | _ -> do_nothing r k e in
 295
 296   let case_line r k e =
 297     match Ast0.unwrap e with
 298       Ast0.OptCase c ->
 299         (* put the + code on the thing, not on the opt *)
 300         r.V0.combiner_case_line c
 301     | _ -> do_nothing r k e in
 302
 303   let do_top r k (e: Ast0.top_level) = k e in
 304
 305   V0.combiner bind option_default
 306     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode 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_structUnion x      = Ast.StructUnionTag x
 415 let mk_sign x             = Ast.SignTag x
 416 let mk_ident x            = Ast.IdentTag (Ast0toast.ident x)
 417 let mk_expression x       = Ast.ExpressionTag (Ast0toast.expression x)
 418 let mk_constant x         = Ast.ConstantTag x
 419 let mk_unaryOp x          = Ast.UnaryOpTag x
 420 let mk_assignOp x         = Ast.AssignOpTag x
 421 let mk_fixOp x            = Ast.FixOpTag x
 422 let mk_binaryOp x         = Ast.BinaryOpTag x
 423 let mk_arithOp x          = Ast.ArithOpTag x
 424 let mk_logicalOp x        = Ast.LogicalOpTag x
 425 let mk_declaration x      = Ast.DeclarationTag (Ast0toast.declaration x)
 426 let mk_topdeclaration x   = Ast.DeclarationTag (Ast0toast.declaration x)
 427 let mk_storage x          = Ast.StorageTag x
 428 let mk_inc_file x         = Ast.IncFileTag x
 429 let mk_statement x        = Ast.StatementTag (Ast0toast.statement x)
 430 let mk_case_line x        = Ast.CaseLineTag (Ast0toast.case_line x)
 431 let mk_const_vol x        = Ast.ConstVolTag x
 432 let mk_token x info       = Ast.Token (x,Some info)
 433 let mk_meta (_,x) info    = Ast.Token (x,Some info)
 434 let mk_code x             = Ast.Code (Ast0toast.top_level x)
 435
 436 let mk_exprdots x  = Ast.ExprDotsTag (Ast0toast.expression_dots x)
 437 let mk_paramdots x = Ast.ParamDotsTag (Ast0toast.parameter_list x)
 438 let mk_stmtdots x  = Ast.StmtDotsTag (Ast0toast.statement_dots x)
 439 let mk_decldots x  = Ast.DeclDotsTag (Ast0toast.declaration_dots x)
 440 let mk_casedots x  = failwith "+ case lines not supported"
 441 let mk_typeC x     = Ast.FullTypeTag (Ast0toast.typeC x)
 442 let mk_init x      = Ast.InitTag (Ast0toast.initialiser x)
 443 let mk_param x     = Ast.ParamTag (Ast0toast.parameterTypeDef x)
 444
 445 let collect_plus_nodes root =
 446   let root_index = Ast0.get_index root in
 447
 448   let bind x y = x @ y in
 449   let option_default = [] in
 450
 451   let mcode fn (term,_,info,mcodekind,_) =
 452     match mcodekind with Ast0.PLUS -> [(info,fn term)] | _ -> [] in
 453
 454   let imcode fn (term,_,info,mcodekind,_) =
 455     match mcodekind with
 456       Ast0.PLUS -> [(info,fn term (Ast0toast.convert_info info))]
 457     | _ -> [] in
 458
 459   let do_nothing fn r k e =
 460     match Ast0.get_mcodekind e with
 461       (Ast0.CONTEXT(_)) when not(Ast0.get_index e = root_index) -> []
 462     | Ast0.PLUS -> [(Ast0.get_info e,fn e)]
 463     | _ -> k e in
 464
 465   (* case for everything that is just a wrapper for a simpler thing *)
 466   let stmt r k e =
 467     match Ast0.unwrap e with
 468       Ast0.Exp(exp) -> r.V0.combiner_expression exp
 469     | Ast0.TopExp(exp) -> r.V0.combiner_expression exp
 470     | Ast0.Ty(ty) -> r.V0.combiner_typeC ty
 471     | Ast0.TopInit(init) -> r.V0.combiner_initialiser init
 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_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 or is_minus m1 or !empty_isos
 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 (* not sure this is safe.  if have iso problems, consider changing this
 843 to always return false *)
 844 and is_minus = function
 845     Ast0.MINUS _ -> true
 846   | _ -> false
 847
 848 and before_m2 ((f2,infom2,m2) as x2) rest
 849     (p : (Ast0.info * Ast.anything list list) list) =
 850   match (rest,p) with
 851     (_,[]) -> ()
 852   | ([],((infop,_)::_)) ->
 853       let (bef_m2,aft_m2) = split_at_end infom2 p in (* bef_m2 isn't empty *)
 854       if good_start infom2
 855       then (attach_all_before bef_m2 m2; after_m2 x2 rest aft_m2)
 856       else
 857         failwith
 858           (pr "%d: no available token to attach to" infop.Ast0.line_start)
 859   | (m::ms,_) -> before_m1 x2 m ms p
 860
 861 and after_m2 ((f2,infom2,m2) as x2) rest
 862     (p : (Ast0.info * Ast.anything list list) list) =
 863   match (rest,p) with
 864     (_,[]) -> ()
 865   | ([],((infop,_)::_)) ->
 866       if good_end infom2
 867       then attach_all_after p m2
 868       else
 869         failwith
 870           (pr "%d: no available token to attach to" infop.Ast0.line_start)
 871   | (m::ms,_) -> after_m1 x2 m ms p
 872
 873 let merge_one : (minus_join_point * Ast0.info * 'a) list *
 874     (Ast0.info * Ast.anything list list) list -> unit = function (m,p) ->
 875   (*
 876   Printf.printf "minus code\n";
 877   List.iter
 878     (function (_,info,_) ->
 879       Printf.printf "start %d end %d real_start %d real_end %d\n"
 880         info.Ast0.logical_start info.Ast0.logical_end
 881         info.Ast0.line_start info.Ast0.line_end)
 882     m;
 883   Printf.printf "plus code\n";
 884   List.iter
 885     (function (info,p) ->
 886       Printf.printf "start %d end %d real_start %d real_end %d\n"
 887         info.Ast0.logical_start info.Ast0.logical_end
 888         info.Ast0.line_end info.Ast0.line_end;
 889       Pretty_print_cocci.print_anything "" p;
 890       Format.print_newline())
 891     p;
 892   *)
 893   match (m,p) with
 894     (_,[]) -> ()
 895   | (m1::m2::restm,p) -> before_m1 m1 m2 restm p
 896   | ([m],p) -> before_m2 m [] p
 897   | ([],_) -> failwith "minus tree ran out before the plus tree"
 898
 899 let merge minus_list plus_list =
 900   (*
 901   Printf.printf "minus list %s\n"
 902     (String.concat " "
 903        (List.map (function (x,_) -> string_of_int x) minus_list));
 904   Printf.printf "plus list %s\n"
 905     (String.concat " "
 906        (List.map (function (x,_) -> string_of_int x) plus_list));
 907   *)
 908   List.iter
 909     (function (index,minus_info) ->
 910       let plus_info = List.assoc index plus_list in
 911       merge_one (minus_info,plus_info))
 912     minus_list
 913
 914 (* --------------------------------------------------------------------- *)
 915 (* --------------------------------------------------------------------- *)
 916 (* Need to check that CONTEXT nodes have nothing attached to their tokens.
 917 If they do, they become MIXED *)
 918
 919 let reevaluate_contextness =
 920    let bind = (@) in
 921    let option_default = [] in
 922
 923    let mcode (_,_,_,mc,_) =
 924      match mc with
 925        Ast0.CONTEXT(mc) -> let (ba,_,_) = !mc in [ba]
 926      | _ -> [] in
 927
 928    let donothing r k e =
 929      match Ast0.get_mcodekind e with
 930        Ast0.CONTEXT(mc) ->
 931          if List.exists (function Ast.NOTHING -> false | _ -> true) (k e)
 932          then Ast0.set_mcodekind e (Ast0.MIXED(mc));
 933          []
 934      | _ -> let _ = k e in [] in
 935
 936   let res =
 937     V0.combiner bind option_default
 938       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 939       donothing donothing donothing donothing donothing donothing donothing
 940       donothing
 941       donothing donothing donothing donothing donothing donothing donothing in
 942   res.V0.combiner_top_level
 943
 944 (* --------------------------------------------------------------------- *)
 945 (* --------------------------------------------------------------------- *)
 946
 947 let insert_plus minus plus ei =
 948   empty_isos := ei;
 949   let minus_stream = process_minus minus in
 950   let plus_stream = process_plus plus in
 951   merge minus_stream plus_stream;
 952   List.iter (function x -> let _ =  reevaluate_contextness x in ()) minus