parsing_cocci/context_neg.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 (* Detects subtrees that are all minus/plus and nodes that are "binding
  28 context nodes".  The latter is a node whose structure and immediate tokens
  29 are the same in the minus and plus trees, and such that for every child,
  30 the set of context nodes in the child subtree is the same in the minus and
  31 plus subtrees. *)
  32
  33 module Ast = Ast_cocci
  34 module Ast0 = Ast0_cocci
  35 module V0 = Visitor_ast0
  36 module VT0 = Visitor_ast0_types
  37 module U = Unparse_ast0
  38
  39 (* --------------------------------------------------------------------- *)
  40 (* Generic access to code *)
  41
  42 let set_mcodekind x mcodekind =
  43   match x with
  44     Ast0.DotsExprTag(d) -> Ast0.set_mcodekind d mcodekind
  45   | Ast0.DotsInitTag(d) -> Ast0.set_mcodekind d mcodekind
  46   | Ast0.DotsParamTag(d) -> Ast0.set_mcodekind d mcodekind
  47   | Ast0.DotsStmtTag(d) -> Ast0.set_mcodekind d mcodekind
  48   | Ast0.DotsDeclTag(d) -> Ast0.set_mcodekind d mcodekind
  49   | Ast0.DotsCaseTag(d) -> Ast0.set_mcodekind d mcodekind
  50   | Ast0.IdentTag(d) -> Ast0.set_mcodekind d mcodekind
  51   | Ast0.ExprTag(d) -> Ast0.set_mcodekind d mcodekind
  52   | Ast0.ArgExprTag(d) | Ast0.TestExprTag(d) ->
  53       failwith "not possible - iso only"
  54   | Ast0.TypeCTag(d) -> Ast0.set_mcodekind d mcodekind
  55   | Ast0.ParamTag(d) -> Ast0.set_mcodekind d mcodekind
  56   | Ast0.DeclTag(d) -> Ast0.set_mcodekind d mcodekind
  57   | Ast0.InitTag(d) -> Ast0.set_mcodekind d mcodekind
  58   | Ast0.StmtTag(d) -> Ast0.set_mcodekind d mcodekind
  59   | Ast0.CaseLineTag(d) -> Ast0.set_mcodekind d mcodekind
  60   | Ast0.TopTag(d) -> Ast0.set_mcodekind d mcodekind
  61   | Ast0.IsoWhenTag(_) -> failwith "only within iso phase"
  62   | Ast0.IsoWhenTTag(_) -> failwith "only within iso phase"
  63   | Ast0.IsoWhenFTag(_) -> failwith "only within iso phase"
  64   | Ast0.MetaPosTag(p) -> failwith "invisible at this stage"
  65   | Ast0.HiddenVarTag(p) -> failwith "hiddenvar only within iso phase"
  66
  67 let set_index x index =
  68   match x with
  69     Ast0.DotsExprTag(d) -> Ast0.set_index d index
  70   | Ast0.DotsInitTag(d) -> Ast0.set_index d index
  71   | Ast0.DotsParamTag(d) -> Ast0.set_index d index
  72   | Ast0.DotsStmtTag(d) -> Ast0.set_index d index
  73   | Ast0.DotsDeclTag(d) -> Ast0.set_index d index
  74   | Ast0.DotsCaseTag(d) -> Ast0.set_index d index
  75   | Ast0.IdentTag(d) -> Ast0.set_index d index
  76   | Ast0.ExprTag(d) -> Ast0.set_index d index
  77   | Ast0.ArgExprTag(d) | Ast0.TestExprTag(d) ->
  78       failwith "not possible - iso only"
  79   | Ast0.TypeCTag(d) -> Ast0.set_index d index
  80   | Ast0.ParamTag(d) -> Ast0.set_index d index
  81   | Ast0.InitTag(d) -> Ast0.set_index d index
  82   | Ast0.DeclTag(d) -> Ast0.set_index d index
  83   | Ast0.StmtTag(d) -> Ast0.set_index d index
  84   | Ast0.CaseLineTag(d) -> Ast0.set_index d index
  85   | Ast0.TopTag(d) -> Ast0.set_index d index
  86   | Ast0.IsoWhenTag(_) -> failwith "only within iso phase"
  87   | Ast0.IsoWhenTTag(_) -> failwith "only within iso phase"
  88   | Ast0.IsoWhenFTag(_) -> failwith "only within iso phase"
  89   | Ast0.MetaPosTag(p) -> failwith "invisible at this stage"
  90   | Ast0.HiddenVarTag(p) -> failwith "hiddenvar only within iso phase"
  91
  92 let get_index = function
  93     Ast0.DotsExprTag(d) -> Index.expression_dots d
  94   | Ast0.DotsInitTag(d) -> Index.initialiser_dots d
  95   | Ast0.DotsParamTag(d) -> Index.parameter_dots d
  96   | Ast0.DotsStmtTag(d) -> Index.statement_dots d
  97   | Ast0.DotsDeclTag(d) -> Index.declaration_dots d
  98   | Ast0.DotsCaseTag(d) -> Index.case_line_dots d
  99   | Ast0.IdentTag(d) -> Index.ident d
 100   | Ast0.ExprTag(d) -> Index.expression d
 101   | Ast0.ArgExprTag(d) | Ast0.TestExprTag(d) ->
 102       failwith "not possible - iso only"
 103   | Ast0.TypeCTag(d) -> Index.typeC d
 104   | Ast0.ParamTag(d) -> Index.parameterTypeDef d
 105   | Ast0.InitTag(d) -> Index.initialiser d
 106   | Ast0.DeclTag(d) -> Index.declaration d
 107   | Ast0.StmtTag(d) -> Index.statement d
 108   | Ast0.CaseLineTag(d) -> Index.case_line d
 109   | Ast0.TopTag(d) -> Index.top_level d
 110   | Ast0.IsoWhenTag(_) -> failwith "only within iso phase"
 111   | Ast0.IsoWhenTTag(_) -> failwith "only within iso phase"
 112   | Ast0.IsoWhenFTag(_) -> failwith "only within iso phase"
 113   | Ast0.MetaPosTag(p) -> failwith "invisible at this stage"
 114   | Ast0.HiddenVarTag(p) -> failwith "hiddenvar only within iso phase"
 115
 116 (* --------------------------------------------------------------------- *)
 117 (* Collect the line numbers of the plus code.  This is used for disjunctions.
 118 It is not completely clear why this is necessary, but it seems like an easy
 119 fix for whatever is the problem that is discussed in disj_cases *)
 120
 121 let plus_lines = ref ([] : int list)
 122
 123 let insert n =
 124   let rec loop = function
 125       [] -> [n]
 126     | x::xs ->
 127         match compare n x with
 128           1 -> x::(loop xs)
 129         | 0 -> x::xs
 130         | -1 -> n::x::xs
 131         | _ -> failwith "not possible" in
 132   plus_lines := loop !plus_lines
 133
 134 let find n min max =
 135   let rec loop = function
 136       [] -> (min,max)
 137     | [x] -> if n < x then (min,x) else (x,max)
 138     | x1::x2::rest ->
 139         if n < x1
 140         then (min,x1)
 141         else if n > x1 && n < x2 then (x1,x2) else loop (x2::rest) in
 142   loop !plus_lines
 143
 144 let collect_plus_lines top =
 145   plus_lines := [];
 146   let bind x y = () in
 147   let option_default = () in
 148   let donothing r k e = k e in
 149   let mcode (_,_,info,mcodekind,_,_) =
 150     match mcodekind with
 151       Ast0.PLUS _ -> insert info.Ast0.pos_info.Ast0.line_start
 152     | _ -> () in
 153   let fn =
 154     V0.flat_combiner bind option_default
 155       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 156       donothing donothing donothing donothing donothing donothing
 157       donothing donothing donothing donothing donothing donothing donothing
 158       donothing donothing in
 159   fn.VT0.combiner_rec_top_level top
 160
 161 (* --------------------------------------------------------------------- *)
 162
 163 type kind =
 164     Neutral | AllMarked of Ast.count | NotAllMarked (* marked means + or - *)
 165
 166 (* --------------------------------------------------------------------- *)
 167 (* The first part analyzes each of the minus tree and the plus tree
 168 separately *)
 169
 170 (* ints are unique token indices (offset field) *)
 171 type node =
 172     Token (* tokens *) of kind * int (* unique index *) * Ast0.mcodekind *
 173         int list (* context tokens *)
 174   | Recursor (* children *) of kind *
 175         int list (* indices of all tokens at the level below *) *
 176         Ast0.mcodekind list (* tokens at the level below *) *
 177         int list
 178   | Bind (* neighbors *) of kind *
 179         int list (* indices of all tokens at current level *) *
 180         Ast0.mcodekind list (* tokens at current level *) *
 181         int list (* indices of all tokens at the level below *) *
 182         Ast0.mcodekind list (* tokens at the level below *)
 183         * int list list
 184
 185 let kind2c = function
 186     Neutral -> "neutral"
 187   | AllMarked _ -> "allmarked"
 188   | NotAllMarked -> "notallmarked"
 189
 190 let node2c = function
 191     Token(k,_,_,_) -> Printf.sprintf "token %s\n" (kind2c k)
 192   | Recursor(k,_,_,_) -> Printf.sprintf "recursor %s\n" (kind2c k)
 193   | Bind(k,_,_,_,_,_) -> Printf.sprintf "bind %s\n" (kind2c k)
 194
 195 (* goal: detect negative in both tokens and recursors, or context only in
 196 tokens *)
 197 let bind c1 c2 =
 198   let lub = function
 199       (k1,k2) when k1 = k2 -> k1
 200     | (Neutral,AllMarked c) -> AllMarked c
 201     | (AllMarked c,Neutral) -> AllMarked c
 202     | _ -> NotAllMarked in
 203   match (c1,c2) with
 204     (* token/token *)
 205     (* there are tokens at this level, so ignore the level below *)
 206     (Token(k1,i1,t1,l1),Token(k2,i2,t2,l2)) ->
 207       Bind(lub(k1,k2),[i1;i2],[t1;t2],[],[],[l1;l2])
 208
 209     (* token/recursor *)
 210     (* there are tokens at this level, so ignore the level below *)
 211   | (Token(k1,i1,t1,l1),Recursor(k2,_,_,l2)) ->
 212       Bind(lub(k1,k2),[i1],[t1],[],[],[l1;l2])
 213   | (Recursor(k1,_,_,l1),Token(k2,i2,t2,l2)) ->
 214       Bind(lub(k1,k2),[i2],[t2],[],[],[l1;l2])
 215
 216     (* token/bind *)
 217     (* there are tokens at this level, so ignore the level below *)
 218   | (Token(k1,i1,t1,l1),Bind(k2,i2,t2,_,_,l2)) ->
 219       Bind(lub(k1,k2),i1::i2,t1::t2,[],[],l1::l2)
 220   | (Bind(k1,i1,t1,_,_,l1),Token(k2,i2,t2,l2)) ->
 221       Bind(lub(k1,k2),i1@[i2],t1@[t2],[],[],l1@[l2])
 222
 223     (* recursor/bind *)
 224   | (Recursor(k1,bi1,bt1,l1),Bind(k2,i2,t2,bi2,bt2,l2)) ->
 225       Bind(lub(k1,k2),i2,t2,bi1@bi2,bt1@bt2,l1::l2)
 226   | (Bind(k1,i1,t1,bi1,bt1,l1),Recursor(k2,bi2,bt2,l2)) ->
 227       Bind(lub(k1,k2),i1,t1,bi1@bi2,bt1@bt2,l1@[l2])
 228
 229     (* recursor/recursor and bind/bind - not likely to ever occur *)
 230   | (Recursor(k1,bi1,bt1,l1),Recursor(k2,bi2,bt2,l2)) ->
 231       Bind(lub(k1,k2),[],[],bi1@bi2,bt1@bt2,[l1;l2])
 232   | (Bind(k1,i1,t1,bi1,bt1,l1),Bind(k2,i2,t2,bi2,bt2,l2)) ->
 233       Bind(lub(k1,k2),i1@i2,t1@t2,bi1@bi2,bt1@bt2,l1@l2)
 234
 235
 236 let option_default = (*Bind(Neutral,[],[],[],[],[])*)
 237   Recursor(Neutral,[],[],[])
 238
 239 let mcode (_,_,info,mcodekind,pos,_) =
 240   let offset = info.Ast0.pos_info.Ast0.offset in
 241   match mcodekind with
 242     Ast0.MINUS(_) -> Token(AllMarked Ast.ONE,offset,mcodekind,[])
 243   | Ast0.PLUS c -> Token(AllMarked c,offset,mcodekind,[])
 244   | Ast0.CONTEXT(_) -> Token(NotAllMarked,offset,mcodekind,[offset])
 245   | _ -> failwith "not possible"
 246
 247 let neutral_mcode (_,_,info,mcodekind,pos,_) =
 248   let offset = info.Ast0.pos_info.Ast0.offset in
 249   match mcodekind with
 250     Ast0.MINUS(_) -> Token(Neutral,offset,mcodekind,[])
 251   | Ast0.PLUS _ -> Token(Neutral,offset,mcodekind,[])
 252   | Ast0.CONTEXT(_) -> Token(Neutral,offset,mcodekind,[offset])
 253   | _ -> failwith "not possible"
 254
 255 (* neutral for context; used for mcode in bef aft nodes that don't represent
 256 anything if they don't contain some information *)
 257 let nc_mcode (_,_,info,mcodekind,pos,_) =
 258   (* distinguish from the offset of some real token *)
 259   let offset = (-1) * info.Ast0.pos_info.Ast0.offset in
 260   match mcodekind with
 261     Ast0.MINUS(_) -> Token(AllMarked Ast.ONE,offset,mcodekind,[])
 262   | Ast0.PLUS c -> Token(AllMarked c,offset,mcodekind,[])
 263   | Ast0.CONTEXT(_) ->
 264       (* Unlike the other mcode cases, we drop the offset from the context
 265          offsets.  This is because we don't know whether the term this is
 266          associated with is - or context.  In any case, the context offsets are
 267          used for identification, and this invisible node should not be needed
 268          for this purpose. *)
 269       Token(Neutral,offset,mcodekind,[])
 270   | _ -> failwith "not possible"
 271
 272 let is_context = function Ast0.CONTEXT(_) -> true | _ -> false
 273
 274 let union_all l = List.fold_left Common.union_set [] l
 275
 276 (* is minus is true when we are processing minus code that might be
 277 intermingled with plus code.  it is used in disj_cases *)
 278 let classify is_minus all_marked table code =
 279   let mkres builder k il tl bil btl l e =
 280     (match k with
 281       AllMarked count ->
 282         Ast0.set_mcodekind e (all_marked count) (* definitive *)
 283     | _ ->
 284       let check_index il tl =
 285         if List.for_all is_context tl
 286         then
 287           (let e1 = builder e in
 288           let index = (get_index e1)@il in
 289           try
 290             let _ = Hashtbl.find table index in
 291             failwith
 292               (Printf.sprintf "line %d: index %s already used\n"
 293                  (Ast0.get_info e).Ast0.pos_info.Ast0.line_start
 294                  (String.concat " " (List.map string_of_int index)))
 295           with Not_found -> Hashtbl.add table index (e1,l)) in
 296       if il = [] then check_index bil btl else check_index il tl);
 297     if il = []
 298     then Recursor(k, bil, btl, union_all l)
 299     else Recursor(k, il, tl, union_all l) in
 300
 301   let compute_result builder e = function
 302       Bind(k,il,tl,bil,btl,l) -> mkres builder k il tl bil btl l e
 303     | Token(k,il,tl,l) -> mkres builder k [il] [tl] [] [] [l] e
 304     | Recursor(k,bil,btl,l) -> mkres builder k [] [] bil btl [l] e in
 305
 306   let make_not_marked = function
 307       Bind(k,il,tl,bil,btl,l) -> Bind(NotAllMarked,il,tl,bil,btl,l)
 308     | Token(k,il,tl,l) -> Token(NotAllMarked,il,tl,l)
 309     | Recursor(k,bil,btl,l) -> Recursor(NotAllMarked,bil,btl,l) in
 310
 311   let do_nothing builder r k e = compute_result builder e (k e) in
 312
 313   let disj_cases disj starter code fn ender =
 314     (* neutral_mcode used so starter and ender don't have an affect on
 315        whether the code is considered all plus/minus, but so that they are
 316        consider in the index list, which is needed to make a disj with
 317        something in one branch and nothing in the other different from code
 318        that just has the something (starter/ender enough, mids not needed
 319        for this).  Cannot agglomerate + code over | boundaries, because two -
 320        cases might have different + code, and don't want to put the + code
 321        together into one unit. *)
 322     let make_not_marked =
 323       if is_minus
 324       then
 325         (let min = Ast0.get_line disj in
 326         let max = Ast0.get_line_end disj in
 327         let (plus_min,plus_max) = find min (min-1) (max+1) in
 328         if max > plus_max then make_not_marked else (function x -> x))
 329       else make_not_marked in
 330     bind (neutral_mcode starter)
 331       (bind (List.fold_right bind
 332                (List.map make_not_marked (List.map fn code))
 333                option_default)
 334          (neutral_mcode ender)) in
 335
 336   (* no whencode in plus tree so have to drop it *)
 337   (* need special cases for dots, nests, and disjs *)
 338   let ident r k e =
 339     compute_result Ast0.ident e
 340       (match Ast0.unwrap e with
 341         Ast0.DisjId(starter,id_list,_,ender) ->
 342           disj_cases e starter id_list r.VT0.combiner_rec_ident ender
 343       | _ -> k e) in
 344
 345   let expression r k e =
 346     compute_result Ast0.expr e
 347       (match Ast0.unwrap e with
 348         Ast0.NestExpr(starter,exp,ender,whencode,multi) ->
 349           k (Ast0.rewrap e (Ast0.NestExpr(starter,exp,ender,None,multi)))
 350       | Ast0.Edots(dots,whencode) ->
 351           k (Ast0.rewrap e (Ast0.Edots(dots,None)))
 352       | Ast0.Ecircles(dots,whencode) ->
 353           k (Ast0.rewrap e (Ast0.Ecircles(dots,None)))
 354       | Ast0.Estars(dots,whencode) ->
 355           k (Ast0.rewrap e (Ast0.Estars(dots,None)))
 356       | Ast0.DisjExpr(starter,expr_list,_,ender) ->
 357           disj_cases e starter expr_list r.VT0.combiner_rec_expression ender
 358       | _ -> k e) in
 359
 360   (* not clear why we have the next two cases, since DisjDecl and
 361   DisjType shouldn't have been constructed yet, as they only come from isos *)
 362   (* actually, DisjDecl now allowed in source struct decls *)
 363   let declaration r k e =
 364     compute_result Ast0.decl e
 365       (match Ast0.unwrap e with
 366         Ast0.DisjDecl(starter,decls,_,ender) ->
 367           disj_cases e starter decls r.VT0.combiner_rec_declaration ender
 368       | Ast0.Ddots(dots,whencode) ->
 369           k (Ast0.rewrap e (Ast0.Ddots(dots,None)))
 370         (* Need special cases for the following so that the type will be
 371            considered as a unit, rather than distributed around the
 372            declared variable.  This needs to be done because of the call to
 373            compute_result, ie the processing of each term should make a
 374            side-effect on the complete term structure as well as collecting
 375            some information about it.  So we have to visit each complete
 376            term structure.  In (all?) other such cases, we visit the terms
 377            using rebuilder, which just visits the subterms, rather than
 378            reordering their components. *)
 379       | Ast0.Init(stg,ty,id,eq,ini,sem) ->
 380           bind (match stg with Some stg -> mcode stg | _ -> option_default)
 381             (bind (r.VT0.combiner_rec_typeC ty)
 382                (bind (r.VT0.combiner_rec_ident id)
 383                   (bind (mcode eq)
 384                      (bind (r.VT0.combiner_rec_initialiser ini) (mcode sem)))))
 385       | Ast0.UnInit(stg,ty,id,sem) ->
 386           bind (match stg with Some stg -> mcode stg | _ -> option_default)
 387             (bind (r.VT0.combiner_rec_typeC ty)
 388                (bind (r.VT0.combiner_rec_ident id) (mcode sem)))
 389       | _ -> k e) in
 390
 391   let param r k e =
 392     compute_result Ast0.param e
 393       (match Ast0.unwrap e with
 394         Ast0.Param(ty,Some id) ->
 395           (* needed for the same reason as in the Init and UnInit cases *)
 396           bind (r.VT0.combiner_rec_typeC ty) (r.VT0.combiner_rec_ident id)
 397       | _ -> k e) in
 398
 399   let typeC r k e =
 400     compute_result Ast0.typeC e
 401       (match Ast0.unwrap e with
 402         Ast0.DisjType(starter,types,_,ender) ->
 403           disj_cases e starter types r.VT0.combiner_rec_typeC ender
 404       | _ -> k e) in
 405
 406   let initialiser r k i =
 407     compute_result Ast0.ini i
 408       (match Ast0.unwrap i with
 409         Ast0.Idots(dots,whencode) ->
 410           k (Ast0.rewrap i (Ast0.Idots(dots,None)))
 411       | _ -> k i) in
 412
 413   let case_line r k e =
 414     compute_result Ast0.case_line e
 415       (match Ast0.unwrap e with
 416         Ast0.DisjCase(starter,case_list,_,ender) ->
 417           disj_cases e starter case_list r.VT0.combiner_rec_case_line ender
 418       | _ -> k e) in
 419
 420   let statement r k s =
 421     compute_result Ast0.stmt s
 422       (match Ast0.unwrap s with
 423         Ast0.Nest(started,stm_dots,ender,whencode,multi) ->
 424           k (Ast0.rewrap s (Ast0.Nest(started,stm_dots,ender,[],multi)))
 425       | Ast0.Dots(dots,whencode) ->
 426           k (Ast0.rewrap s (Ast0.Dots(dots,[])))
 427       | Ast0.Circles(dots,whencode) ->
 428           k (Ast0.rewrap s (Ast0.Circles(dots,[])))
 429       | Ast0.Stars(dots,whencode) ->
 430           k (Ast0.rewrap s (Ast0.Stars(dots,[])))
 431       | Ast0.Disj(starter,statement_dots_list,_,ender) ->
 432           disj_cases s starter statement_dots_list
 433             r.VT0.combiner_rec_statement_dots
 434             ender
 435         (* cases for everything with extra mcode *)
 436       | Ast0.FunDecl((info,bef),_,_,_,_,_,_,_,_)
 437       | Ast0.Decl((info,bef),_) ->
 438           bind (nc_mcode ((),(),info,bef,(),-1)) (k s)
 439       | Ast0.IfThen(_,_,_,_,_,(info,aft))
 440       | Ast0.IfThenElse(_,_,_,_,_,_,_,(info,aft))
 441       | Ast0.Iterator(_,_,_,_,_,(info,aft))
 442       | Ast0.While(_,_,_,_,_,(info,aft))
 443       | Ast0.For(_,_,_,_,_,_,_,_,_,(info,aft)) ->
 444           bind (k s) (nc_mcode ((),(),info,aft,(),-1))
 445       | _ -> k s
 446
 447 ) in
 448
 449   let do_top builder r k e = compute_result builder e (k e) in
 450
 451   let combiner =
 452     V0.flat_combiner bind option_default
 453       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 454       (do_nothing Ast0.dotsExpr) (do_nothing Ast0.dotsInit)
 455       (do_nothing Ast0.dotsParam) (do_nothing Ast0.dotsStmt)
 456       (do_nothing Ast0.dotsDecl) (do_nothing Ast0.dotsCase)
 457       ident expression typeC initialiser param declaration
 458       statement case_line (do_top Ast0.top) in
 459   combiner.VT0.combiner_rec_top_level code
 460
 461 (* --------------------------------------------------------------------- *)
 462 (* Traverse the hash tables and find corresponding context nodes that have
 463 the same context children *)
 464
 465 (* this is just a sanity check - really only need to look at the top-level
 466    structure *)
 467 let equal_mcode (_,_,info1,_,_,_) (_,_,info2,_,_,_) =
 468   info1.Ast0.pos_info.Ast0.offset = info2.Ast0.pos_info.Ast0.offset
 469
 470 let equal_option e1 e2 =
 471   match (e1,e2) with
 472     (Some x, Some y) -> equal_mcode x y
 473   | (None, None) -> true
 474   | _ -> false
 475
 476 let dots fn d1 d2 =
 477   match (Ast0.unwrap d1,Ast0.unwrap d2) with
 478     (Ast0.DOTS(l1),Ast0.DOTS(l2)) -> List.length l1 = List.length l2
 479   | (Ast0.CIRCLES(l1),Ast0.CIRCLES(l2)) -> List.length l1 = List.length l2
 480   | (Ast0.STARS(l1),Ast0.STARS(l2)) -> List.length l1 = List.length l2
 481   | _ -> false
 482
 483 let rec equal_ident i1 i2 =
 484   match (Ast0.unwrap i1,Ast0.unwrap i2) with
 485     (Ast0.Id(name1),Ast0.Id(name2)) -> equal_mcode name1 name2
 486   | (Ast0.MetaId(name1,_,_,_),Ast0.MetaId(name2,_,_,_)) ->
 487       equal_mcode name1 name2
 488   | (Ast0.MetaFunc(name1,_,_),Ast0.MetaFunc(name2,_,_)) ->
 489       equal_mcode name1 name2
 490   | (Ast0.MetaLocalFunc(name1,_,_),Ast0.MetaLocalFunc(name2,_,_)) ->
 491       equal_mcode name1 name2
 492   | (Ast0.DisjId(starter1,_,mids1,ender1),
 493      Ast0.DisjId(starter2,_,mids2,ender2)) ->
 494       equal_mcode starter1 starter2 &&
 495       List.for_all2 equal_mcode mids1 mids2 &&
 496       equal_mcode ender1 ender2
 497   | (Ast0.OptIdent(_),Ast0.OptIdent(_)) -> true
 498   | (Ast0.UniqueIdent(_),Ast0.UniqueIdent(_)) -> true
 499   | _ -> false
 500
 501 let rec equal_expression e1 e2 =
 502   match (Ast0.unwrap e1,Ast0.unwrap e2) with
 503     (Ast0.Ident(_),Ast0.Ident(_)) -> true
 504   | (Ast0.Constant(const1),Ast0.Constant(const2)) -> equal_mcode const1 const2
 505   | (Ast0.FunCall(_,lp1,_,rp1),Ast0.FunCall(_,lp2,_,rp2)) ->
 506       equal_mcode lp1 lp2 && equal_mcode rp1 rp2
 507   | (Ast0.Assignment(_,op1,_,_),Ast0.Assignment(_,op2,_,_)) ->
 508       equal_mcode op1 op2
 509   | (Ast0.Sequence(_,op1,_),Ast0.Sequence(_,op2,_)) ->
 510       equal_mcode op1 op2
 511   | (Ast0.CondExpr(_,why1,_,colon1,_),Ast0.CondExpr(_,why2,_,colon2,_)) ->
 512       equal_mcode why1 why2 && equal_mcode colon1 colon2
 513   | (Ast0.Postfix(_,op1),Ast0.Postfix(_,op2)) -> equal_mcode op1 op2
 514   | (Ast0.Infix(_,op1),Ast0.Infix(_,op2)) -> equal_mcode op1 op2
 515   | (Ast0.Unary(_,op1),Ast0.Unary(_,op2)) -> equal_mcode op1 op2
 516   | (Ast0.Binary(_,op1,_),Ast0.Binary(_,op2,_)) -> equal_mcode op1 op2
 517   | (Ast0.Paren(lp1,_,rp1),Ast0.Paren(lp2,_,rp2)) ->
 518       equal_mcode lp1 lp2 && equal_mcode rp1 rp2
 519   | (Ast0.ArrayAccess(_,lb1,_,rb1),Ast0.ArrayAccess(_,lb2,_,rb2)) ->
 520       equal_mcode lb1 lb2 && equal_mcode rb1 rb2
 521   | (Ast0.RecordAccess(_,pt1,_),Ast0.RecordAccess(_,pt2,_)) ->
 522       equal_mcode pt1 pt2
 523   | (Ast0.RecordPtAccess(_,ar1,_),Ast0.RecordPtAccess(_,ar2,_)) ->
 524       equal_mcode ar1 ar2
 525   | (Ast0.Cast(lp1,_,rp1,_),Ast0.Cast(lp2,_,rp2,_)) ->
 526       equal_mcode lp1 lp2 && equal_mcode rp1 rp2
 527   | (Ast0.SizeOfExpr(szf1,_),Ast0.SizeOfExpr(szf2,_)) ->
 528       equal_mcode szf1 szf2
 529   | (Ast0.SizeOfType(szf1,lp1,_,rp1),Ast0.SizeOfType(szf2,lp2,_,rp2)) ->
 530       equal_mcode szf1 szf2 && equal_mcode lp1 lp2 && equal_mcode rp1 rp2
 531   | (Ast0.TypeExp(_),Ast0.TypeExp(_)) -> true
 532   | (Ast0.Constructor(lp1,_,rp1,_),Ast0.Constructor(lp2,_,rp2,_)) ->
 533       equal_mcode lp1 lp2 && equal_mcode rp1 rp2
 534   | (Ast0.MetaErr(name1,_,_),Ast0.MetaErr(name2,_,_))
 535   | (Ast0.MetaExpr(name1,_,_,_,_),Ast0.MetaExpr(name2,_,_,_,_))
 536   | (Ast0.MetaExprList(name1,_,_),Ast0.MetaExprList(name2,_,_)) ->
 537       equal_mcode name1 name2
 538   | (Ast0.EComma(cm1),Ast0.EComma(cm2)) -> equal_mcode cm1 cm2
 539   | (Ast0.DisjExpr(starter1,_,mids1,ender1),
 540      Ast0.DisjExpr(starter2,_,mids2,ender2)) ->
 541        equal_mcode starter1 starter2 &&
 542        List.for_all2 equal_mcode mids1 mids2 &&
 543        equal_mcode ender1 ender2
 544   | (Ast0.NestExpr(starter1,_,ender1,_,m1),
 545      Ast0.NestExpr(starter2,_,ender2,_,m2)) ->
 546       equal_mcode starter1 starter2 && equal_mcode ender1 ender2 && m1 = m2
 547   | (Ast0.Edots(dots1,_),Ast0.Edots(dots2,_))
 548   | (Ast0.Ecircles(dots1,_),Ast0.Ecircles(dots2,_))
 549   | (Ast0.Estars(dots1,_),Ast0.Estars(dots2,_)) -> equal_mcode dots1 dots2
 550   | (Ast0.OptExp(_),Ast0.OptExp(_)) -> true
 551   | (Ast0.UniqueExp(_),Ast0.UniqueExp(_)) -> true
 552   | _ -> false
 553
 554 let rec equal_typeC t1 t2 =
 555   match (Ast0.unwrap t1,Ast0.unwrap t2) with
 556     (Ast0.ConstVol(cv1,_),Ast0.ConstVol(cv2,_)) -> equal_mcode cv1 cv2
 557   | (Ast0.BaseType(ty1,stringsa),Ast0.BaseType(ty2,stringsb)) ->
 558       List.for_all2 equal_mcode stringsa stringsb
 559   | (Ast0.Signed(sign1,_),Ast0.Signed(sign2,_)) ->
 560       equal_mcode sign1 sign2
 561   | (Ast0.Pointer(_,star1),Ast0.Pointer(_,star2)) ->
 562       equal_mcode star1 star2
 563   | (Ast0.Array(_,lb1,_,rb1),Ast0.Array(_,lb2,_,rb2)) ->
 564       equal_mcode lb1 lb2 && equal_mcode rb1 rb2
 565   | (Ast0.EnumName(kind1,_),Ast0.EnumName(kind2,_)) ->
 566       equal_mcode kind1 kind2
 567   | (Ast0.EnumDef(_,lb1,_,rb1),Ast0.EnumDef(_,lb2,_,rb2)) ->
 568        equal_mcode lb1 lb2 && equal_mcode rb1 rb2
 569   | (Ast0.StructUnionName(kind1,_),Ast0.StructUnionName(kind2,_)) ->
 570       equal_mcode kind1 kind2
 571   | (Ast0.FunctionType(ty1,lp1,p1,rp1),Ast0.FunctionType(ty2,lp2,p2,rp2)) ->
 572       equal_mcode lp1 lp2 && equal_mcode rp1 rp2
 573   | (Ast0.StructUnionDef(_,lb1,_,rb1),
 574      Ast0.StructUnionDef(_,lb2,_,rb2)) ->
 575        equal_mcode lb1 lb2 && equal_mcode rb1 rb2
 576   | (Ast0.TypeName(name1),Ast0.TypeName(name2)) -> equal_mcode name1 name2
 577   | (Ast0.MetaType(name1,_),Ast0.MetaType(name2,_)) ->
 578       equal_mcode name1 name2
 579   | (Ast0.DisjType(starter1,_,mids1,ender1),
 580      Ast0.DisjType(starter2,_,mids2,ender2)) ->
 581        equal_mcode starter1 starter2 &&
 582        List.for_all2 equal_mcode mids1 mids2 &&
 583        equal_mcode ender1 ender2
 584   | (Ast0.OptType(_),Ast0.OptType(_)) -> true
 585   | (Ast0.UniqueType(_),Ast0.UniqueType(_)) -> true
 586   | _ -> false
 587
 588 let equal_declaration d1 d2 =
 589   match (Ast0.unwrap d1,Ast0.unwrap d2) with
 590     (Ast0.MetaDecl(name1,_),Ast0.MetaDecl(name2,_))
 591   | (Ast0.MetaField(name1,_),Ast0.MetaField(name2,_))
 592   | (Ast0.MetaFieldList(name1,_,_),Ast0.MetaFieldList(name2,_,_)) ->
 593       equal_mcode name1 name2
 594   | (Ast0.Init(stg1,_,_,eq1,_,sem1),Ast0.Init(stg2,_,_,eq2,_,sem2)) ->
 595       equal_option stg1 stg2 && equal_mcode eq1 eq2 && equal_mcode sem1 sem2
 596   | (Ast0.UnInit(stg1,_,_,sem1),Ast0.UnInit(stg2,_,_,sem2)) ->
 597       equal_option stg1 stg2 && equal_mcode sem1 sem2
 598   | (Ast0.MacroDecl(nm1,lp1,_,rp1,sem1),Ast0.MacroDecl(nm2,lp2,_,rp2,sem2))->
 599       equal_mcode lp1 lp2 && equal_mcode rp1 rp2 && equal_mcode sem1 sem2
 600   | (Ast0.MacroDeclInit(nm1,lp1,_,rp1,eq1,_,sem1),
 601      Ast0.MacroDeclInit(nm2,lp2,_,rp2,eq2,_,sem2))->
 602       equal_mcode lp1 lp2 && equal_mcode rp1 rp2 && equal_mcode eq1 eq2
 603          && equal_mcode sem1 sem2
 604   | (Ast0.TyDecl(_,sem1),Ast0.TyDecl(_,sem2)) -> equal_mcode sem1 sem2
 605   | (Ast0.Ddots(dots1,_),Ast0.Ddots(dots2,_)) -> equal_mcode dots1 dots2
 606   | (Ast0.OptDecl(_),Ast0.OptDecl(_)) -> true
 607   | (Ast0.UniqueDecl(_),Ast0.UniqueDecl(_)) -> true
 608   | (Ast0.DisjDecl(starter1,_,mids1,ender1),
 609      Ast0.DisjDecl(starter2,_,mids2,ender2)) ->
 610        equal_mcode starter1 starter2 &&
 611        List.for_all2 equal_mcode mids1 mids2 &&
 612        equal_mcode ender1 ender2
 613   | _ -> false
 614
 615 let equal_designator d1 d2 =
 616   match (d1,d2) with
 617     (Ast0.DesignatorField(dot1,_),Ast0.DesignatorField(dot2,_)) ->
 618       equal_mcode dot1 dot2
 619   | (Ast0.DesignatorIndex(lb1,_,rb1),Ast0.DesignatorIndex(lb2,_,rb2)) ->
 620       (equal_mcode lb1 lb2) && (equal_mcode rb1 rb2)
 621   | (Ast0.DesignatorRange(lb1,_,dots1,_,rb1),
 622      Ast0.DesignatorRange(lb2,_,dots2,_,rb2)) ->
 623        (equal_mcode lb1 lb2) && (equal_mcode dots1 dots2) &&
 624        (equal_mcode rb1 rb2)
 625   | _ -> false
 626
 627 let equal_initialiser i1 i2 =
 628   match (Ast0.unwrap i1,Ast0.unwrap i2) with
 629     (Ast0.MetaInit(name1,_),Ast0.MetaInit(name2,_)) ->
 630       equal_mcode name1 name2
 631   | (Ast0.MetaInitList(name1,_,_),Ast0.MetaInitList(name2,_,_)) ->
 632       equal_mcode name1 name2
 633   | (Ast0.InitExpr(_),Ast0.InitExpr(_)) -> true
 634   | (Ast0.InitList(lb1,_,rb1,o1),Ast0.InitList(lb2,_,rb2,o2)) ->
 635       (* can't compare orderedness, because this can differ between -
 636          and + code *)
 637       (equal_mcode lb1 lb2) && (equal_mcode rb1 rb2)
 638   | (Ast0.InitGccExt(designators1,eq1,_),
 639      Ast0.InitGccExt(designators2,eq2,_)) ->
 640        (List.for_all2 equal_designator designators1 designators2) &&
 641        (equal_mcode eq1 eq2)
 642   | (Ast0.InitGccName(_,eq1,_),Ast0.InitGccName(_,eq2,_)) ->
 643       equal_mcode eq1 eq2
 644   | (Ast0.IComma(cm1),Ast0.IComma(cm2)) -> equal_mcode cm1 cm2
 645   | (Ast0.Idots(d1,_),Ast0.Idots(d2,_)) -> equal_mcode d1 d2
 646   | (Ast0.OptIni(_),Ast0.OptIni(_)) -> true
 647   | (Ast0.UniqueIni(_),Ast0.UniqueIni(_)) -> true
 648   | _ -> false
 649
 650 let equal_parameterTypeDef p1 p2 =
 651   match (Ast0.unwrap p1,Ast0.unwrap p2) with
 652     (Ast0.VoidParam(_),Ast0.VoidParam(_)) -> true
 653   | (Ast0.Param(_,_),Ast0.Param(_,_)) -> true
 654   | (Ast0.MetaParam(name1,_),Ast0.MetaParam(name2,_))
 655   | (Ast0.MetaParamList(name1,_,_),Ast0.MetaParamList(name2,_,_)) ->
 656       equal_mcode name1 name2
 657   | (Ast0.PComma(cm1),Ast0.PComma(cm2)) -> equal_mcode cm1 cm2
 658   | (Ast0.Pdots(dots1),Ast0.Pdots(dots2))
 659   | (Ast0.Pcircles(dots1),Ast0.Pcircles(dots2)) -> equal_mcode dots1 dots2
 660   | (Ast0.OptParam(_),Ast0.OptParam(_)) -> true
 661   | (Ast0.UniqueParam(_),Ast0.UniqueParam(_)) -> true
 662   | _ -> false
 663
 664 let rec equal_statement s1 s2 =
 665   match (Ast0.unwrap s1,Ast0.unwrap s2) with
 666     (Ast0.FunDecl(_,fninfo1,_,lp1,_,rp1,lbrace1,_,rbrace1),
 667      Ast0.FunDecl(_,fninfo2,_,lp2,_,rp2,lbrace2,_,rbrace2)) ->
 668        (List.length fninfo1) = (List.length fninfo2) &&
 669        List.for_all2 equal_fninfo fninfo1 fninfo2 &&
 670        equal_mcode lp1 lp2 && equal_mcode rp1 rp2 &&
 671        equal_mcode lbrace1 lbrace2 && equal_mcode rbrace1 rbrace2
 672   | (Ast0.Decl(_,_),Ast0.Decl(_,_)) -> true
 673   | (Ast0.Seq(lbrace1,_,rbrace1),Ast0.Seq(lbrace2,_,rbrace2)) ->
 674       equal_mcode lbrace1 lbrace2 && equal_mcode rbrace1 rbrace2
 675   | (Ast0.ExprStatement(_,sem1),Ast0.ExprStatement(_,sem2)) ->
 676       equal_mcode sem1 sem2
 677   | (Ast0.IfThen(iff1,lp1,_,rp1,_,_),Ast0.IfThen(iff2,lp2,_,rp2,_,_)) ->
 678       equal_mcode iff1 iff2 && equal_mcode lp1 lp2 && equal_mcode rp1 rp2
 679   | (Ast0.IfThenElse(iff1,lp1,_,rp1,_,els1,_,_),
 680      Ast0.IfThenElse(iff2,lp2,_,rp2,_,els2,_,_)) ->
 681        equal_mcode iff1 iff2 &&
 682          equal_mcode lp1 lp2 && equal_mcode rp1 rp2 && equal_mcode els1 els2
 683   | (Ast0.While(whl1,lp1,_,rp1,_,_),Ast0.While(whl2,lp2,_,rp2,_,_)) ->
 684       equal_mcode whl1 whl2 && equal_mcode lp1 lp2 && equal_mcode rp1 rp2
 685   | (Ast0.Do(d1,_,whl1,lp1,_,rp1,sem1),Ast0.Do(d2,_,whl2,lp2,_,rp2,sem2)) ->
 686       equal_mcode whl1 whl2 && equal_mcode d1 d2 &&
 687       equal_mcode lp1 lp2 && equal_mcode rp1 rp2 && equal_mcode sem1 sem2
 688   | (Ast0.For(fr1,lp1,_,sem11,_,sem21,_,rp1,_,_),
 689      Ast0.For(fr2,lp2,_,sem12,_,sem22,_,rp2,_,_)) ->
 690        equal_mcode fr1 fr2 && equal_mcode lp1 lp2 &&
 691        equal_mcode sem11 sem12 && equal_mcode sem21 sem22 &&
 692        equal_mcode rp1 rp2
 693   | (Ast0.Iterator(nm1,lp1,_,rp1,_,_),Ast0.Iterator(nm2,lp2,_,rp2,_,_)) ->
 694       equal_mcode lp1 lp2 && equal_mcode rp1 rp2
 695   | (Ast0.Switch(switch1,lp1,_,rp1,lb1,_,_,rb1),
 696      Ast0.Switch(switch2,lp2,_,rp2,lb2,_,_,rb2)) ->
 697        equal_mcode switch1 switch2 && equal_mcode lp1 lp2 &&
 698        equal_mcode rp1 rp2 && equal_mcode lb1 lb2 &&
 699        equal_mcode rb1 rb2
 700   | (Ast0.Break(br1,sem1),Ast0.Break(br2,sem2)) ->
 701       equal_mcode br1 br2 && equal_mcode sem1 sem2
 702   | (Ast0.Continue(cont1,sem1),Ast0.Continue(cont2,sem2)) ->
 703       equal_mcode cont1 cont2 && equal_mcode sem1 sem2
 704   | (Ast0.Label(_,dd1),Ast0.Label(_,dd2)) ->
 705       equal_mcode dd1 dd2
 706   | (Ast0.Goto(g1,_,sem1),Ast0.Goto(g2,_,sem2)) ->
 707       equal_mcode g1 g2 && equal_mcode sem1 sem2
 708   | (Ast0.Return(ret1,sem1),Ast0.Return(ret2,sem2)) ->
 709       equal_mcode ret1 ret2 && equal_mcode sem1 sem2
 710   | (Ast0.ReturnExpr(ret1,_,sem1),Ast0.ReturnExpr(ret2,_,sem2)) ->
 711       equal_mcode ret1 ret2 && equal_mcode sem1 sem2
 712   | (Ast0.MetaStmt(name1,_),Ast0.MetaStmt(name2,_))
 713   | (Ast0.MetaStmtList(name1,_),Ast0.MetaStmtList(name2,_)) ->
 714       equal_mcode name1 name2
 715   | (Ast0.Disj(starter1,_,mids1,ender1),Ast0.Disj(starter2,_,mids2,ender2)) ->
 716       equal_mcode starter1 starter2 &&
 717       List.for_all2 equal_mcode mids1 mids2 &&
 718       equal_mcode ender1 ender2
 719   | (Ast0.Nest(starter1,_,ender1,_,m1),Ast0.Nest(starter2,_,ender2,_,m2)) ->
 720       equal_mcode starter1 starter2 && equal_mcode ender1 ender2 && m1 = m2
 721   | (Ast0.Exp(_),Ast0.Exp(_)) -> true
 722   | (Ast0.TopExp(_),Ast0.TopExp(_)) -> true
 723   | (Ast0.Ty(_),Ast0.Ty(_)) -> true
 724   | (Ast0.TopInit(_),Ast0.TopInit(_)) -> true
 725   | (Ast0.Dots(d1,_),Ast0.Dots(d2,_))
 726   | (Ast0.Circles(d1,_),Ast0.Circles(d2,_))
 727   | (Ast0.Stars(d1,_),Ast0.Stars(d2,_)) -> equal_mcode d1 d2
 728   | (Ast0.Include(inc1,name1),Ast0.Include(inc2,name2)) ->
 729       equal_mcode inc1 inc2 && equal_mcode name1 name2
 730   | (Ast0.Undef(def1,_),Ast0.Undef(def2,_)) ->
 731       equal_mcode def1 def2
 732   | (Ast0.Define(def1,_,_,_),Ast0.Define(def2,_,_,_)) ->
 733       equal_mcode def1 def2
 734   | (Ast0.OptStm(_),Ast0.OptStm(_)) -> true
 735   | (Ast0.UniqueStm(_),Ast0.UniqueStm(_)) -> true
 736   | _ -> false
 737
 738 and equal_fninfo x y =
 739   match (x,y) with
 740     (Ast0.FStorage(s1),Ast0.FStorage(s2)) -> equal_mcode s1 s2
 741   | (Ast0.FType(_),Ast0.FType(_)) -> true
 742   | (Ast0.FInline(i1),Ast0.FInline(i2)) -> equal_mcode i1 i2
 743   | (Ast0.FAttr(i1),Ast0.FAttr(i2)) -> equal_mcode i1 i2
 744   | _ -> false
 745
 746 let equal_case_line c1 c2 =
 747   match (Ast0.unwrap c1,Ast0.unwrap c2) with
 748     (Ast0.Default(def1,colon1,_),Ast0.Default(def2,colon2,_)) ->
 749       equal_mcode def1 def2 && equal_mcode colon1 colon2
 750   | (Ast0.Case(case1,_,colon1,_),Ast0.Case(case2,_,colon2,_)) ->
 751       equal_mcode case1 case2 && equal_mcode colon1 colon2
 752   | (Ast0.DisjCase(starter1,_,mids1,ender1),
 753      Ast0.DisjCase(starter2,_,mids2,ender2)) ->
 754        equal_mcode starter1 starter2 &&
 755        List.for_all2 equal_mcode mids1 mids2 &&
 756        equal_mcode ender1 ender2
 757   | (Ast0.OptCase(_),Ast0.OptCase(_)) -> true
 758   | _ -> false
 759
 760 let rec equal_top_level t1 t2 =
 761   match (Ast0.unwrap t1,Ast0.unwrap t2) with
 762     (Ast0.NONDECL(_),Ast0.NONDECL(_)) -> true
 763   | (Ast0.FILEINFO(old_file1,new_file1),Ast0.FILEINFO(old_file2,new_file2)) ->
 764       equal_mcode old_file1 old_file2 && equal_mcode new_file1 new_file2
 765   | (Ast0.CODE(_),Ast0.CODE(_)) -> true
 766   | (Ast0.ERRORWORDS(_),Ast0.ERRORWORDS(_)) -> true
 767   | _ -> false
 768
 769 let root_equal e1 e2 =
 770   match (e1,e2) with
 771     (Ast0.DotsExprTag(d1),Ast0.DotsExprTag(d2)) -> dots equal_expression d1 d2
 772   | (Ast0.DotsParamTag(d1),Ast0.DotsParamTag(d2)) ->
 773       dots equal_parameterTypeDef d1 d2
 774   | (Ast0.DotsStmtTag(d1),Ast0.DotsStmtTag(d2)) -> dots equal_statement d1 d2
 775   | (Ast0.DotsDeclTag(d1),Ast0.DotsDeclTag(d2)) -> dots equal_declaration d1 d2
 776   | (Ast0.DotsCaseTag(d1),Ast0.DotsCaseTag(d2)) -> dots equal_case_line d1 d2
 777   | (Ast0.IdentTag(i1),Ast0.IdentTag(i2)) -> equal_ident i1 i2
 778   | (Ast0.ExprTag(e1),Ast0.ExprTag(e2)) -> equal_expression e1 e2
 779   | (Ast0.ArgExprTag(d),_) -> failwith "not possible - iso only"
 780   | (Ast0.TypeCTag(t1),Ast0.TypeCTag(t2)) -> equal_typeC t1 t2
 781   | (Ast0.ParamTag(p1),Ast0.ParamTag(p2)) -> equal_parameterTypeDef p1 p2
 782   | (Ast0.InitTag(d1),Ast0.InitTag(d2)) -> equal_initialiser d1 d2
 783   | (Ast0.DeclTag(d1),Ast0.DeclTag(d2)) -> equal_declaration d1 d2
 784   | (Ast0.StmtTag(s1),Ast0.StmtTag(s2)) -> equal_statement s1 s2
 785   | (Ast0.TopTag(t1),Ast0.TopTag(t2)) -> equal_top_level t1 t2
 786   | (Ast0.IsoWhenTag(_),_) | (_,Ast0.IsoWhenTag(_))
 787   | (Ast0.IsoWhenTTag(_),_) | (_,Ast0.IsoWhenTTag(_))
 788   | (Ast0.IsoWhenFTag(_),_) | (_,Ast0.IsoWhenFTag(_)) ->
 789       failwith "only within iso phase"
 790   | _ -> false
 791
 792 let default_context _ =
 793   Ast0.CONTEXT(ref(Ast.NOTHING,
 794                    Ast0.default_token_info,Ast0.default_token_info))
 795
 796 let traverse minus_table plus_table =
 797   Hashtbl.iter
 798     (function key ->
 799       function (e,l) ->
 800         try
 801           let (plus_e,plus_l) = Hashtbl.find plus_table key in
 802           if root_equal e plus_e &&
 803             List.for_all (function x -> x)
 804               (List.map2 Common.equal_set l plus_l)
 805           then
 806             let i = Ast0.fresh_index() in
 807             (set_index e i; set_index plus_e i;
 808              set_mcodekind e (default_context());
 809              set_mcodekind plus_e (default_context()))
 810         with Not_found -> ())
 811     minus_table
 812
 813 (* --------------------------------------------------------------------- *)
 814 (* contextify the whencode *)
 815
 816 let contextify_all =
 817   let bind x y = () in
 818   let option_default = () in
 819   let mcode x = () in
 820   let do_nothing r k e = Ast0.set_mcodekind e (default_context()); k e in
 821
 822   V0.flat_combiner bind option_default
 823     mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 824     do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
 825     do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
 826     do_nothing do_nothing do_nothing
 827
 828 let contextify_whencode =
 829   let bind x y = () in
 830   let option_default = () in
 831
 832   let expression r k e =
 833     k e;
 834     match Ast0.unwrap e with
 835       Ast0.NestExpr(_,_,_,Some whencode,_)
 836     | Ast0.Edots(_,Some whencode)
 837     | Ast0.Ecircles(_,Some whencode)
 838     | Ast0.Estars(_,Some whencode) ->
 839         contextify_all.VT0.combiner_rec_expression whencode
 840     | _ -> () in
 841
 842   let initialiser r k i =
 843     match Ast0.unwrap i with
 844       Ast0.Idots(dots,Some whencode) ->
 845         contextify_all.VT0.combiner_rec_initialiser whencode
 846     | _ -> k i in
 847
 848   let whencode = function
 849       Ast0.WhenNot sd -> contextify_all.VT0.combiner_rec_statement_dots sd
 850     | Ast0.WhenAlways s -> contextify_all.VT0.combiner_rec_statement s
 851     | Ast0.WhenModifier(_) -> ()
 852     | Ast0.WhenNotTrue(e) -> contextify_all.VT0.combiner_rec_expression e
 853     | Ast0.WhenNotFalse(e) -> contextify_all.VT0.combiner_rec_expression e in
 854
 855   let statement r k (s : Ast0.statement) =
 856     k s;
 857     match Ast0.unwrap s with
 858       Ast0.Nest(_,_,_,whn,_)
 859     | Ast0.Dots(_,whn) | Ast0.Circles(_,whn) | Ast0.Stars(_,whn) ->
 860         List.iter whencode whn
 861     | _ -> () in
 862
 863   let combiner =
 864     V0.combiner bind option_default
 865       {V0.combiner_functions with
 866         VT0.combiner_exprfn = expression;
 867         VT0.combiner_initfn = initialiser;
 868         VT0.combiner_stmtfn = statement} in
 869   combiner.VT0.combiner_rec_top_level
 870
 871 (* --------------------------------------------------------------------- *)
 872
 873 (* the first int list is the tokens in the node, the second is the tokens
 874 in the descendents *)
 875 let minus_table =
 876   (Hashtbl.create(50) : (int list, Ast0.anything * int list list) Hashtbl.t)
 877 let plus_table =
 878   (Hashtbl.create(50) : (int list, Ast0.anything * int list list) Hashtbl.t)
 879
 880 let iscode t =
 881   match Ast0.unwrap t with
 882     Ast0.NONDECL(_) -> true
 883   | Ast0.FILEINFO(_) -> true
 884   | Ast0.ERRORWORDS(_) -> false
 885   | Ast0.CODE(_) -> true
 886   | Ast0.TOPCODE(_)
 887   | Ast0.OTHER(_) -> failwith "unexpected top level code"
 888
 889 (* ------------------------------------------------------------------- *)
 890 (* alignment of minus and plus *)
 891
 892 let concat = function
 893     [] -> []
 894   | [s] -> [s]
 895   | l ->
 896       let rec loop = function
 897           [] -> []
 898         | x::rest ->
 899             (match Ast0.unwrap x with
 900               Ast0.NONDECL(s) -> let stms = loop rest in s::stms
 901             | Ast0.CODE(ss) ->
 902                 let stms = loop rest in
 903                 (match Ast0.unwrap ss with
 904                   Ast0.DOTS(d) -> d@stms
 905                 | _ -> failwith "no dots allowed in pure plus code")
 906             | _ -> failwith "plus code is being discarded") in
 907       let res =
 908         Compute_lines.compute_statement_dots_lines false
 909           (Ast0.rewrap (List.hd l) (Ast0.DOTS (loop l))) in
 910       [Ast0.rewrap res (Ast0.CODE res)]
 911
 912 let collect_up_to m plus =
 913   let minfo = Ast0.get_info m in
 914   let mend = minfo.Ast0.pos_info.Ast0.logical_end in
 915   let rec loop = function
 916       [] -> ([],[])
 917     | p::plus ->
 918         let pinfo = Ast0.get_info p in
 919         let pstart = pinfo.Ast0.pos_info.Ast0.logical_start in
 920         if pstart > mend
 921         then ([],p::plus)
 922         else let (plus,rest) = loop plus in (p::plus,rest) in
 923   let (plus,rest) = loop plus in
 924   (concat plus,rest)
 925
 926 let realign minus plus =
 927   let rec loop = function
 928       ([],_) -> failwith "not possible, some context required"
 929     | ([m],p) -> ([m],concat p)
 930     | (m::minus,plus) ->
 931         let (p,plus) = collect_up_to m plus in
 932         let (minus,plus) = loop (minus,plus) in
 933         (m::minus,p@plus) in
 934   loop (minus,plus)
 935
 936 (* ------------------------------------------------------------------- *)
 937 (* check compatible: check that at the top level the minus and plus code is
 938 of the same kind.  Could go further and make the correspondence between the
 939 code between ...s. *)
 940
 941 let isonly f l = match Ast0.undots l with [s] -> f s | _ -> false
 942
 943 let isall f l = List.for_all (isonly f) l
 944
 945 let rec is_exp s =
 946   match Ast0.unwrap s with
 947     Ast0.Exp(e) -> true
 948   | Ast0.Disj(_,stmts,_,_) -> isall is_exp stmts
 949   | _ -> false
 950
 951 let rec is_ty s =
 952   match Ast0.unwrap s with
 953     Ast0.Ty(e) -> true
 954   | Ast0.Disj(_,stmts,_,_) -> isall is_ty stmts
 955   | _ -> false
 956
 957 let rec is_init s =
 958   match Ast0.unwrap s with
 959     Ast0.TopInit(e) -> true
 960   | Ast0.Disj(_,stmts,_,_) -> isall is_init stmts
 961   | _ -> false
 962
 963 let rec is_decl s =
 964   match Ast0.unwrap s with
 965     Ast0.Decl(_,e) -> true
 966   | Ast0.FunDecl(_,_,_,_,_,_,_,_,_) -> true
 967   | Ast0.Disj(_,stmts,_,_) -> isall is_decl stmts
 968   | _ -> false
 969
 970 let rec is_fndecl s =
 971   match Ast0.unwrap s with
 972     Ast0.FunDecl(_,_,_,_,_,_,_,_,_) -> true
 973   | Ast0.Disj(_,stmts,_,_) -> isall is_fndecl stmts
 974   | _ -> false
 975
 976 let rec is_toplevel s =
 977   match Ast0.unwrap s with
 978     Ast0.Decl(_,e) -> true
 979   | Ast0.FunDecl(_,_,_,_,_,_,_,_,_) -> true
 980   | Ast0.Disj(_,stmts,_,_) -> isall is_toplevel stmts
 981   | Ast0.ExprStatement(Some fc,_) ->
 982       (match Ast0.unwrap fc with
 983         Ast0.FunCall(_,_,_,_) -> true
 984       | _ -> false)
 985   | Ast0.Include(_,_) -> true
 986   | Ast0.Undef(_,_) -> true
 987   | Ast0.Define(_,_,_,_) -> true
 988   | _ -> false
 989
 990 (* consider code and topcode to be the same; difference handled
 991 in top_level.ml *)
 992 let check_compatible m p =
 993   let fail _ =
 994     failwith
 995       (Printf.sprintf
 996          "incompatible minus and plus code starting on lines %d and %d"
 997          (Ast0.get_line m) (Ast0.get_line p)) in
 998   match (Ast0.unwrap m, Ast0.unwrap p) with
 999     (Ast0.NONDECL(decl1),Ast0.NONDECL(decl2)) ->
1000       if not (is_decl decl1 && is_decl decl2)
1001       then fail()
1002   | (Ast0.NONDECL(decl1),Ast0.CODE(code2)) ->
1003       (* This is probably the only important case.  We don't want to
1004          replace top-level declarations by arbitrary code. *)
1005       let v1 = is_decl decl1 in
1006       let v2 = List.for_all is_toplevel (Ast0.undots code2) in
1007       if !Flag.make_hrule = None && v1 && not v2
1008       then fail()
1009   | (Ast0.CODE(code1),Ast0.NONDECL(decl2)) ->
1010       let v1 = List.for_all is_toplevel (Ast0.undots code1) in
1011       let v2 = is_decl decl2 in
1012       if v1 && not v2
1013       then fail()
1014   | (Ast0.CODE(code1),Ast0.CODE(code2)) ->
1015       let v1 = isonly is_init code1 in
1016       let v2a = isonly is_init code2 in
1017       let v2b = isonly is_exp code2 in
1018       if v1
1019       then (if not (v2a || v2b) then fail())
1020       else
1021         let testers = [is_exp;is_ty] in
1022         List.iter
1023           (function tester ->
1024             let v1 = isonly tester code1 in
1025             let v2 = isonly tester code2 in
1026             if (v1 && not v2) or (!Flag.make_hrule = None && v2 && not v1)
1027             then fail())
1028           testers;
1029         let v1 = isonly is_fndecl code1 in
1030         let v2 = List.for_all is_toplevel (Ast0.undots code2) in
1031         if !Flag.make_hrule = None && v1 && not v2
1032         then fail()
1033   | (Ast0.FILEINFO(_,_),Ast0.FILEINFO(_,_)) -> ()
1034   | (Ast0.OTHER(_),Ast0.OTHER(_)) -> ()
1035   | _ -> fail()
1036
1037 (* ------------------------------------------------------------------- *)
1038
1039 (* returns a list of corresponding minus and plus trees *)
1040 let context_neg minus plus =
1041   Hashtbl.clear minus_table;
1042   Hashtbl.clear plus_table;
1043   List.iter contextify_whencode minus;
1044   let (minus,plus) = realign minus plus in
1045   let rec loop = function
1046       ([],[]) -> []
1047     | ([],l) ->
1048         failwith (Printf.sprintf "%d plus things remaining" (List.length l))
1049     | (minus,[]) ->
1050         plus_lines := [];
1051         let _ =
1052           List.map
1053             (function m ->
1054               classify true
1055                 (function _ ->
1056                   Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info)))
1057                 minus_table m)
1058             minus in
1059         []
1060     | (((m::minus) as mall),((p::plus) as pall)) ->
1061         let minfo = Ast0.get_info m in
1062         let pinfo = Ast0.get_info p in
1063         let mstart = minfo.Ast0.pos_info.Ast0.logical_start in
1064         let mend = minfo.Ast0.pos_info.Ast0.logical_end in
1065         let pstart = pinfo.Ast0.pos_info.Ast0.logical_start in
1066         let pend = pinfo.Ast0.pos_info.Ast0.logical_end in
1067         if (iscode m or iscode p) &&
1068           (mend + 1 = pstart or pend + 1 = mstart or (* adjacent *)
1069            (mstart <= pstart && mend >= pstart) or
1070            (pstart <= mstart && pend >= mstart)) (* overlapping or nested *)
1071         then
1072           begin
1073             (* ensure that the root of each tree has a unique index,
1074                although it might get overwritten if the node is a context
1075                node *)
1076             let i = Ast0.fresh_index() in
1077             Ast0.set_index m i; Ast0.set_index p i;
1078             check_compatible m p;
1079             collect_plus_lines p;
1080             let _ =
1081               classify true
1082                 (function _ ->
1083                   Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info)))
1084                 minus_table m in
1085             let _ = classify false (function c -> Ast0.PLUS c) plus_table p in
1086             traverse minus_table plus_table;
1087             (m,p)::loop(minus,plus)
1088           end
1089         else
1090           if not(iscode m or iscode p)
1091           then loop(minus,plus)
1092           else
1093             if mstart < pstart
1094             then
1095               begin
1096                 plus_lines := [];
1097                 let _ =
1098                   classify true
1099                     (function _ ->
1100                       Ast0.MINUS(ref(Ast.NOREPLACEMENT,
1101                                      Ast0.default_token_info)))
1102                     minus_table m in
1103                 loop(minus,pall)
1104               end
1105             else loop(mall,plus) in
1106   loop(minus,plus)