parsing_cocci/.#unify_ast.ml.1.70

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