parsing_cocci/.#unify_ast.ml.1.75

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