parsing_cocci/unify_ast.ml

   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.MetaInit(_,_,_),_) | (_,Ast.MetaInit(_,_,_)) -> return true
 316   | (Ast.InitExpr(expa),Ast.InitExpr(expb)) ->
 317       unify_expression expa expb
 318   | (Ast.InitList(_,initlista,_,whena),
 319      Ast.InitList(_,initlistb,_,whenb)) ->
 320       (* ignore whencode - returns true safely *)
 321       unify_lists unify_initialiser (function _ -> false) initlista initlistb
 322   | (Ast.InitGccExt(designatorsa,_,inia),
 323      Ast.InitGccExt(designatorsb,_,inib)) ->
 324        conjunct_bindings
 325          (unify_lists unify_designator (function _ -> false)
 326             designatorsa designatorsb)
 327          (unify_initialiser inia inib)
 328   | (Ast.InitGccName(namea,_,inia),Ast.InitGccName(nameb,_,inib)) ->
 329       conjunct_bindings (unify_ident namea nameb) (unify_initialiser inia inib)
 330
 331   | (Ast.OptIni(_),_)
 332   | (Ast.UniqueIni(_),_)
 333   | (_,Ast.OptIni(_))
 334   | (_,Ast.UniqueIni(_)) -> failwith "unsupported decl"
 335   | _ -> return false
 336
 337 and unify_designator d1 d2 =
 338   match (d1,d2) with
 339     (Ast.DesignatorField(_,idb),Ast.DesignatorField(_,ida)) ->
 340       unify_ident ida idb
 341   | (Ast.DesignatorIndex(_,expa,_),Ast.DesignatorIndex(_,expb,_)) ->
 342       unify_expression expa expb
 343   | (Ast.DesignatorRange(_,mina,_,maxa,_),
 344      Ast.DesignatorRange(_,minb,_,maxb,_)) ->
 345        conjunct_bindings (unify_expression mina minb)
 346          (unify_expression maxa maxb)
 347   | _ -> return false
 348
 349 (* --------------------------------------------------------------------- *)
 350 (* Parameter *)
 351
 352 and unify_parameterTypeDef p1 p2 =
 353   match (Ast.unwrap p1,Ast.unwrap p2) with
 354     (Ast.VoidParam(ft1),Ast.VoidParam(ft2)) -> unify_fullType ft1 ft2
 355   | (Ast.Param(ft1,i1),Ast.Param(ft2,i2)) ->
 356       conjunct_bindings (unify_fullType ft1 ft2)
 357         (unify_option unify_ident i1 i2)
 358
 359   | (Ast.MetaParam(_,_,_),_)
 360   | (Ast.MetaParamList(_,_,_,_),_)
 361   | (_,Ast.MetaParam(_,_,_))
 362   | (_,Ast.MetaParamList(_,_,_,_)) -> return true
 363
 364   | (Ast.PComma(_),Ast.PComma(_)) -> return true
 365
 366   (* dots can match against anything.  return true to be safe. *)
 367   | (Ast.Pdots(_),_) | (_,Ast.Pdots(_))
 368   | (Ast.Pcircles(_),_) | (_,Ast.Pcircles(_)) -> return true
 369
 370   | (Ast.OptParam(_),_)
 371   | (Ast.UniqueParam(_),_)
 372   | (_,Ast.OptParam(_))
 373   | (_,Ast.UniqueParam(_)) -> failwith "unsupported parameter"
 374   | _ -> return false
 375
 376 (* --------------------------------------------------------------------- *)
 377 (* Define parameter *)
 378
 379 and unify_define_parameters p1 p2 =
 380  match (Ast.unwrap p1,Ast.unwrap p2) with
 381     (Ast.NoParams,Ast.NoParams) -> return true
 382   | (Ast.DParams(lp1,params1,rp1),Ast.DParams(lp2,params2,rp2)) ->
 383       unify_dots unify_define_param dpdots params1 params2
 384   | _ -> return false
 385
 386 and unify_define_param p1 p2 =
 387   match (Ast.unwrap p1,Ast.unwrap p2) with
 388     (Ast.DParam(i1),Ast.DParam(i2)) ->
 389         (unify_ident i1 i2)
 390   | (Ast.DPComma(_),Ast.DPComma(_)) -> return true
 391
 392   (* dots can match against anything.  return true to be safe. *)
 393   | (Ast.DPdots(_),_) | (_,Ast.DPdots(_))
 394   | (Ast.DPcircles(_),_) | (_,Ast.DPcircles(_)) -> return true
 395
 396   | (Ast.OptDParam(_),_)
 397   | (Ast.UniqueDParam(_),_)
 398   | (_,Ast.OptDParam(_))
 399   | (_,Ast.UniqueDParam(_)) -> failwith "unsupported parameter"
 400   | _ -> return false
 401
 402 (* --------------------------------------------------------------------- *)
 403 (* Top-level code *)
 404
 405 and unify_rule_elem re1 re2 =
 406   match (Ast.unwrap re1,Ast.unwrap re2) with
 407     (Ast.FunHeader(_,_,fi1,nm1,lp1,params1,rp1),
 408      Ast.FunHeader(_,_,fi2,nm2,lp2,params2,rp2)) ->
 409        conjunct_bindings (unify_fninfo fi1 fi2)
 410          (conjunct_bindings (unify_ident nm1 nm2)
 411             (unify_dots unify_parameterTypeDef pdots params1 params2))
 412   | (Ast.Decl(_,_,d1),Ast.Decl(_,_,d2)) -> unify_declaration d1 d2
 413
 414   | (Ast.SeqStart(lb1),Ast.SeqStart(lb2)) -> return true
 415   | (Ast.SeqEnd(rb1),Ast.SeqEnd(rb2)) -> return true
 416
 417   | (Ast.ExprStatement(e1,s1),Ast.ExprStatement(e2,s2)) ->
 418       unify_expression e1 e2
 419   | (Ast.IfHeader(if1,lp1,e1,rp1),Ast.IfHeader(if2,lp2,e2,rp2)) ->
 420       unify_expression e1 e2
 421   | (Ast.Else(e1),Ast.Else(e2)) -> return true
 422   | (Ast.WhileHeader(wh1,lp1,e1,rp1),Ast.WhileHeader(wh2,lp2,e2,rp2)) ->
 423       unify_expression e1 e2
 424   | (Ast.DoHeader(d1),Ast.DoHeader(d2)) -> return true
 425   | (Ast.WhileTail(wh1,lp1,e1,rp1,s1),Ast.WhileTail(wh2,lp2,e2,rp2,s2)) ->
 426       unify_expression e1 e2
 427   | (Ast.ForHeader(fr1,lp1,e11,s11,e21,s21,e31,rp1),
 428      Ast.ForHeader(fr2,lp2,e12,s12,e22,s22,e32,rp2)) ->
 429        conjunct_bindings
 430          (unify_option unify_expression e11 e12)
 431          (conjunct_bindings
 432             (unify_option unify_expression e21 e22)
 433             (unify_option unify_expression e31 e32))
 434   | (Ast.IteratorHeader(nm1,lp1,args1,rp1),
 435      Ast.IteratorHeader(nm2,lp2,args2,rp2)) ->
 436       conjunct_bindings (unify_ident nm1 nm2)
 437          (unify_dots unify_expression edots args1 args2)
 438   | (Ast.DefineHeader(_,n1,p1),Ast.DefineHeader(_,n2,p2)) ->
 439       conjunct_bindings (unify_ident n1 n2)
 440         (unify_define_parameters p1 p2)
 441   | (Ast.Break(r1,s1),Ast.Break(r2,s2)) -> return true
 442   | (Ast.Continue(r1,s1),Ast.Continue(r2,s2)) -> return true
 443   | (Ast.Label(l1,dd1),Ast.Label(l2,dd2)) -> unify_ident l1 l2
 444   | (Ast.Goto(g1,l1,dd1),Ast.Goto(g2,l2,dd2)) -> unify_ident l1 l2
 445   | (Ast.Return(r1,s1),Ast.Return(r2,s2)) -> return true
 446   | (Ast.ReturnExpr(r1,e1,s1),Ast.ReturnExpr(r2,e2,s2)) ->
 447       unify_expression e1 e2
 448
 449   | (Ast.DisjRuleElem(res1),_) ->
 450       disjunct_all_bindings
 451         (List.map (function x -> unify_rule_elem x re2) res1)
 452   | (_,Ast.DisjRuleElem(res2)) ->
 453       disjunct_all_bindings
 454         (List.map (function x -> unify_rule_elem re1 x) res2)
 455
 456   | (Ast.MetaRuleElem(_,_,_),_)
 457   | (Ast.MetaStmt(_,_,_,_),_)
 458   | (Ast.MetaStmtList(_,_,_),_)
 459   | (_,Ast.MetaRuleElem(_,_,_))
 460   | (_,Ast.MetaStmt(_,_,_,_))
 461   | (_,Ast.MetaStmtList(_,_,_)) -> return true
 462
 463     (* can match a rule_elem in different parts *)
 464   | (Ast.Exp(e1),Ast.Exp(e2)) -> return true
 465   | (Ast.Exp(e1),_) -> subexp (unify_expression e1) re2
 466   | (_,Ast.Exp(e2)) -> subexp (unify_expression e2) re1
 467
 468   | (Ast.TopExp(e1),Ast.TopExp(e2)) -> unify_expression e1 e2
 469   | (Ast.TopInit(i1),Ast.TopInit(i2)) -> unify_initialiser i1 i2
 470
 471     (* can match a rule_elem in different parts *)
 472   | (Ast.Ty(t1),Ast.Ty(t2)) -> return true
 473   | (Ast.Ty(t1),_) -> subtype (unify_fullType t1) re2
 474   | (_,Ast.Ty(t2)) -> subtype (unify_fullType t2) re1
 475   | _ -> return false
 476
 477 and unify_fninfo patterninfo cinfo =
 478   let patterninfo = List.sort compare patterninfo in
 479   let cinfo = List.sort compare cinfo in
 480   let rec loop = function
 481       (Ast.FStorage(sta)::resta,Ast.FStorage(stb)::restb) ->
 482       if unify_mcode sta stb then loop (resta,restb) else return false
 483     | (Ast.FType(tya)::resta,Ast.FType(tyb)::restb) ->
 484         conjunct_bindings (unify_fullType tya tyb) (loop (resta,restb))
 485     | (Ast.FInline(ia)::resta,Ast.FInline(ib)::restb) ->
 486         if unify_mcode ia ib then loop (resta,restb) else return false
 487     | (Ast.FAttr(ia)::resta,Ast.FAttr(ib)::restb) ->
 488         if unify_mcode ia ib then loop (resta,restb) else return false
 489     | (x::resta,((y::_) as restb)) ->
 490         (match compare x y with
 491           -1 -> return false
 492         | 1 -> loop (resta,restb)
 493         | _ -> failwith "not possible")
 494     | _ -> return false in
 495   loop (patterninfo,cinfo)
 496
 497 and subexp f =
 498   let bind = conjunct_bindings in
 499   let option_default = return false in
 500   let mcode r e = option_default in
 501   let expr r k e = conjunct_bindings (f e) (k e) in
 502   let donothing r k e = k e in
 503   let recursor = V.combiner bind option_default
 504       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 505       donothing donothing donothing donothing
 506       donothing expr donothing donothing donothing donothing donothing
 507       donothing donothing donothing donothing donothing in
 508   recursor.V.combiner_rule_elem
 509
 510 and subtype f =
 511   let bind = conjunct_bindings in
 512   let option_default = return false in
 513   let mcode r e = option_default in
 514   let fullType r k e = conjunct_bindings (f e) (k e) in
 515   let donothing r k e = k e in
 516   let recursor = V.combiner bind option_default
 517       mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
 518       donothing donothing donothing donothing
 519       donothing donothing fullType donothing donothing donothing donothing
 520       donothing donothing donothing donothing donothing in
 521   recursor.V.combiner_rule_elem
 522
 523 let rec unify_statement s1 s2 =
 524   match (Ast.unwrap s1,Ast.unwrap s2) with
 525     (Ast.Seq(lb1,s1,rb1),Ast.Seq(lb2,s2,rb2)) ->
 526       conjunct_bindings (unify_rule_elem lb1 lb2)
 527         (conjunct_bindings
 528            (unify_dots unify_statement sdots s1 s2)
 529            (unify_rule_elem rb1 rb2))
 530   | (Ast.IfThen(h1,thn1,_),Ast.IfThen(h2,thn2,_)) ->
 531       conjunct_bindings (unify_rule_elem h1 h2) (unify_statement thn1 thn2)
 532   | (Ast.IfThenElse(h1,thn1,e1,els1,_),Ast.IfThenElse(h2,thn2,e2,els2,_)) ->
 533       conjunct_bindings (unify_rule_elem h1 h2)
 534         (conjunct_bindings (unify_statement thn1 thn2)
 535            (conjunct_bindings (unify_rule_elem e1 e2)
 536               (unify_statement els1 els2)))
 537   | (Ast.While(h1,s1,_),Ast.While(h2,s2,_)) ->
 538       conjunct_bindings (unify_rule_elem h1 h2) (unify_statement s1 s2)
 539   | (Ast.Do(h1,s1,t1),Ast.Do(h2,s2,t2)) ->
 540       conjunct_bindings (unify_rule_elem h1 h2)
 541         (conjunct_bindings (unify_statement s1 s2) (unify_rule_elem t1 t2))
 542   | (Ast.For(h1,s1,_),Ast.For(h2,s2,_)) ->
 543       conjunct_bindings (unify_rule_elem h1 h2) (unify_statement s1 s2)
 544   | (Ast.Atomic(re1),Ast.Atomic(re2)) -> unify_rule_elem re1 re2
 545   | (Ast.Disj(s1),_) ->
 546       let s2 = Ast.rewrap s2 (Ast.DOTS[s2]) in
 547       disjunct_all_bindings
 548         (List.map
 549            (function x -> unify_dots unify_statement sdots x s2)
 550            s1)
 551   | (_,Ast.Disj(s2)) ->
 552       let s1 = Ast.rewrap s1 (Ast.DOTS[s1]) in
 553       disjunct_all_bindings
 554         (List.map
 555            (function x -> unify_dots unify_statement sdots s1 x)
 556            s2)
 557   | (Ast.Nest(s1,_,_,_,_),Ast.Nest(s2,_,_,_,_)) ->
 558       unify_dots unify_statement sdots s1 s2
 559   | (Ast.FunDecl(h1,lb1,s1,rb1),Ast.FunDecl(h2,lb2,s2,rb2)) ->
 560       conjunct_bindings (unify_rule_elem h1 h2)
 561         (conjunct_bindings (unify_rule_elem lb1 lb2)
 562            (conjunct_bindings (unify_dots unify_statement sdots s1 s2)
 563               (unify_rule_elem rb1 rb2)))
 564   | (Ast.Define(h1,s1),Ast.Define(h2,s2)) ->
 565       conjunct_bindings (unify_rule_elem h1 h2)
 566         (unify_dots unify_statement sdots s1 s2)
 567   (* dots can match against anything.  return true to be safe. *)
 568   | (Ast.Dots(_,_,_,_),_) | (_,Ast.Dots(_,_,_,_))
 569   | (Ast.Circles(_,_,_,_),_) | (_,Ast.Circles(_,_,_,_))
 570   | (Ast.Stars(_,_,_,_),_) | (_,Ast.Stars(_,_,_,_)) -> return true
 571   | (Ast.OptStm(_),_)
 572   | (Ast.UniqueStm(_),_)
 573   | (_,Ast.OptStm(_))
 574   | (_,Ast.UniqueStm(_)) -> failwith "unsupported statement"
 575   | _ -> return false
 576
 577 let unify_statement_dots = unify_dots unify_statement sdots