(*
-* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
-* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
-* This file is part of Coccinelle.
-*
-* Coccinelle is free software: you can redistribute it and/or modify
-* it under the terms of the GNU General Public License as published by
-* the Free Software Foundation, according to version 2 of the License.
-*
-* Coccinelle is distributed in the hope that it will be useful,
-* but WITHOUT ANY WARRANTY; without even the implied warranty of
-* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-* GNU General Public License for more details.
-*
-* You should have received a copy of the GNU General Public License
-* along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
-*
-* The authors reserve the right to distribute this or future versions of
-* Coccinelle under other licenses.
-*)
+ * Copyright 2012, INRIA
+ * Julia Lawall, Gilles Muller
+ * Copyright 2010-2011, INRIA, University of Copenhagen
+ * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
+ * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
+ * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
+ * This file is part of Coccinelle.
+ *
+ * Coccinelle is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, according to version 2 of the License.
+ *
+ * Coccinelle is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
+ *
+ * The authors reserve the right to distribute this or future versions of
+ * Coccinelle under other licenses.
+ *)
(* --------------------------------------------------------------------- *)
Ast.Dots(_,_,_,_) | Ast.Circles(_,_,_,_) | Ast.Stars(_,_,_,_) -> true
| _ -> false
+let idots e =
+ match Ast.unwrap e with
+ Ast.Idots(_,_) -> true
+ | _ -> false
+
(* --------------------------------------------------------------------- *)
(* Identifier *)
-and unify_ident i1 i2 =
+let rec unify_ident i1 i2 =
match (Ast.unwrap i1,Ast.unwrap i2) with
(Ast.Id(i1),Ast.Id(i2)) -> return (unify_mcode i1 i2)
| (_,Ast.MetaFunc(_,_,_,_))
| (_,Ast.MetaLocalFunc(_,_,_,_)) -> return true
+ | (Ast.DisjId(i1),_) ->
+ disjunct_all_bindings (List.map (function x -> unify_ident x i2) i1)
+ | (_,Ast.DisjId(i2)) ->
+ disjunct_all_bindings (List.map (function x -> unify_ident i1 x) i2)
+
| (Ast.OptIdent(_),_)
| (Ast.UniqueIdent(_),_)
| (_,Ast.OptIdent(_))
(* --------------------------------------------------------------------- *)
(* Expression *)
-let rec unify_expression e1 e2 =
+and unify_expression e1 e2 =
match (Ast.unwrap e1,Ast.unwrap e2) with
(Ast.Ident(i1),Ast.Ident(i2)) -> unify_ident i1 i2
| (Ast.Constant(c1),Ast.Constant(c2))-> return (unify_mcode c1 c2)
if unify_mcode op1 op2
then conjunct_bindings (unify_expression l1 l2) (unify_expression r1 r2)
else return false
+ | (Ast.Sequence(l1,_,r1),Ast.Sequence(l2,_,r2)) ->
+ conjunct_bindings (unify_expression l1 l2) (unify_expression r1 r2)
| (Ast.CondExpr(tst1,q1,thn1,c1,els1),Ast.CondExpr(tst2,q2,thn2,c2,els2)) ->
conjunct_bindings (unify_expression tst1 tst2)
(conjunct_bindings (unify_option unify_expression thn1 thn2)
| (Ast.SizeOfType(szf1,lp1,ty1,rp1),Ast.SizeOfType(szf2,lp2,ty2,rp2)) ->
unify_fullType ty1 ty2
| (Ast.TypeExp(ty1),Ast.TypeExp(ty2)) -> unify_fullType ty1 ty2
+ | (Ast.Constructor(lp1,ty1,rp1,i1),Ast.Constructor(lp2,ty2,rp2,i2)) ->
+ conjunct_bindings (unify_fullType ty1 ty2) (unify_initialiser i1 i2)
| (Ast.Paren(lp1,e1,rp1),Ast.Paren(lp2,e2,rp2)) ->
unify_expression e1 e2
| (_,Ast.MetaExpr(_,_,_,_,_,_))
| (_,Ast.MetaExprList(_,_,_,_)) -> return true
+ | (Ast.AsExpr(exp1,asexp1),_) ->
+ disjunct_all_bindings
+ (List.map (function x -> unify_expression x e2) [exp1;asexp1])
+ | (_,Ast.AsExpr(exp2,asexp2)) ->
+ disjunct_all_bindings
+ (List.map (function x -> unify_expression x e1) [exp2;asexp2])
+
| (Ast.EComma(cm1),Ast.EComma(cm2)) -> return true
| (Ast.DisjExpr(e1),_) ->
disjunct_all_bindings (List.map (function x -> unify_expression x e2) e1)
| (_,Ast.DisjExpr(e2)) ->
disjunct_all_bindings (List.map (function x -> unify_expression e1 x) e2)
- | (Ast.NestExpr(e1,_,_),Ast.NestExpr(e2,_,_)) ->
+ | (Ast.NestExpr(_,e1,_,_,_),Ast.NestExpr(_,e2,_,_,_)) ->
unify_dots unify_expression edots e1 e2
(* dots can match against anything. return true to be safe. *)
and unify_fullType ft1 ft2 =
match (Ast.unwrap ft1,Ast.unwrap ft2) with
- (Ast.Type(cv1,ty1),Ast.Type(cv2,ty2)) ->
+ (Ast.Type(_,cv1,ty1),Ast.Type(_,cv2,ty2)) ->
if bool_unify_option unify_mcode cv1 cv2
then unify_typeC ty1 ty2
else return false
+ | (Ast.AsType(ty1,asty1),_) ->
+ disjunct_all_bindings
+ (List.map (function x -> unify_fullType x ft2) [ty1;asty1])
+ | (_,Ast.AsType(ty2,asty2)) ->
+ disjunct_all_bindings
+ (List.map (function x -> unify_fullType x ft1) [ty2;asty2])
| (Ast.DisjType(ft1),_) ->
disjunct_all_bindings (List.map (function x -> unify_fullType x ft2) ft1)
| (_,Ast.DisjType(ft2)) ->
| (Ast.Array(ty1,lb1,e1,rb1),Ast.Array(ty2,lb2,e2,rb2)) ->
conjunct_bindings
(unify_fullType ty1 ty2) (unify_option unify_expression e1 e2)
- | (Ast.EnumName(s1,ts1),Ast.EnumName(s2,ts2)) ->
+ | (Ast.EnumName(s1,Some ts1),Ast.EnumName(s2,Some ts2)) ->
if unify_mcode s1 s2 then unify_ident ts1 ts2 else return false
+ | (Ast.EnumName(s1,None),Ast.EnumName(s2,None)) ->
+ return true
+ | (Ast.EnumDef(ty1,lb1,ids1,rb1),Ast.EnumDef(ty2,lb2,ids2,rb2)) ->
+ conjunct_bindings (unify_fullType ty1 ty2)
+ (unify_dots unify_expression edots ids1 ids2)
| (Ast.StructUnionName(s1,Some ts1),Ast.StructUnionName(s2,Some ts2)) ->
if unify_mcode s1 s2 then unify_ident ts1 ts2 else return false
| (Ast.StructUnionName(s1,None),Ast.StructUnionName(s2,None)) ->
- return true
+ return (unify_mcode s1 s2)
| (Ast.StructUnionDef(ty1,lb1,decls1,rb1),
Ast.StructUnionDef(ty2,lb2,decls2,rb2)) ->
conjunct_bindings (unify_fullType ty1 ty2)
and unify_declaration d1 d2 =
match (Ast.unwrap d1,Ast.unwrap d2) with
- (Ast.Init(stg1,ft1,id1,eq1,i1,s1),Ast.Init(stg2,ft2,id2,eq2,i2,s2)) ->
+ (Ast.MetaDecl(_,_,_),_) | (_,Ast.MetaDecl(_,_,_)) -> return true
+ | (Ast.MetaField(_,_,_),_) | (_,Ast.MetaField(_,_,_)) -> return true
+ | (Ast.MetaFieldList(_,_,_,_),_) | (_,Ast.MetaFieldList(_,_,_,_)) ->
+ return true
+ | (Ast.Init(stg1,ft1,id1,eq1,i1,s1),Ast.Init(stg2,ft2,id2,eq2,i2,s2)) ->
if bool_unify_option unify_mcode stg1 stg2
then
conjunct_bindings (unify_fullType ft1 ft2)
Ast.MacroDecl(n2,lp2,args2,rp2,sem2)) ->
conjunct_bindings (unify_ident n1 n2)
(unify_dots unify_expression edots args1 args2)
+ | (Ast.MacroDeclInit(n1,lp1,args1,rp1,eq1,ini1,sem1),
+ Ast.MacroDeclInit(n2,lp2,args2,rp2,eq2,ini2,sem2)) ->
+ conjunct_bindings (unify_ident n1 n2)
+ (conjunct_bindings (unify_dots unify_expression edots args1 args2)
+ (unify_initialiser ini1 ini2))
| (Ast.TyDecl(ft1,s1),Ast.TyDecl(ft2,s2)) -> unify_fullType ft1 ft2
| (Ast.Typedef(stg1,ft1,id1,s1),Ast.Typedef(stg2,ft2,id2,s2)) ->
conjunct_bindings (unify_fullType ft1 ft2) (unify_typeC id1 id2)
and unify_initialiser i1 i2 =
match (Ast.unwrap i1,Ast.unwrap i2) with
- (Ast.InitExpr(expa),Ast.InitExpr(expb)) ->
+ (Ast.MetaInit(_,_,_),_) | (_,Ast.MetaInit(_,_,_)) -> return true
+ | (Ast.MetaInitList(_,_,_,_),_) | (_,Ast.MetaInitList(_,_,_,_)) -> return true
+ | (Ast.InitExpr(expa),Ast.InitExpr(expb)) ->
unify_expression expa expb
- | (Ast.InitList(_,initlista,_,whena),
- Ast.InitList(_,initlistb,_,whenb)) ->
+ | (Ast.ArInitList(_,initlista,_),
+ Ast.ArInitList(_,initlistb,_)) ->
+ (* ignore whencode - returns true safely *)
+ unify_dots unify_initialiser idots initlista initlistb
+ | (Ast.StrInitList(_,_,initlista,_,whena),
+ Ast.StrInitList(_,_,initlistb,_,whenb)) ->
(* ignore whencode - returns true safely *)
unify_lists unify_initialiser (function _ -> false) initlista initlistb
- | (Ast.InitGccDotName(_,namea,_,inia),
- Ast.InitGccDotName(_,nameb,_,inib)) ->
+ | (Ast.InitGccExt(designatorsa,_,inia),
+ Ast.InitGccExt(designatorsb,_,inib)) ->
conjunct_bindings
- (unify_ident namea nameb) (unify_initialiser inia inib)
+ (unify_lists unify_designator (function _ -> false)
+ designatorsa designatorsb)
+ (unify_initialiser inia inib)
| (Ast.InitGccName(namea,_,inia),Ast.InitGccName(nameb,_,inib)) ->
conjunct_bindings (unify_ident namea nameb) (unify_initialiser inia inib)
- | (Ast.InitGccIndex(_,expa,_,_,inia),
- Ast.InitGccIndex(_,expb,_,_,inib)) ->
- conjunct_bindings
- (unify_expression expa expb) (unify_initialiser inia inib)
- | (Ast.InitGccRange(_,exp1a,_,exp2a,_,_,inia),
- Ast.InitGccRange(_,exp1b,_,exp2b,_,_,inib)) ->
- conjunct_bindings (unify_expression exp1a exp1b)
- (conjunct_bindings (unify_expression exp2a exp2b)
- (unify_initialiser inia inib))
| (Ast.OptIni(_),_)
| (Ast.UniqueIni(_),_)
| (_,Ast.UniqueIni(_)) -> failwith "unsupported decl"
| _ -> return false
+and unify_designator d1 d2 =
+ match (d1,d2) with
+ (Ast.DesignatorField(_,idb),Ast.DesignatorField(_,ida)) ->
+ unify_ident ida idb
+ | (Ast.DesignatorIndex(_,expa,_),Ast.DesignatorIndex(_,expb,_)) ->
+ unify_expression expa expb
+ | (Ast.DesignatorRange(_,mina,_,maxa,_),
+ Ast.DesignatorRange(_,minb,_,maxb,_)) ->
+ conjunct_bindings (unify_expression mina minb)
+ (unify_expression maxa maxb)
+ | _ -> return false
+
(* --------------------------------------------------------------------- *)
(* Parameter *)
| (Ast.SeqEnd(rb1),Ast.SeqEnd(rb2)) -> return true
| (Ast.ExprStatement(e1,s1),Ast.ExprStatement(e2,s2)) ->
- unify_expression e1 e2
+ unify_option unify_expression e1 e2
| (Ast.IfHeader(if1,lp1,e1,rp1),Ast.IfHeader(if2,lp2,e2,rp2)) ->
unify_expression e1 e2
| (Ast.Else(e1),Ast.Else(e2)) -> return true
Ast.IteratorHeader(nm2,lp2,args2,rp2)) ->
conjunct_bindings (unify_ident nm1 nm2)
(unify_dots unify_expression edots args1 args2)
+ | (Ast.Undef(_,n1),Ast.Undef(_,n2)) -> unify_ident n1 n2
| (Ast.DefineHeader(_,n1,p1),Ast.DefineHeader(_,n2,p2)) ->
conjunct_bindings (unify_ident n1 n2)
(unify_define_parameters p1 p2)
let donothing r k e = k e in
let recursor = V.combiner bind option_default
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
- donothing donothing donothing donothing
+ donothing donothing donothing donothing donothing
donothing expr donothing donothing donothing donothing donothing
donothing donothing donothing donothing donothing in
recursor.V.combiner_rule_elem
let donothing r k e = k e in
let recursor = V.combiner bind option_default
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
- donothing donothing donothing donothing
+ donothing donothing donothing donothing donothing
donothing donothing fullType donothing donothing donothing donothing
donothing donothing donothing donothing donothing in
recursor.V.combiner_rule_elem
let rec unify_statement s1 s2 =
match (Ast.unwrap s1,Ast.unwrap s2) with
- (Ast.Seq(lb1,d1,s1,rb1),Ast.Seq(lb2,d2,s2,rb2)) ->
+ (Ast.Seq(lb1,s1,rb1),Ast.Seq(lb2,s2,rb2)) ->
conjunct_bindings (unify_rule_elem lb1 lb2)
(conjunct_bindings
(unify_dots unify_statement sdots s1 s2)
- (conjunct_bindings
- (unify_dots unify_statement sdots d1 d2)
- (unify_rule_elem rb1 rb2)))
+ (unify_rule_elem rb1 rb2))
| (Ast.IfThen(h1,thn1,_),Ast.IfThen(h2,thn2,_)) ->
conjunct_bindings (unify_rule_elem h1 h2) (unify_statement thn1 thn2)
| (Ast.IfThenElse(h1,thn1,e1,els1,_),Ast.IfThenElse(h2,thn2,e2,els2,_)) ->
(List.map
(function x -> unify_dots unify_statement sdots s1 x)
s2)
- | (Ast.Nest(s1,_,_,_,_),Ast.Nest(s2,_,_,_,_)) ->
+ | (Ast.Nest(_,s1,_,_,_,_,_),Ast.Nest(_,s2,_,_,_,_,_)) ->
unify_dots unify_statement sdots s1 s2
- | (Ast.FunDecl(h1,lb1,d1,s1,rb1),Ast.FunDecl(h2,lb2,d2,s2,rb2)) ->
+ | (Ast.FunDecl(h1,lb1,s1,rb1),Ast.FunDecl(h2,lb2,s2,rb2)) ->
conjunct_bindings (unify_rule_elem h1 h2)
(conjunct_bindings (unify_rule_elem lb1 lb2)
- (conjunct_bindings (unify_dots unify_statement sdots d1 d2)
- (conjunct_bindings (unify_dots unify_statement sdots s1 s2)
- (unify_rule_elem rb1 rb2))))
+ (conjunct_bindings (unify_dots unify_statement sdots s1 s2)
+ (unify_rule_elem rb1 rb2)))
| (Ast.Define(h1,s1),Ast.Define(h2,s2)) ->
conjunct_bindings (unify_rule_elem h1 h2)
(unify_dots unify_statement sdots s1 s2)