parsing_cocci/unify_ast.ml

   1 (*
   2  * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
   3  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   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 (*
  24  * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
  25  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
  26  * This file is part of Coccinelle.
  27  *
  28  * Coccinelle is free software: you can redistribute it and/or modify
  29  * it under the terms of the GNU General Public License as published by
  30  * the Free Software Foundation, according to version 2 of the License.
  31  *
  32  * Coccinelle is distributed in the hope that it will be useful,
  33  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  34  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  35  * GNU General Public License for more details.
  36  *
  37  * You should have received a copy of the GNU General Public License
  38  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  39  *
  40  * The authors reserve the right to distribute this or future versions of
  41  * Coccinelle under other licenses.
  42  *)
  43
  44
  45 (* --------------------------------------------------------------------- *)
  46 (* Given two patterns, A and B, determine whether B can match any matched
  47 subterms of A.  For simplicity, this doesn't maintain an environment; it
  48 just assume metavariables match.  Thus the result is either NO or MAYBE. *)
  49
  50 module Ast = Ast_cocci
  51 module V = Visitor_ast
  52
  53 (* --------------------------------------------------------------------- *)
  54
  55 type res = NO | MAYBE
  56
  57 let return b = if b then MAYBE else NO
  58
  59 let unify_mcode (x,_,_,_) (y,_,_,_) = x = y
  60
  61 let ret_unify_mcode a b = return (unify_mcode a b)
  62
  63 let unify_option f t1 t2 =
  64   match (t1,t2) with
  65     (Some t1, Some t2) -> f t1 t2
  66   | (None, None) -> return true
  67   | _ -> return false
  68
  69 let unify_true_option f t1 t2 =
  70   match (t1,t2) with
  71     (Some t1, Some t2) -> f t1 t2
  72   | (None, None) -> return true
  73   | _ -> return true
  74
  75 let bool_unify_option f t1 t2 =
  76   match (t1,t2) with
  77     (Some t1, Some t2) -> f t1 t2
  78   | (None, None) -> true
  79   | _ -> false
  80
  81 let conjunct_bindings b1 b2 =
  82   match b1 with NO -> b1 | MAYBE -> b2
  83
  84 let disjunct_bindings b1 b2 =
  85   match b1 with MAYBE -> b1 | NO -> b2
  86
  87 let disjunct_all_bindings = List.fold_left disjunct_bindings NO
  88
  89 (* --------------------------------------------------------------------- *)
  90
  91 (* compute the common prefix.  if in at least one case, this ends with the
  92 end of the pattern or a ..., then return true. *)
  93
  94 let unify_lists fn dfn la lb =
  95   let rec loop = function
  96       ([],_) | (_,[]) -> return true
  97     | (cura::resta,curb::restb) ->
  98         (match fn cura curb with
  99           MAYBE -> loop (resta,restb)
 100         | NO -> if dfn cura or dfn curb then MAYBE else NO) in
 101   loop (la,lb)
 102
 103 let unify_dots fn dfn d1 d2 =
 104   match (Ast.unwrap d1,Ast.unwrap d2) with
 105     (Ast.DOTS(l1),Ast.DOTS(l2))
 106   | (Ast.CIRCLES(l1),Ast.CIRCLES(l2))
 107   | (Ast.STARS(l1),Ast.STARS(l2)) -> unify_lists fn dfn l1 l2
 108   | _ -> return false
 109
 110 let edots e =
 111   match Ast.unwrap e with
 112     Ast.Edots(_,_) | Ast.Ecircles(_,_) | Ast.Estars(_,_) -> true
 113   | _ -> false
 114
 115 let ddots e =
 116   match Ast.unwrap e with
 117     Ast.Ddots(_,_) -> true
 118   | _ -> false
 119
 120 let pdots p =
 121   match Ast.unwrap p with
 122     Ast.Pdots(_) | Ast.Pcircles(_) -> true
 123   | _ -> false
 124
 125 let dpdots e =
 126   match Ast.unwrap e with
 127     Ast.DPdots(_) | Ast.DPcircles(_) -> true
 128   | _ -> false
 129
 130 let sdots s =
 131   match Ast.unwrap s with
 132     Ast.Dots(_,_,_,_) | Ast.Circles(_,_,_,_) | Ast.Stars(_,_,_,_) -> true
 133   | _ -> false
 134
 135 (* --------------------------------------------------------------------- *)
 136 (* Identifier *)
 137
 138 and unify_ident i1 i2 =
 139   match (Ast.unwrap i1,Ast.unwrap i2) with
 140     (Ast.Id(i1),Ast.Id(i2)) -> return (unify_mcode i1 i2)
 141
 142   | (Ast.MetaId(_,_,_,_),_)
 143   | (Ast.MetaFunc(_,_,_,_),_)
 144   | (Ast.MetaLocalFunc(_,_,_,_),_)
 145   | (_,Ast.MetaId(_,_,_,_))
 146   | (_,Ast.MetaFunc(_,_,_,_))
 147   | (_,Ast.MetaLocalFunc(_,_,_,_)) -> return true
 148
 149   | (Ast.OptIdent(_),_)
 150   | (Ast.UniqueIdent(_),_)
 151   | (_,Ast.OptIdent(_))
 152   | (_,Ast.UniqueIdent(_)) -> failwith "unsupported ident"
 153
 154 (* --------------------------------------------------------------------- *)
 155 (* Expression *)
 156
 157 let rec unify_expression e1 e2 =
 158   match (Ast.unwrap e1,Ast.unwrap e2) with
 159     (Ast.Ident(i1),Ast.Ident(i2)) -> unify_ident i1 i2
 160   | (Ast.Constant(c1),Ast.Constant(c2))-> return (unify_mcode c1 c2)
 161   | (Ast.FunCall(f1,lp1,args1,rp1),Ast.FunCall(f2,lp2,args2,rp2)) ->
 162       conjunct_bindings
 163         (unify_expression f1 f2)
 164         (unify_dots unify_expression edots args1 args2)
 165   | (Ast.Assignment(l1,op1,r1,_),Ast.Assignment(l2,op2,r2,_)) ->
 166       if unify_mcode op1 op2
 167       then conjunct_bindings (unify_expression l1 l2) (unify_expression r1 r2)
 168       else return false
 169   | (Ast.CondExpr(tst1,q1,thn1,c1,els1),Ast.CondExpr(tst2,q2,thn2,c2,els2)) ->
 170       conjunct_bindings (unify_expression tst1 tst2)
 171         (conjunct_bindings (unify_option unify_expression thn1 thn2)
 172            (unify_expression els1 els2))
 173   | (Ast.Postfix(e1,op1),Ast.Postfix(e2,op2)) ->
 174       if unify_mcode op1 op2 then unify_expression e1 e2 else return false
 175   | (Ast.Infix(e1,op1),Ast.Infix(e2,op2)) ->
 176       if unify_mcode op1 op2 then unify_expression e1 e2 else return false
 177   | (Ast.Unary(e1,op1),Ast.Unary(e2,op2)) ->
 178       if unify_mcode op1 op2 then unify_expression e1 e2 else return false
 179   | (Ast.Binary(l1,op1,r1),Ast.Binary(l2,op2,r2)) ->
 180       if unify_mcode op1 op2
 181       then conjunct_bindings (unify_expression l1 l2) (unify_expression r1 r2)
 182       else return false
 183   | (Ast.ArrayAccess(ar1,lb1,e1,rb1),Ast.ArrayAccess(ar2,lb2,e2,rb2)) ->
 184       conjunct_bindings (unify_expression ar1 ar2) (unify_expression e1 e2)
 185   | (Ast.RecordAccess(e1,d1,fld1),Ast.RecordAccess(e2,d2,fld2)) ->
 186       conjunct_bindings (unify_expression e1 e2) (unify_ident fld1 fld2)
 187   | (Ast.RecordPtAccess(e1,pt1,fld1),Ast.RecordPtAccess(e2,pt2,fld2)) ->
 188       conjunct_bindings (unify_expression e1 e2) (unify_ident fld1 fld2)
 189   | (Ast.Cast(lp1,ty1,rp1,e1),Ast.Cast(lp2,ty2,rp2,e2)) ->
 190       conjunct_bindings (unify_fullType ty1 ty2) (unify_expression e1 e2)
 191   | (Ast.SizeOfExpr(szf1,e1),Ast.SizeOfExpr(szf2,e2)) ->
 192       unify_expression e1 e2
 193   | (Ast.SizeOfType(szf1,lp1,ty1,rp1),Ast.SizeOfType(szf2,lp2,ty2,rp2)) ->
 194       unify_fullType ty1 ty2
 195   | (Ast.TypeExp(ty1),Ast.TypeExp(ty2)) -> unify_fullType ty1 ty2
 196   | (Ast.Paren(lp1,e1,rp1),Ast.Paren(lp2,e2,rp2)) ->
 197       unify_expression e1 e2
 198
 199   | (Ast.MetaErr(_,_,_,_),_)
 200   | (Ast.MetaExpr(_,_,_,_,_,_),_)
 201   | (Ast.MetaExprList(_,_,_,_),_)
 202   | (_,Ast.MetaErr(_,_,_,_))
 203   | (_,Ast.MetaExpr(_,_,_,_,_,_))
 204   | (_,Ast.MetaExprList(_,_,_,_)) -> return true
 205
 206   | (Ast.EComma(cm1),Ast.EComma(cm2)) -> return true
 207
 208   | (Ast.DisjExpr(e1),_) ->
 209       disjunct_all_bindings (List.map (function x -> unify_expression x e2) e1)
 210   | (_,Ast.DisjExpr(e2)) ->
 211       disjunct_all_bindings (List.map (function x -> unify_expression e1 x) e2)
 212   | (Ast.NestExpr(_,e1,_,_,_),Ast.NestExpr(_,e2,_,_,_)) ->
 213       unify_dots unify_expression edots e1 e2
 214
 215   (* dots can match against anything.  return true to be safe. *)
 216   | (Ast.Edots(_,_),_) | (_,Ast.Edots(_,_))
 217   | (Ast.Ecircles(_,_),_) | (_,Ast.Ecircles(_,_))
 218   | (Ast.Estars(_,_),_) | (_,Ast.Estars(_,_)) -> return true
 219
 220   | (Ast.OptExp(_),_)
 221   | (Ast.UniqueExp(_),_)
 222   | (_,Ast.OptExp(_))
 223   | (_,Ast.UniqueExp(_)) -> failwith "unsupported expression"
 224   | _ -> return false
 225
 226 (* --------------------------------------------------------------------- *)
 227 (* Types *)
 228
 229 and unify_fullType ft1 ft2 =
 230   match (Ast.unwrap ft1,Ast.unwrap ft2) with
 231     (Ast.Type(cv1,ty1),Ast.Type(cv2,ty2)) ->
 232       if bool_unify_option unify_mcode cv1 cv2
 233       then unify_typeC ty1 ty2
 234       else return false
 235   | (Ast.DisjType(ft1),_) ->
 236       disjunct_all_bindings (List.map (function x -> unify_fullType x ft2) ft1)
 237   | (_,Ast.DisjType(ft2)) ->
 238       disjunct_all_bindings (List.map (function x -> unify_fullType ft1 x) ft2)
 239
 240   | (Ast.OptType(_),_)
 241   | (Ast.UniqueType(_),_)
 242   | (_,Ast.OptType(_))
 243   | (_,Ast.UniqueType(_)) -> failwith "unsupported type"
 244
 245 and unify_typeC t1 t2 =
 246   match (Ast.unwrap t1,Ast.unwrap t2) with
 247     (Ast.BaseType(ty1,stringsa),Ast.BaseType(ty2,stringsb)) ->
 248       if ty1 = ty2
 249       then
 250         unify_lists ret_unify_mcode (function _ -> false (* not dots*))
 251           stringsa stringsb
 252       else return false
 253   | (Ast.SignedT(sgn1,ty1),Ast.SignedT(sgn2,ty2)) ->
 254       if unify_mcode sgn1 sgn2
 255       then unify_option unify_typeC ty1 ty2
 256       else return false
 257   | (Ast.Pointer(ty1,s1),Ast.Pointer(ty2,s2)) -> unify_fullType ty1 ty2
 258   | (Ast.FunctionPointer(tya,lp1a,stara,rp1a,lp2a,paramsa,rp2a),
 259      Ast.FunctionPointer(tyb,lp1b,starb,rp1b,lp2b,paramsb,rp2b)) ->
 260        if List.for_all2 unify_mcode
 261            [lp1a;stara;rp1a;lp2a;rp2a] [lp1b;starb;rp1b;lp2b;rp2b]
 262        then
 263          conjunct_bindings (unify_fullType tya tyb)
 264            (unify_dots unify_parameterTypeDef pdots paramsa paramsb)
 265        else return false
 266   | (Ast.FunctionType(_,tya,lp1a,paramsa,rp1a),
 267      Ast.FunctionType(_,tyb,lp1b,paramsb,rp1b)) ->
 268        if List.for_all2 unify_mcode [lp1a;rp1a] [lp1b;rp1b]
 269        then
 270          conjunct_bindings (unify_option unify_fullType tya tyb)
 271            (unify_dots unify_parameterTypeDef pdots paramsa paramsb)
 272        else return false
 273   | (Ast.FunctionType _ , _) -> failwith "not supported"
 274   | (Ast.Array(ty1,lb1,e1,rb1),Ast.Array(ty2,lb2,e2,rb2)) ->
 275       conjunct_bindings
 276         (unify_fullType ty1 ty2) (unify_option unify_expression e1 e2)
 277   | (Ast.EnumName(s1,ts1),Ast.EnumName(s2,ts2)) ->
 278       if unify_mcode s1 s2 then unify_ident ts1 ts2 else return false
 279   | (Ast.StructUnionName(s1,Some ts1),Ast.StructUnionName(s2,Some ts2)) ->
 280       if unify_mcode s1 s2 then unify_ident ts1 ts2 else return false
 281   | (Ast.StructUnionName(s1,None),Ast.StructUnionName(s2,None)) ->
 282       return true
 283   | (Ast.StructUnionDef(ty1,lb1,decls1,rb1),
 284      Ast.StructUnionDef(ty2,lb2,decls2,rb2)) ->
 285        conjunct_bindings (unify_fullType ty1 ty2)
 286          (unify_dots unify_declaration ddots decls1 decls2)
 287   | (Ast.TypeName(t1),Ast.TypeName(t2)) -> return (unify_mcode t1 t2)
 288
 289   | (Ast.MetaType(_,_,_),_)
 290   | (_,Ast.MetaType(_,_,_)) -> return true
 291   | _ -> return false
 292
 293 (* --------------------------------------------------------------------- *)
 294 (* Variable declaration *)
 295 (* Even if the Cocci program specifies a list of declarations, they are
 296    split out into multiple declarations of a single variable each. *)
 297
 298 and unify_declaration d1 d2 =
 299   match (Ast.unwrap d1,Ast.unwrap d2) with
 300     (Ast.Init(stg1,ft1,id1,eq1,i1,s1),Ast.Init(stg2,ft2,id2,eq2,i2,s2)) ->
 301       if bool_unify_option unify_mcode stg1 stg2
 302       then
 303         conjunct_bindings (unify_fullType ft1 ft2)
 304           (conjunct_bindings (unify_ident id1 id2) (unify_initialiser i1 i2))
 305       else return false
 306   | (Ast.UnInit(stg1,ft1,id1,s1),Ast.UnInit(stg2,ft2,id2,s2)) ->
 307       if bool_unify_option unify_mcode stg1 stg2
 308       then conjunct_bindings (unify_fullType ft1 ft2) (unify_ident id1 id2)
 309       else return false
 310   | (Ast.MacroDecl(n1,lp1,args1,rp1,sem1),
 311      Ast.MacroDecl(n2,lp2,args2,rp2,sem2)) ->
 312        conjunct_bindings (unify_ident n1 n2)
 313          (unify_dots unify_expression edots args1 args2)
 314   | (Ast.TyDecl(ft1,s1),Ast.TyDecl(ft2,s2)) -> unify_fullType ft1 ft2
 315   | (Ast.Typedef(stg1,ft1,id1,s1),Ast.Typedef(stg2,ft2,id2,s2)) ->
 316       conjunct_bindings (unify_fullType ft1 ft2) (unify_typeC id1 id2)
 317   | (Ast.DisjDecl(d1),_) ->
 318       disjunct_all_bindings
 319         (List.map (function x -> unify_declaration x d2) d1)
 320   | (_,Ast.DisjDecl(d2)) ->
 321       disjunct_all_bindings
 322         (List.map (function x -> unify_declaration d1 x) d2)
 323   (* dots can match against anything.  return true to be safe. *)
 324   | (Ast.Ddots(_,_),_) | (_,Ast.Ddots(_,_)) -> return true
 325
 326   | (Ast.OptDecl(_),_)
 327   | (Ast.UniqueDecl(_),_)
 328   | (_,Ast.OptDecl(_))
 329   | (_,Ast.UniqueDecl(_)) -> failwith "unsupported decl"
 330   | _ -> return false
 331
 332 (* --------------------------------------------------------------------- *)
 333 (* Initializer *)
 334
 335 and unify_initialiser i1 i2 =
 336   match (Ast.unwrap i1,Ast.unwrap i2) with
 337     (Ast.MetaInit(_,_,_),_) | (_,Ast.MetaInit(_,_,_)) -> return true
 338   | (Ast.InitExpr(expa),Ast.InitExpr(expb)) ->
 339       unify_expression expa expb
 340   | (Ast.InitList(_,initlista,_,whena),
 341      Ast.InitList(_,initlistb,_,whenb)) ->
 342       (* ignore whencode - returns true safely *)
 343       unify_lists unify_initialiser (function _ -> false) initlista initlistb
 344   | (Ast.InitGccExt(designatorsa,_,inia),
 345      Ast.InitGccExt(designatorsb,_,inib)) ->
 346        conjunct_bindings
 347          (unify_lists unify_designator (function _ -> false)
 348             designatorsa designatorsb)
 349          (unify_initialiser inia inib)
 350   | (Ast.InitGccName(namea,_,inia),Ast.InitGccName(nameb,_,inib)) ->
 351       conjunct_bindings (unify_ident namea nameb) (unify_initialiser inia inib)
 352
 353   | (Ast.OptIni(_),_)
 354   | (Ast.UniqueIni(_),_)
 355   | (_,Ast.OptIni(_))
 356   | (_,Ast.UniqueIni(_)) -> failwith "unsupported decl"
 357   | _ -> return false
 358
 359 and unify_designator d1 d2 =
 360   match (d1,d2) with
 361     (Ast.DesignatorField(_,idb),Ast.DesignatorField(_,ida)) ->
 362       unify_ident ida idb
 363   | (Ast.DesignatorIndex(_,expa,_),Ast.DesignatorIndex(_,expb,_)) ->
 364       unify_expression expa expb
 365   | (Ast.DesignatorRange(_,mina,_,maxa,_),
 366      Ast.DesignatorRange(_,minb,_,maxb,_)) ->
 367        conjunct_bindings (unify_expression mina minb)
 368          (unify_expression maxa maxb)
 369   | _ -> return false
 370
 371 (* --------------------------------------------------------------------- *)
 372 (* Parameter *)
 373
 374 and unify_parameterTypeDef p1 p2 =
 375   match (Ast.unwrap p1,Ast.unwrap p2) with
 376     (Ast.VoidParam(ft1),Ast.VoidParam(ft2)) -> unify_fullType ft1 ft2
 377   | (Ast.Param(ft1,i1),Ast.Param(ft2,i2)) ->
 378       conjunct_bindings (unify_fullType ft1 ft2)
 379         (unify_option unify_ident i1 i2)
 380
 381   | (Ast.MetaParam(_,_,_),_)
 382   | (Ast.MetaParamList(_,_,_,_),_)
 383   | (_,Ast.MetaParam(_,_,_))
 384   | (_,Ast.MetaParamList(_,_,_,_)) -> return true
 385
 386   | (Ast.PComma(_),Ast.PComma(_)) -> return true
 387
 388   (* dots can match against anything.  return true to be safe. *)
 389   | (Ast.Pdots(_),_) | (_,Ast.Pdots(_))
 390   | (Ast.Pcircles(_),_) | (_,Ast.Pcircles(_)) -> return true
 391
 392   | (Ast.OptParam(_),_)
 393   | (Ast.UniqueParam(_),_)
 394   | (_,Ast.OptParam(_))
 395   | (_,Ast.UniqueParam(_)) -> failwith "unsupported parameter"
 396   | _ -> return false
 397
 398 (* --------------------------------------------------------------------- *)
 399 (* Define parameter *)
 400
 401 and unify_define_parameters p1 p2 =
 402  match (Ast.unwrap p1,Ast.unwrap p2) with
 403     (Ast.NoParams,Ast.NoParams) -> return true
 404   | (Ast.DParams(lp1,params1,rp1),Ast.DParams(lp2,params2,rp2)) ->
 405       unify_dots unify_define_param dpdots params1 params2
 406   | _ -> return false
 407
 408 and unify_define_param p1 p2 =
 409   match (Ast.unwrap p1,Ast.unwrap p2) with
 410     (Ast.DParam(i1),Ast.DParam(i2)) ->
 411         (unify_ident i1 i2)
 412   | (Ast.DPComma(_),Ast.DPComma(_)) -> return true
 413
 414   (* dots can match against anything.  return true to be safe. *)
 415   | (Ast.DPdots(_),_) | (_,Ast.DPdots(_))
 416   | (Ast.DPcircles(_),_) | (_,Ast.DPcircles(_)) -> return true
 417
 418   | (Ast.OptDParam(_),_)
 419   | (Ast.UniqueDParam(_),_)
 420   | (_,Ast.OptDParam(_))
 421   | (_,Ast.UniqueDParam(_)) -> failwith "unsupported parameter"
 422   | _ -> return false
 423
 424 (* --------------------------------------------------------------------- *)
 425 (* Top-level code *)
 426
 427 and unify_rule_elem re1 re2 =
 428   match (Ast.unwrap re1,Ast.unwrap re2) with
 429     (Ast.FunHeader(_,_,fi1,nm1,lp1,params1,rp1),
 430      Ast.FunHeader(_,_,fi2,nm2,lp2,params2,rp2)) ->
 431        conjunct_bindings (unify_fninfo fi1 fi2)
 432          (conjunct_bindings (unify_ident nm1 nm2)
 433             (unify_dots unify_parameterTypeDef pdots params1 params2))
 434   | (Ast.Decl(_,_,d1),Ast.Decl(_,_,d2)) -> unify_declaration d1 d2
 435
 436   | (Ast.SeqStart(lb1),Ast.SeqStart(lb2)) -> return true
 437   | (Ast.SeqEnd(rb1),Ast.SeqEnd(rb2)) -> return true
 438
 439   | (Ast.ExprStatement(e1,s1),Ast.ExprStatement(e2,s2)) ->
 440       unify_expression e1 e2
 441   | (Ast.IfHeader(if1,lp1,e1,rp1),Ast.IfHeader(if2,lp2,e2,rp2)) ->
 442       unify_expression e1 e2
 443   | (Ast.Else(e1),Ast.Else(e2)) -> return true
 444   | (Ast.WhileHeader(wh1,lp1,e1,rp1),Ast.WhileHeader(wh2,lp2,e2,rp2)) ->
 445       unify_expression e1 e2
 446   | (Ast.DoHeader(d1),Ast.DoHeader(d2)) -> return true
 447   | (Ast.WhileTail(wh1,lp1,e1,rp1,s1),Ast.WhileTail(wh2,lp2,e2,rp2,s2)) ->
 448       unify_expression e1 e2
 449   | (Ast.ForHeader(fr1,lp1,e11,s11,e21,s21,e31,rp1),
 450      Ast.ForHeader(fr2,lp2,e12,s12,e22,s22,e32,rp2)) ->
 451        conjunct_bindings
 452          (unify_option unify_expression e11 e12)
 453          (conjunct_bindings
 454             (unify_option unify_expression e21 e22)
 455             (unify_option unify_expression e31 e32))
 456   | (Ast.IteratorHeader(nm1,lp1,args1,rp1),
 457      Ast.IteratorHeader(nm2,lp2,args2,rp2)) ->
 458       conjunct_bindings (unify_ident nm1 nm2)
 459          (unify_dots unify_expression edots args1 args2)
 460   | (Ast.DefineHeader(_,n1,p1),Ast.DefineHeader(_,n2,p2)) ->
 461       conjunct_bindings (unify_ident n1 n2)
 462         (unify_define_parameters p1 p2)
 463   | (Ast.Break(r1,s1),Ast.Break(r2,s2)) -> return true
 464   | (Ast.Continue(r1,s1),Ast.Continue(r2,s2)) -> return true
 465   | (Ast.Label(l1,dd1),Ast.Label(l2,dd2)) -> unify_ident l1 l2
 466   | (Ast.Goto(g1,l1,dd1),Ast.Goto(g2,l2,dd2)) -> unify_ident l1 l2
 467   | (Ast.Return(r1,s1),Ast.Return(r2,s2)) -> return true
 468   | (Ast.ReturnExpr(r1,e1,s1),Ast.ReturnExpr(r2,e2,s2)) ->
 469       unify_expression e1 e2
 470
 471   | (Ast.DisjRuleElem(res1),_) ->
 472       disjunct_all_bindings
 473         (List.map (function x -> unify_rule_elem x re2) res1)
 474   | (_,Ast.DisjRuleElem(res2)) ->
 475       disjunct_all_bindings
 476         (List.map (function x -> unify_rule_elem re1 x) res2)
 477
 478   | (Ast.MetaRuleElem(_,_,_),_)
 479   | (Ast.MetaStmt(_,_,_,_),_)
 480   | (Ast.MetaStmtList(_,_,_),_)
 481   | (_,Ast.MetaRuleElem(_,_,_))
 482   | (_,Ast.MetaStmt(_,_,_,_))
 483   | (_,Ast.MetaStmtList(_,_,_)) -> return true
 484
 485     (* can match a rule_elem in different parts *)
 486   | (Ast.Exp(e1),Ast.Exp(e2)) -> return true
 487   | (Ast.Exp(e1),_) -> subexp (unify_expression e1) re2
 488   | (_,Ast.Exp(e2)) -> subexp (unify_expression e2) re1
 489
 490   | (Ast.TopExp(e1),Ast.TopExp(e2)) -> unify_expression e1 e2
 491   | (Ast.TopInit(i1),Ast.TopInit(i2)) -> unify_initialiser i1 i2
 492
 493     (* can match a rule_elem in different parts *)
 494   | (Ast.Ty(t1),Ast.Ty(t2)) -> return true
 495   | (Ast.Ty(t1),_) -> subtype (unify_fullType t1) re2
 496   | (_,Ast.Ty(t2)) -> subtype (unify_fullType t2) re1
 497   | _ -> return false
 498
 499 and unify_fninfo patterninfo cinfo =
 500   let patterninfo = List.sort compare patterninfo in
 501   let cinfo = List.sort compare cinfo in
 502   let rec loop = function
 503       (Ast.FStorage(sta)::resta,Ast.FStorage(stb)::restb) ->
 504       if unify_mcode sta stb then loop (resta,restb) else return false
 505     | (Ast.FType(tya)::resta,Ast.FType(tyb)::restb) ->
 506         conjunct_bindings (unify_fullType tya tyb) (loop (resta,restb))
 507     | (Ast.FInline(ia)::resta,Ast.FInline(ib)::restb) ->
 508         if unify_mcode ia ib then loop (resta,restb) else return false
 509     | (Ast.FAttr(ia)::resta,Ast.FAttr(ib)::restb) ->
 510         if unify_mcode ia ib then loop (resta,restb) else return false
 511     | (x::resta,((y::_) as restb)) ->
 512         (match compare x y with
 513           -1 -> return false
 514         | 1 -> loop (resta,restb)
 515         | _ -> failwith "not possible")
 516     | _ -> return false in
 517   loop (patterninfo,cinfo)
 518
 519 and subexp f =
 520   let bind = conjunct_bindings in
 521   let option_default = return false in
 522   let mcode r e = option_default in
 523   let expr r k e = conjunct_bindings (f e) (k e) in
 524   let donothing r k e = k e in
 525   let recursor = V.combiner bind option_default
 526       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 527       donothing donothing donothing donothing
 528       donothing expr donothing donothing donothing donothing donothing
 529       donothing donothing donothing donothing donothing in
 530   recursor.V.combiner_rule_elem
 531
 532 and subtype f =
 533   let bind = conjunct_bindings in
 534   let option_default = return false in
 535   let mcode r e = option_default in
 536   let fullType r k e = conjunct_bindings (f e) (k e) in
 537   let donothing r k e = k e in
 538   let recursor = V.combiner bind option_default
 539       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 540       donothing donothing donothing donothing
 541       donothing donothing fullType donothing donothing donothing donothing
 542       donothing donothing donothing donothing donothing in
 543   recursor.V.combiner_rule_elem
 544
 545 let rec unify_statement s1 s2 =
 546   match (Ast.unwrap s1,Ast.unwrap s2) with
 547     (Ast.Seq(lb1,s1,rb1),Ast.Seq(lb2,s2,rb2)) ->
 548       conjunct_bindings (unify_rule_elem lb1 lb2)
 549         (conjunct_bindings
 550            (unify_dots unify_statement sdots s1 s2)
 551            (unify_rule_elem rb1 rb2))
 552   | (Ast.IfThen(h1,thn1,_),Ast.IfThen(h2,thn2,_)) ->
 553       conjunct_bindings (unify_rule_elem h1 h2) (unify_statement thn1 thn2)
 554   | (Ast.IfThenElse(h1,thn1,e1,els1,_),Ast.IfThenElse(h2,thn2,e2,els2,_)) ->
 555       conjunct_bindings (unify_rule_elem h1 h2)
 556         (conjunct_bindings (unify_statement thn1 thn2)
 557            (conjunct_bindings (unify_rule_elem e1 e2)
 558               (unify_statement els1 els2)))
 559   | (Ast.While(h1,s1,_),Ast.While(h2,s2,_)) ->
 560       conjunct_bindings (unify_rule_elem h1 h2) (unify_statement s1 s2)
 561   | (Ast.Do(h1,s1,t1),Ast.Do(h2,s2,t2)) ->
 562       conjunct_bindings (unify_rule_elem h1 h2)
 563         (conjunct_bindings (unify_statement s1 s2) (unify_rule_elem t1 t2))
 564   | (Ast.For(h1,s1,_),Ast.For(h2,s2,_)) ->
 565       conjunct_bindings (unify_rule_elem h1 h2) (unify_statement s1 s2)
 566   | (Ast.Atomic(re1),Ast.Atomic(re2)) -> unify_rule_elem re1 re2
 567   | (Ast.Disj(s1),_) ->
 568       let s2 = Ast.rewrap s2 (Ast.DOTS[s2]) in
 569       disjunct_all_bindings
 570         (List.map
 571            (function x -> unify_dots unify_statement sdots x s2)
 572            s1)
 573   | (_,Ast.Disj(s2)) ->
 574       let s1 = Ast.rewrap s1 (Ast.DOTS[s1]) in
 575       disjunct_all_bindings
 576         (List.map
 577            (function x -> unify_dots unify_statement sdots s1 x)
 578            s2)
 579   | (Ast.Nest(_,s1,_,_,_,_,_),Ast.Nest(_,s2,_,_,_,_,_)) ->
 580       unify_dots unify_statement sdots s1 s2
 581   | (Ast.FunDecl(h1,lb1,s1,rb1),Ast.FunDecl(h2,lb2,s2,rb2)) ->
 582       conjunct_bindings (unify_rule_elem h1 h2)
 583         (conjunct_bindings (unify_rule_elem lb1 lb2)
 584            (conjunct_bindings (unify_dots unify_statement sdots s1 s2)
 585               (unify_rule_elem rb1 rb2)))
 586   | (Ast.Define(h1,s1),Ast.Define(h2,s2)) ->
 587       conjunct_bindings (unify_rule_elem h1 h2)
 588         (unify_dots unify_statement sdots s1 s2)
 589   (* dots can match against anything.  return true to be safe. *)
 590   | (Ast.Dots(_,_,_,_),_) | (_,Ast.Dots(_,_,_,_))
 591   | (Ast.Circles(_,_,_,_),_) | (_,Ast.Circles(_,_,_,_))
 592   | (Ast.Stars(_,_,_,_),_) | (_,Ast.Stars(_,_,_,_)) -> return true
 593   | (Ast.OptStm(_),_)
 594   | (Ast.UniqueStm(_),_)
 595   | (_,Ast.OptStm(_))
 596   | (_,Ast.UniqueStm(_)) -> failwith "unsupported statement"
 597   | _ -> return false
 598
 599 let unify_statement_dots = unify_dots unify_statement sdots