Commit | Line | Data |
---|---|---|
f537ebc4 | 1 | (* |
17ba0788 C |
2 | * Copyright 2012, INRIA |
3 | * Julia Lawall, Gilles Muller | |
4 | * Copyright 2010-2011, INRIA, University of Copenhagen | |
f537ebc4 C |
5 | * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix |
6 | * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen | |
7 | * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix | |
8 | * This file is part of Coccinelle. | |
9 | * | |
10 | * Coccinelle is free software: you can redistribute it and/or modify | |
11 | * it under the terms of the GNU General Public License as published by | |
d6ce1786 C |
12 | * the Free Software Foundation, according to version 2 of the License. |
13 | * | |
14 | * Coccinelle is distributed in the hope that it will be useful, | |
15 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | * GNU General Public License for more details. | |
18 | * | |
19 | * You should have received a copy of the GNU General Public License | |
20 | * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>. | |
21 | * | |
22 | * The authors reserve the right to distribute this or future versions of | |
23 | * Coccinelle under other licenses. | |
24 | *) | |
25 | ||
26 | ||
feec80c3 | 27 | # 0 "./unify_ast.ml" |
34e49164 C |
28 | (* --------------------------------------------------------------------- *) |
29 | (* Given two patterns, A and B, determine whether B can match any matched | |
30 | subterms of A. For simplicity, this doesn't maintain an environment; it | |
31 | just assume metavariables match. Thus the result is either NO or MAYBE. *) | |
32 | ||
33 | module Ast = Ast_cocci | |
34 | module V = Visitor_ast | |
35 | ||
36 | (* --------------------------------------------------------------------- *) | |
37 | ||
38 | type res = NO | MAYBE | |
39 | ||
40 | let return b = if b then MAYBE else NO | |
41 | ||
42 | let unify_mcode (x,_,_,_) (y,_,_,_) = x = y | |
43 | ||
faf9a90c C |
44 | let ret_unify_mcode a b = return (unify_mcode a b) |
45 | ||
34e49164 C |
46 | let unify_option f t1 t2 = |
47 | match (t1,t2) with | |
48 | (Some t1, Some t2) -> f t1 t2 | |
49 | | (None, None) -> return true | |
50 | | _ -> return false | |
51 | ||
52 | let unify_true_option f t1 t2 = | |
53 | match (t1,t2) with | |
54 | (Some t1, Some t2) -> f t1 t2 | |
55 | | (None, None) -> return true | |
56 | | _ -> return true | |
57 | ||
58 | let bool_unify_option f t1 t2 = | |
59 | match (t1,t2) with | |
60 | (Some t1, Some t2) -> f t1 t2 | |
61 | | (None, None) -> true | |
62 | | _ -> false | |
63 | ||
64 | let conjunct_bindings b1 b2 = | |
65 | match b1 with NO -> b1 | MAYBE -> b2 | |
66 | ||
67 | let disjunct_bindings b1 b2 = | |
68 | match b1 with MAYBE -> b1 | NO -> b2 | |
69 | ||
faf9a90c | 70 | let disjunct_all_bindings = List.fold_left disjunct_bindings NO |
34e49164 C |
71 | |
72 | (* --------------------------------------------------------------------- *) | |
73 | ||
74 | (* compute the common prefix. if in at least one case, this ends with the | |
75 | end of the pattern or a ..., then return true. *) | |
76 | ||
77 | let unify_lists fn dfn la lb = | |
78 | let rec loop = function | |
79 | ([],_) | (_,[]) -> return true | |
80 | | (cura::resta,curb::restb) -> | |
81 | (match fn cura curb with | |
82 | MAYBE -> loop (resta,restb) | |
83 | | NO -> if dfn cura or dfn curb then MAYBE else NO) in | |
84 | loop (la,lb) | |
85 | ||
86 | let unify_dots fn dfn d1 d2 = | |
87 | match (Ast.unwrap d1,Ast.unwrap d2) with | |
88 | (Ast.DOTS(l1),Ast.DOTS(l2)) | |
89 | | (Ast.CIRCLES(l1),Ast.CIRCLES(l2)) | |
90 | | (Ast.STARS(l1),Ast.STARS(l2)) -> unify_lists fn dfn l1 l2 | |
91 | | _ -> return false | |
92 | ||
93 | let edots e = | |
94 | match Ast.unwrap e with | |
95 | Ast.Edots(_,_) | Ast.Ecircles(_,_) | Ast.Estars(_,_) -> true | |
96 | | _ -> false | |
97 | ||
98 | let ddots e = | |
99 | match Ast.unwrap e with | |
100 | Ast.Ddots(_,_) -> true | |
101 | | _ -> false | |
102 | ||
103 | let pdots p = | |
104 | match Ast.unwrap p with | |
105 | Ast.Pdots(_) | Ast.Pcircles(_) -> true | |
106 | | _ -> false | |
107 | ||
108 | let dpdots e = | |
109 | match Ast.unwrap e with | |
110 | Ast.DPdots(_) | Ast.DPcircles(_) -> true | |
111 | | _ -> false | |
112 | ||
113 | let sdots s = | |
114 | match Ast.unwrap s with | |
115 | Ast.Dots(_,_,_,_) | Ast.Circles(_,_,_,_) | Ast.Stars(_,_,_,_) -> true | |
116 | | _ -> false | |
117 | ||
c491d8ee C |
118 | let idots e = |
119 | match Ast.unwrap e with | |
120 | Ast.Idots(_,_) -> true | |
121 | | _ -> false | |
122 | ||
34e49164 C |
123 | (* --------------------------------------------------------------------- *) |
124 | (* Identifier *) | |
125 | ||
d3f655c6 | 126 | let rec unify_ident i1 i2 = |
34e49164 C |
127 | match (Ast.unwrap i1,Ast.unwrap i2) with |
128 | (Ast.Id(i1),Ast.Id(i2)) -> return (unify_mcode i1 i2) | |
129 | ||
130 | | (Ast.MetaId(_,_,_,_),_) | |
131 | | (Ast.MetaFunc(_,_,_,_),_) | |
132 | | (Ast.MetaLocalFunc(_,_,_,_),_) | |
133 | | (_,Ast.MetaId(_,_,_,_)) | |
134 | | (_,Ast.MetaFunc(_,_,_,_)) | |
135 | | (_,Ast.MetaLocalFunc(_,_,_,_)) -> return true | |
136 | ||
d6ce1786 C |
137 | | (Ast.AsIdent(id1,asid1),_) -> |
138 | disjunct_all_bindings | |
139 | (List.map (function x -> unify_ident x i2) [id1;asid1]) | |
140 | | (_,Ast.AsIdent(id2,asid2)) -> | |
141 | disjunct_all_bindings | |
142 | (List.map (function x -> unify_ident x i1) [id2;asid2]) | |
143 | ||
d3f655c6 C |
144 | | (Ast.DisjId(i1),_) -> |
145 | disjunct_all_bindings (List.map (function x -> unify_ident x i2) i1) | |
146 | | (_,Ast.DisjId(i2)) -> | |
147 | disjunct_all_bindings (List.map (function x -> unify_ident i1 x) i2) | |
148 | ||
34e49164 C |
149 | | (Ast.OptIdent(_),_) |
150 | | (Ast.UniqueIdent(_),_) | |
151 | | (_,Ast.OptIdent(_)) | |
152 | | (_,Ast.UniqueIdent(_)) -> failwith "unsupported ident" | |
153 | ||
154 | (* --------------------------------------------------------------------- *) | |
155 | (* Expression *) | |
156 | ||
d3f655c6 | 157 | and unify_expression e1 e2 = |
34e49164 C |
158 | match (Ast.unwrap e1,Ast.unwrap e2) with |
159 | (Ast.Ident(i1),Ast.Ident(i2)) -> unify_ident i1 i2 | |
160 | | (Ast.Constant(c1),Ast.Constant(c2))-> return (unify_mcode c1 c2) | |
161 | | (Ast.FunCall(f1,lp1,args1,rp1),Ast.FunCall(f2,lp2,args2,rp2)) -> | |
162 | conjunct_bindings | |
163 | (unify_expression f1 f2) | |
164 | (unify_dots unify_expression edots args1 args2) | |
165 | | (Ast.Assignment(l1,op1,r1,_),Ast.Assignment(l2,op2,r2,_)) -> | |
166 | if unify_mcode op1 op2 | |
167 | then conjunct_bindings (unify_expression l1 l2) (unify_expression r1 r2) | |
168 | else return false | |
17ba0788 C |
169 | | (Ast.Sequence(l1,_,r1),Ast.Sequence(l2,_,r2)) -> |
170 | conjunct_bindings (unify_expression l1 l2) (unify_expression r1 r2) | |
34e49164 C |
171 | | (Ast.CondExpr(tst1,q1,thn1,c1,els1),Ast.CondExpr(tst2,q2,thn2,c2,els2)) -> |
172 | conjunct_bindings (unify_expression tst1 tst2) | |
173 | (conjunct_bindings (unify_option unify_expression thn1 thn2) | |
174 | (unify_expression els1 els2)) | |
175 | | (Ast.Postfix(e1,op1),Ast.Postfix(e2,op2)) -> | |
176 | if unify_mcode op1 op2 then unify_expression e1 e2 else return false | |
177 | | (Ast.Infix(e1,op1),Ast.Infix(e2,op2)) -> | |
178 | if unify_mcode op1 op2 then unify_expression e1 e2 else return false | |
179 | | (Ast.Unary(e1,op1),Ast.Unary(e2,op2)) -> | |
180 | if unify_mcode op1 op2 then unify_expression e1 e2 else return false | |
181 | | (Ast.Binary(l1,op1,r1),Ast.Binary(l2,op2,r2)) -> | |
182 | if unify_mcode op1 op2 | |
183 | then conjunct_bindings (unify_expression l1 l2) (unify_expression r1 r2) | |
184 | else return false | |
185 | | (Ast.ArrayAccess(ar1,lb1,e1,rb1),Ast.ArrayAccess(ar2,lb2,e2,rb2)) -> | |
186 | conjunct_bindings (unify_expression ar1 ar2) (unify_expression e1 e2) | |
187 | | (Ast.RecordAccess(e1,d1,fld1),Ast.RecordAccess(e2,d2,fld2)) -> | |
188 | conjunct_bindings (unify_expression e1 e2) (unify_ident fld1 fld2) | |
189 | | (Ast.RecordPtAccess(e1,pt1,fld1),Ast.RecordPtAccess(e2,pt2,fld2)) -> | |
190 | conjunct_bindings (unify_expression e1 e2) (unify_ident fld1 fld2) | |
191 | | (Ast.Cast(lp1,ty1,rp1,e1),Ast.Cast(lp2,ty2,rp2,e2)) -> | |
192 | conjunct_bindings (unify_fullType ty1 ty2) (unify_expression e1 e2) | |
193 | | (Ast.SizeOfExpr(szf1,e1),Ast.SizeOfExpr(szf2,e2)) -> | |
194 | unify_expression e1 e2 | |
195 | | (Ast.SizeOfType(szf1,lp1,ty1,rp1),Ast.SizeOfType(szf2,lp2,ty2,rp2)) -> | |
196 | unify_fullType ty1 ty2 | |
197 | | (Ast.TypeExp(ty1),Ast.TypeExp(ty2)) -> unify_fullType ty1 ty2 | |
7fe62b65 C |
198 | | (Ast.Constructor(lp1,ty1,rp1,i1),Ast.Constructor(lp2,ty2,rp2,i2)) -> |
199 | conjunct_bindings (unify_fullType ty1 ty2) (unify_initialiser i1 i2) | |
34e49164 C |
200 | | (Ast.Paren(lp1,e1,rp1),Ast.Paren(lp2,e2,rp2)) -> |
201 | unify_expression e1 e2 | |
202 | ||
203 | | (Ast.MetaErr(_,_,_,_),_) | |
204 | | (Ast.MetaExpr(_,_,_,_,_,_),_) | |
205 | | (Ast.MetaExprList(_,_,_,_),_) | |
206 | | (_,Ast.MetaErr(_,_,_,_)) | |
207 | | (_,Ast.MetaExpr(_,_,_,_,_,_)) | |
208 | | (_,Ast.MetaExprList(_,_,_,_)) -> return true | |
209 | ||
17ba0788 C |
210 | | (Ast.AsExpr(exp1,asexp1),_) -> |
211 | disjunct_all_bindings | |
212 | (List.map (function x -> unify_expression x e2) [exp1;asexp1]) | |
213 | | (_,Ast.AsExpr(exp2,asexp2)) -> | |
214 | disjunct_all_bindings | |
215 | (List.map (function x -> unify_expression x e1) [exp2;asexp2]) | |
216 | ||
34e49164 C |
217 | | (Ast.EComma(cm1),Ast.EComma(cm2)) -> return true |
218 | ||
219 | | (Ast.DisjExpr(e1),_) -> | |
220 | disjunct_all_bindings (List.map (function x -> unify_expression x e2) e1) | |
221 | | (_,Ast.DisjExpr(e2)) -> | |
222 | disjunct_all_bindings (List.map (function x -> unify_expression e1 x) e2) | |
5636bb2c | 223 | | (Ast.NestExpr(_,e1,_,_,_),Ast.NestExpr(_,e2,_,_,_)) -> |
34e49164 C |
224 | unify_dots unify_expression edots e1 e2 |
225 | ||
226 | (* dots can match against anything. return true to be safe. *) | |
227 | | (Ast.Edots(_,_),_) | (_,Ast.Edots(_,_)) | |
228 | | (Ast.Ecircles(_,_),_) | (_,Ast.Ecircles(_,_)) | |
229 | | (Ast.Estars(_,_),_) | (_,Ast.Estars(_,_)) -> return true | |
230 | ||
231 | | (Ast.OptExp(_),_) | |
232 | | (Ast.UniqueExp(_),_) | |
233 | | (_,Ast.OptExp(_)) | |
234 | | (_,Ast.UniqueExp(_)) -> failwith "unsupported expression" | |
235 | | _ -> return false | |
236 | ||
237 | (* --------------------------------------------------------------------- *) | |
238 | (* Types *) | |
239 | ||
240 | and unify_fullType ft1 ft2 = | |
241 | match (Ast.unwrap ft1,Ast.unwrap ft2) with | |
17ba0788 | 242 | (Ast.Type(_,cv1,ty1),Ast.Type(_,cv2,ty2)) -> |
34e49164 C |
243 | if bool_unify_option unify_mcode cv1 cv2 |
244 | then unify_typeC ty1 ty2 | |
245 | else return false | |
17ba0788 C |
246 | | (Ast.AsType(ty1,asty1),_) -> |
247 | disjunct_all_bindings | |
248 | (List.map (function x -> unify_fullType x ft2) [ty1;asty1]) | |
249 | | (_,Ast.AsType(ty2,asty2)) -> | |
250 | disjunct_all_bindings | |
251 | (List.map (function x -> unify_fullType x ft1) [ty2;asty2]) | |
34e49164 C |
252 | | (Ast.DisjType(ft1),_) -> |
253 | disjunct_all_bindings (List.map (function x -> unify_fullType x ft2) ft1) | |
254 | | (_,Ast.DisjType(ft2)) -> | |
255 | disjunct_all_bindings (List.map (function x -> unify_fullType ft1 x) ft2) | |
256 | ||
257 | | (Ast.OptType(_),_) | |
258 | | (Ast.UniqueType(_),_) | |
259 | | (_,Ast.OptType(_)) | |
260 | | (_,Ast.UniqueType(_)) -> failwith "unsupported type" | |
261 | ||
262 | and unify_typeC t1 t2 = | |
263 | match (Ast.unwrap t1,Ast.unwrap t2) with | |
faf9a90c C |
264 | (Ast.BaseType(ty1,stringsa),Ast.BaseType(ty2,stringsb)) -> |
265 | if ty1 = ty2 | |
266 | then | |
267 | unify_lists ret_unify_mcode (function _ -> false (* not dots*)) | |
268 | stringsa stringsb | |
269 | else return false | |
270 | | (Ast.SignedT(sgn1,ty1),Ast.SignedT(sgn2,ty2)) -> | |
271 | if unify_mcode sgn1 sgn2 | |
272 | then unify_option unify_typeC ty1 ty2 | |
273 | else return false | |
34e49164 C |
274 | | (Ast.Pointer(ty1,s1),Ast.Pointer(ty2,s2)) -> unify_fullType ty1 ty2 |
275 | | (Ast.FunctionPointer(tya,lp1a,stara,rp1a,lp2a,paramsa,rp2a), | |
276 | Ast.FunctionPointer(tyb,lp1b,starb,rp1b,lp2b,paramsb,rp2b)) -> | |
277 | if List.for_all2 unify_mcode | |
278 | [lp1a;stara;rp1a;lp2a;rp2a] [lp1b;starb;rp1b;lp2b;rp2b] | |
279 | then | |
280 | conjunct_bindings (unify_fullType tya tyb) | |
281 | (unify_dots unify_parameterTypeDef pdots paramsa paramsb) | |
282 | else return false | |
283 | | (Ast.FunctionType(_,tya,lp1a,paramsa,rp1a), | |
284 | Ast.FunctionType(_,tyb,lp1b,paramsb,rp1b)) -> | |
285 | if List.for_all2 unify_mcode [lp1a;rp1a] [lp1b;rp1b] | |
286 | then | |
287 | conjunct_bindings (unify_option unify_fullType tya tyb) | |
288 | (unify_dots unify_parameterTypeDef pdots paramsa paramsb) | |
289 | else return false | |
290 | | (Ast.FunctionType _ , _) -> failwith "not supported" | |
291 | | (Ast.Array(ty1,lb1,e1,rb1),Ast.Array(ty2,lb2,e2,rb2)) -> | |
292 | conjunct_bindings | |
293 | (unify_fullType ty1 ty2) (unify_option unify_expression e1 e2) | |
c491d8ee | 294 | | (Ast.EnumName(s1,Some ts1),Ast.EnumName(s2,Some ts2)) -> |
faf9a90c | 295 | if unify_mcode s1 s2 then unify_ident ts1 ts2 else return false |
c491d8ee C |
296 | | (Ast.EnumName(s1,None),Ast.EnumName(s2,None)) -> |
297 | return true | |
298 | | (Ast.EnumDef(ty1,lb1,ids1,rb1),Ast.EnumDef(ty2,lb2,ids2,rb2)) -> | |
299 | conjunct_bindings (unify_fullType ty1 ty2) | |
300 | (unify_dots unify_expression edots ids1 ids2) | |
34e49164 C |
301 | | (Ast.StructUnionName(s1,Some ts1),Ast.StructUnionName(s2,Some ts2)) -> |
302 | if unify_mcode s1 s2 then unify_ident ts1 ts2 else return false | |
303 | | (Ast.StructUnionName(s1,None),Ast.StructUnionName(s2,None)) -> | |
c491d8ee | 304 | return (unify_mcode s1 s2) |
34e49164 C |
305 | | (Ast.StructUnionDef(ty1,lb1,decls1,rb1), |
306 | Ast.StructUnionDef(ty2,lb2,decls2,rb2)) -> | |
307 | conjunct_bindings (unify_fullType ty1 ty2) | |
308 | (unify_dots unify_declaration ddots decls1 decls2) | |
309 | | (Ast.TypeName(t1),Ast.TypeName(t2)) -> return (unify_mcode t1 t2) | |
310 | ||
311 | | (Ast.MetaType(_,_,_),_) | |
312 | | (_,Ast.MetaType(_,_,_)) -> return true | |
313 | | _ -> return false | |
314 | ||
315 | (* --------------------------------------------------------------------- *) | |
316 | (* Variable declaration *) | |
317 | (* Even if the Cocci program specifies a list of declarations, they are | |
318 | split out into multiple declarations of a single variable each. *) | |
319 | ||
320 | and unify_declaration d1 d2 = | |
321 | match (Ast.unwrap d1,Ast.unwrap d2) with | |
413ffc02 C |
322 | (Ast.MetaDecl(_,_,_),_) | (_,Ast.MetaDecl(_,_,_)) -> return true |
323 | | (Ast.MetaField(_,_,_),_) | (_,Ast.MetaField(_,_,_)) -> return true | |
190f1acf C |
324 | | (Ast.MetaFieldList(_,_,_,_),_) | (_,Ast.MetaFieldList(_,_,_,_)) -> |
325 | return true | |
413ffc02 | 326 | | (Ast.Init(stg1,ft1,id1,eq1,i1,s1),Ast.Init(stg2,ft2,id2,eq2,i2,s2)) -> |
34e49164 C |
327 | if bool_unify_option unify_mcode stg1 stg2 |
328 | then | |
329 | conjunct_bindings (unify_fullType ft1 ft2) | |
330 | (conjunct_bindings (unify_ident id1 id2) (unify_initialiser i1 i2)) | |
331 | else return false | |
332 | | (Ast.UnInit(stg1,ft1,id1,s1),Ast.UnInit(stg2,ft2,id2,s2)) -> | |
333 | if bool_unify_option unify_mcode stg1 stg2 | |
334 | then conjunct_bindings (unify_fullType ft1 ft2) (unify_ident id1 id2) | |
335 | else return false | |
336 | | (Ast.MacroDecl(n1,lp1,args1,rp1,sem1), | |
337 | Ast.MacroDecl(n2,lp2,args2,rp2,sem2)) -> | |
338 | conjunct_bindings (unify_ident n1 n2) | |
339 | (unify_dots unify_expression edots args1 args2) | |
17ba0788 C |
340 | | (Ast.MacroDeclInit(n1,lp1,args1,rp1,eq1,ini1,sem1), |
341 | Ast.MacroDeclInit(n2,lp2,args2,rp2,eq2,ini2,sem2)) -> | |
342 | conjunct_bindings (unify_ident n1 n2) | |
343 | (conjunct_bindings (unify_dots unify_expression edots args1 args2) | |
344 | (unify_initialiser ini1 ini2)) | |
34e49164 C |
345 | | (Ast.TyDecl(ft1,s1),Ast.TyDecl(ft2,s2)) -> unify_fullType ft1 ft2 |
346 | | (Ast.Typedef(stg1,ft1,id1,s1),Ast.Typedef(stg2,ft2,id2,s2)) -> | |
347 | conjunct_bindings (unify_fullType ft1 ft2) (unify_typeC id1 id2) | |
348 | | (Ast.DisjDecl(d1),_) -> | |
349 | disjunct_all_bindings | |
350 | (List.map (function x -> unify_declaration x d2) d1) | |
351 | | (_,Ast.DisjDecl(d2)) -> | |
352 | disjunct_all_bindings | |
353 | (List.map (function x -> unify_declaration d1 x) d2) | |
354 | (* dots can match against anything. return true to be safe. *) | |
355 | | (Ast.Ddots(_,_),_) | (_,Ast.Ddots(_,_)) -> return true | |
356 | ||
357 | | (Ast.OptDecl(_),_) | |
358 | | (Ast.UniqueDecl(_),_) | |
359 | | (_,Ast.OptDecl(_)) | |
360 | | (_,Ast.UniqueDecl(_)) -> failwith "unsupported decl" | |
361 | | _ -> return false | |
362 | ||
363 | (* --------------------------------------------------------------------- *) | |
364 | (* Initializer *) | |
365 | ||
366 | and unify_initialiser i1 i2 = | |
367 | match (Ast.unwrap i1,Ast.unwrap i2) with | |
113803cf | 368 | (Ast.MetaInit(_,_,_),_) | (_,Ast.MetaInit(_,_,_)) -> return true |
8f657093 | 369 | | (Ast.MetaInitList(_,_,_,_),_) | (_,Ast.MetaInitList(_,_,_,_)) -> return true |
113803cf | 370 | | (Ast.InitExpr(expa),Ast.InitExpr(expb)) -> |
34e49164 | 371 | unify_expression expa expb |
c491d8ee C |
372 | | (Ast.ArInitList(_,initlista,_), |
373 | Ast.ArInitList(_,initlistb,_)) -> | |
374 | (* ignore whencode - returns true safely *) | |
375 | unify_dots unify_initialiser idots initlista initlistb | |
376 | | (Ast.StrInitList(_,_,initlista,_,whena), | |
377 | Ast.StrInitList(_,_,initlistb,_,whenb)) -> | |
34e49164 C |
378 | (* ignore whencode - returns true safely *) |
379 | unify_lists unify_initialiser (function _ -> false) initlista initlistb | |
113803cf C |
380 | | (Ast.InitGccExt(designatorsa,_,inia), |
381 | Ast.InitGccExt(designatorsb,_,inib)) -> | |
34e49164 | 382 | conjunct_bindings |
113803cf C |
383 | (unify_lists unify_designator (function _ -> false) |
384 | designatorsa designatorsb) | |
385 | (unify_initialiser inia inib) | |
34e49164 C |
386 | | (Ast.InitGccName(namea,_,inia),Ast.InitGccName(nameb,_,inib)) -> |
387 | conjunct_bindings (unify_ident namea nameb) (unify_initialiser inia inib) | |
faf9a90c | 388 | |
34e49164 C |
389 | | (Ast.OptIni(_),_) |
390 | | (Ast.UniqueIni(_),_) | |
391 | | (_,Ast.OptIni(_)) | |
392 | | (_,Ast.UniqueIni(_)) -> failwith "unsupported decl" | |
393 | | _ -> return false | |
394 | ||
113803cf C |
395 | and unify_designator d1 d2 = |
396 | match (d1,d2) with | |
397 | (Ast.DesignatorField(_,idb),Ast.DesignatorField(_,ida)) -> | |
398 | unify_ident ida idb | |
399 | | (Ast.DesignatorIndex(_,expa,_),Ast.DesignatorIndex(_,expb,_)) -> | |
400 | unify_expression expa expb | |
401 | | (Ast.DesignatorRange(_,mina,_,maxa,_), | |
402 | Ast.DesignatorRange(_,minb,_,maxb,_)) -> | |
403 | conjunct_bindings (unify_expression mina minb) | |
404 | (unify_expression maxa maxb) | |
405 | | _ -> return false | |
406 | ||
34e49164 C |
407 | (* --------------------------------------------------------------------- *) |
408 | (* Parameter *) | |
409 | ||
410 | and unify_parameterTypeDef p1 p2 = | |
411 | match (Ast.unwrap p1,Ast.unwrap p2) with | |
412 | (Ast.VoidParam(ft1),Ast.VoidParam(ft2)) -> unify_fullType ft1 ft2 | |
413 | | (Ast.Param(ft1,i1),Ast.Param(ft2,i2)) -> | |
414 | conjunct_bindings (unify_fullType ft1 ft2) | |
415 | (unify_option unify_ident i1 i2) | |
416 | ||
417 | | (Ast.MetaParam(_,_,_),_) | |
418 | | (Ast.MetaParamList(_,_,_,_),_) | |
419 | | (_,Ast.MetaParam(_,_,_)) | |
420 | | (_,Ast.MetaParamList(_,_,_,_)) -> return true | |
421 | ||
422 | | (Ast.PComma(_),Ast.PComma(_)) -> return true | |
423 | ||
424 | (* dots can match against anything. return true to be safe. *) | |
425 | | (Ast.Pdots(_),_) | (_,Ast.Pdots(_)) | |
426 | | (Ast.Pcircles(_),_) | (_,Ast.Pcircles(_)) -> return true | |
427 | ||
428 | | (Ast.OptParam(_),_) | |
429 | | (Ast.UniqueParam(_),_) | |
430 | | (_,Ast.OptParam(_)) | |
431 | | (_,Ast.UniqueParam(_)) -> failwith "unsupported parameter" | |
432 | | _ -> return false | |
433 | ||
434 | (* --------------------------------------------------------------------- *) | |
435 | (* Define parameter *) | |
436 | ||
437 | and unify_define_parameters p1 p2 = | |
438 | match (Ast.unwrap p1,Ast.unwrap p2) with | |
439 | (Ast.NoParams,Ast.NoParams) -> return true | |
440 | | (Ast.DParams(lp1,params1,rp1),Ast.DParams(lp2,params2,rp2)) -> | |
441 | unify_dots unify_define_param dpdots params1 params2 | |
442 | | _ -> return false | |
443 | ||
444 | and unify_define_param p1 p2 = | |
445 | match (Ast.unwrap p1,Ast.unwrap p2) with | |
446 | (Ast.DParam(i1),Ast.DParam(i2)) -> | |
447 | (unify_ident i1 i2) | |
448 | | (Ast.DPComma(_),Ast.DPComma(_)) -> return true | |
449 | ||
450 | (* dots can match against anything. return true to be safe. *) | |
451 | | (Ast.DPdots(_),_) | (_,Ast.DPdots(_)) | |
452 | | (Ast.DPcircles(_),_) | (_,Ast.DPcircles(_)) -> return true | |
453 | ||
454 | | (Ast.OptDParam(_),_) | |
455 | | (Ast.UniqueDParam(_),_) | |
456 | | (_,Ast.OptDParam(_)) | |
457 | | (_,Ast.UniqueDParam(_)) -> failwith "unsupported parameter" | |
458 | | _ -> return false | |
459 | ||
460 | (* --------------------------------------------------------------------- *) | |
461 | (* Top-level code *) | |
462 | ||
463 | and unify_rule_elem re1 re2 = | |
464 | match (Ast.unwrap re1,Ast.unwrap re2) with | |
465 | (Ast.FunHeader(_,_,fi1,nm1,lp1,params1,rp1), | |
466 | Ast.FunHeader(_,_,fi2,nm2,lp2,params2,rp2)) -> | |
467 | conjunct_bindings (unify_fninfo fi1 fi2) | |
468 | (conjunct_bindings (unify_ident nm1 nm2) | |
469 | (unify_dots unify_parameterTypeDef pdots params1 params2)) | |
470 | | (Ast.Decl(_,_,d1),Ast.Decl(_,_,d2)) -> unify_declaration d1 d2 | |
471 | ||
472 | | (Ast.SeqStart(lb1),Ast.SeqStart(lb2)) -> return true | |
473 | | (Ast.SeqEnd(rb1),Ast.SeqEnd(rb2)) -> return true | |
474 | ||
475 | | (Ast.ExprStatement(e1,s1),Ast.ExprStatement(e2,s2)) -> | |
8babbc8f | 476 | unify_option unify_expression e1 e2 |
34e49164 C |
477 | | (Ast.IfHeader(if1,lp1,e1,rp1),Ast.IfHeader(if2,lp2,e2,rp2)) -> |
478 | unify_expression e1 e2 | |
479 | | (Ast.Else(e1),Ast.Else(e2)) -> return true | |
480 | | (Ast.WhileHeader(wh1,lp1,e1,rp1),Ast.WhileHeader(wh2,lp2,e2,rp2)) -> | |
481 | unify_expression e1 e2 | |
482 | | (Ast.DoHeader(d1),Ast.DoHeader(d2)) -> return true | |
483 | | (Ast.WhileTail(wh1,lp1,e1,rp1,s1),Ast.WhileTail(wh2,lp2,e2,rp2,s2)) -> | |
484 | unify_expression e1 e2 | |
755320b0 C |
485 | | (Ast.ForHeader(fr1,lp1,first1,e21,s21,e31,rp1), |
486 | Ast.ForHeader(fr2,lp2,first2,e22,s22,e32,rp2)) -> | |
487 | let first = | |
488 | match (first1,first2) with | |
489 | (Ast.ForExp(e11,s11),Ast.ForExp(e12,s1)) -> | |
490 | unify_option unify_expression e11 e12 | |
491 | | (Ast.ForDecl(_,_,d1),Ast.ForDecl(_,_,d2)) -> | |
492 | unify_declaration d1 d2 | |
493 | | _ -> return false in | |
494 | conjunct_bindings first | |
34e49164 C |
495 | (conjunct_bindings |
496 | (unify_option unify_expression e21 e22) | |
497 | (unify_option unify_expression e31 e32)) | |
498 | | (Ast.IteratorHeader(nm1,lp1,args1,rp1), | |
499 | Ast.IteratorHeader(nm2,lp2,args2,rp2)) -> | |
500 | conjunct_bindings (unify_ident nm1 nm2) | |
501 | (unify_dots unify_expression edots args1 args2) | |
3a314143 | 502 | | (Ast.Undef(_,n1),Ast.Undef(_,n2)) -> unify_ident n1 n2 |
34e49164 C |
503 | | (Ast.DefineHeader(_,n1,p1),Ast.DefineHeader(_,n2,p2)) -> |
504 | conjunct_bindings (unify_ident n1 n2) | |
505 | (unify_define_parameters p1 p2) | |
506 | | (Ast.Break(r1,s1),Ast.Break(r2,s2)) -> return true | |
507 | | (Ast.Continue(r1,s1),Ast.Continue(r2,s2)) -> return true | |
508 | | (Ast.Label(l1,dd1),Ast.Label(l2,dd2)) -> unify_ident l1 l2 | |
509 | | (Ast.Goto(g1,l1,dd1),Ast.Goto(g2,l2,dd2)) -> unify_ident l1 l2 | |
510 | | (Ast.Return(r1,s1),Ast.Return(r2,s2)) -> return true | |
511 | | (Ast.ReturnExpr(r1,e1,s1),Ast.ReturnExpr(r2,e2,s2)) -> | |
512 | unify_expression e1 e2 | |
513 | ||
514 | | (Ast.DisjRuleElem(res1),_) -> | |
515 | disjunct_all_bindings | |
516 | (List.map (function x -> unify_rule_elem x re2) res1) | |
517 | | (_,Ast.DisjRuleElem(res2)) -> | |
518 | disjunct_all_bindings | |
519 | (List.map (function x -> unify_rule_elem re1 x) res2) | |
520 | ||
521 | | (Ast.MetaRuleElem(_,_,_),_) | |
522 | | (Ast.MetaStmt(_,_,_,_),_) | |
523 | | (Ast.MetaStmtList(_,_,_),_) | |
524 | | (_,Ast.MetaRuleElem(_,_,_)) | |
525 | | (_,Ast.MetaStmt(_,_,_,_)) | |
526 | | (_,Ast.MetaStmtList(_,_,_)) -> return true | |
527 | ||
528 | (* can match a rule_elem in different parts *) | |
529 | | (Ast.Exp(e1),Ast.Exp(e2)) -> return true | |
530 | | (Ast.Exp(e1),_) -> subexp (unify_expression e1) re2 | |
531 | | (_,Ast.Exp(e2)) -> subexp (unify_expression e2) re1 | |
532 | ||
533 | | (Ast.TopExp(e1),Ast.TopExp(e2)) -> unify_expression e1 e2 | |
1be43e12 | 534 | | (Ast.TopInit(i1),Ast.TopInit(i2)) -> unify_initialiser i1 i2 |
34e49164 C |
535 | |
536 | (* can match a rule_elem in different parts *) | |
537 | | (Ast.Ty(t1),Ast.Ty(t2)) -> return true | |
538 | | (Ast.Ty(t1),_) -> subtype (unify_fullType t1) re2 | |
539 | | (_,Ast.Ty(t2)) -> subtype (unify_fullType t2) re1 | |
540 | | _ -> return false | |
541 | ||
542 | and unify_fninfo patterninfo cinfo = | |
543 | let patterninfo = List.sort compare patterninfo in | |
544 | let cinfo = List.sort compare cinfo in | |
545 | let rec loop = function | |
546 | (Ast.FStorage(sta)::resta,Ast.FStorage(stb)::restb) -> | |
547 | if unify_mcode sta stb then loop (resta,restb) else return false | |
548 | | (Ast.FType(tya)::resta,Ast.FType(tyb)::restb) -> | |
549 | conjunct_bindings (unify_fullType tya tyb) (loop (resta,restb)) | |
550 | | (Ast.FInline(ia)::resta,Ast.FInline(ib)::restb) -> | |
551 | if unify_mcode ia ib then loop (resta,restb) else return false | |
552 | | (Ast.FAttr(ia)::resta,Ast.FAttr(ib)::restb) -> | |
553 | if unify_mcode ia ib then loop (resta,restb) else return false | |
554 | | (x::resta,((y::_) as restb)) -> | |
555 | (match compare x y with | |
556 | -1 -> return false | |
557 | | 1 -> loop (resta,restb) | |
558 | | _ -> failwith "not possible") | |
559 | | _ -> return false in | |
560 | loop (patterninfo,cinfo) | |
561 | ||
562 | and subexp f = | |
563 | let bind = conjunct_bindings in | |
564 | let option_default = return false in | |
565 | let mcode r e = option_default in | |
566 | let expr r k e = conjunct_bindings (f e) (k e) in | |
567 | let donothing r k e = k e in | |
568 | let recursor = V.combiner bind option_default | |
569 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode | |
c491d8ee | 570 | donothing donothing donothing donothing donothing |
34e49164 C |
571 | donothing expr donothing donothing donothing donothing donothing |
572 | donothing donothing donothing donothing donothing in | |
573 | recursor.V.combiner_rule_elem | |
574 | ||
575 | and subtype f = | |
576 | let bind = conjunct_bindings in | |
577 | let option_default = return false in | |
578 | let mcode r e = option_default in | |
579 | let fullType r k e = conjunct_bindings (f e) (k e) in | |
580 | let donothing r k e = k e in | |
581 | let recursor = V.combiner bind option_default | |
582 | mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode | |
c491d8ee | 583 | donothing donothing donothing donothing donothing |
34e49164 C |
584 | donothing donothing fullType donothing donothing donothing donothing |
585 | donothing donothing donothing donothing donothing in | |
586 | recursor.V.combiner_rule_elem | |
587 | ||
588 | let rec unify_statement s1 s2 = | |
589 | match (Ast.unwrap s1,Ast.unwrap s2) with | |
708f4980 | 590 | (Ast.Seq(lb1,s1,rb1),Ast.Seq(lb2,s2,rb2)) -> |
34e49164 C |
591 | conjunct_bindings (unify_rule_elem lb1 lb2) |
592 | (conjunct_bindings | |
593 | (unify_dots unify_statement sdots s1 s2) | |
708f4980 | 594 | (unify_rule_elem rb1 rb2)) |
34e49164 C |
595 | | (Ast.IfThen(h1,thn1,_),Ast.IfThen(h2,thn2,_)) -> |
596 | conjunct_bindings (unify_rule_elem h1 h2) (unify_statement thn1 thn2) | |
597 | | (Ast.IfThenElse(h1,thn1,e1,els1,_),Ast.IfThenElse(h2,thn2,e2,els2,_)) -> | |
598 | conjunct_bindings (unify_rule_elem h1 h2) | |
599 | (conjunct_bindings (unify_statement thn1 thn2) | |
600 | (conjunct_bindings (unify_rule_elem e1 e2) | |
601 | (unify_statement els1 els2))) | |
602 | | (Ast.While(h1,s1,_),Ast.While(h2,s2,_)) -> | |
603 | conjunct_bindings (unify_rule_elem h1 h2) (unify_statement s1 s2) | |
604 | | (Ast.Do(h1,s1,t1),Ast.Do(h2,s2,t2)) -> | |
605 | conjunct_bindings (unify_rule_elem h1 h2) | |
606 | (conjunct_bindings (unify_statement s1 s2) (unify_rule_elem t1 t2)) | |
607 | | (Ast.For(h1,s1,_),Ast.For(h2,s2,_)) -> | |
608 | conjunct_bindings (unify_rule_elem h1 h2) (unify_statement s1 s2) | |
609 | | (Ast.Atomic(re1),Ast.Atomic(re2)) -> unify_rule_elem re1 re2 | |
610 | | (Ast.Disj(s1),_) -> | |
611 | let s2 = Ast.rewrap s2 (Ast.DOTS[s2]) in | |
612 | disjunct_all_bindings | |
613 | (List.map | |
614 | (function x -> unify_dots unify_statement sdots x s2) | |
615 | s1) | |
616 | | (_,Ast.Disj(s2)) -> | |
617 | let s1 = Ast.rewrap s1 (Ast.DOTS[s1]) in | |
618 | disjunct_all_bindings | |
619 | (List.map | |
620 | (function x -> unify_dots unify_statement sdots s1 x) | |
621 | s2) | |
5636bb2c | 622 | | (Ast.Nest(_,s1,_,_,_,_,_),Ast.Nest(_,s2,_,_,_,_,_)) -> |
34e49164 | 623 | unify_dots unify_statement sdots s1 s2 |
708f4980 | 624 | | (Ast.FunDecl(h1,lb1,s1,rb1),Ast.FunDecl(h2,lb2,s2,rb2)) -> |
34e49164 C |
625 | conjunct_bindings (unify_rule_elem h1 h2) |
626 | (conjunct_bindings (unify_rule_elem lb1 lb2) | |
708f4980 C |
627 | (conjunct_bindings (unify_dots unify_statement sdots s1 s2) |
628 | (unify_rule_elem rb1 rb2))) | |
34e49164 C |
629 | | (Ast.Define(h1,s1),Ast.Define(h2,s2)) -> |
630 | conjunct_bindings (unify_rule_elem h1 h2) | |
631 | (unify_dots unify_statement sdots s1 s2) | |
632 | (* dots can match against anything. return true to be safe. *) | |
633 | | (Ast.Dots(_,_,_,_),_) | (_,Ast.Dots(_,_,_,_)) | |
634 | | (Ast.Circles(_,_,_,_),_) | (_,Ast.Circles(_,_,_,_)) | |
635 | | (Ast.Stars(_,_,_,_),_) | (_,Ast.Stars(_,_,_,_)) -> return true | |
636 | | (Ast.OptStm(_),_) | |
637 | | (Ast.UniqueStm(_),_) | |
638 | | (_,Ast.OptStm(_)) | |
639 | | (_,Ast.UniqueStm(_)) -> failwith "unsupported statement" | |
640 | | _ -> return false | |
641 | ||
642 | let unify_statement_dots = unify_dots unify_statement sdots |