(*
- * Copyright 2010, INRIA, University of Copenhagen
+ * 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
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),_) ->
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.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.InitGccExt(designatorsa,_,inia),
| (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
HCoop / bpt / coccinelle.git / blobdiff