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 | |
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 | ||
d6ce1786 C |
27 | # 0 "./type_infer.ml" |
28 | (* | |
29 | * Copyright 2012, INRIA | |
30 | * Julia Lawall, Gilles Muller | |
31 | * Copyright 2010-2011, INRIA, University of Copenhagen | |
32 | * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix | |
33 | * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen | |
34 | * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix | |
35 | * This file is part of Coccinelle. | |
36 | * | |
37 | * Coccinelle is free software: you can redistribute it and/or modify | |
38 | * it under the terms of the GNU General Public License as published by | |
39 | * the Free Software Foundation, according to version 2 of the License. | |
40 | * | |
41 | * Coccinelle is distributed in the hope that it will be useful, | |
42 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
43 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
44 | * GNU General Public License for more details. | |
45 | * | |
46 | * You should have received a copy of the GNU General Public License | |
47 | * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>. | |
48 | * | |
49 | * The authors reserve the right to distribute this or future versions of | |
50 | * Coccinelle under other licenses. | |
51 | *) | |
52 | ||
53 | ||
feec80c3 | 54 | # 0 "./type_infer.ml" |
34e49164 C |
55 | module T = Type_cocci |
56 | module Ast = Ast_cocci | |
57 | module Ast0 = Ast0_cocci | |
58 | module V0 = Visitor_ast0 | |
b1b2de81 | 59 | module VT0 = Visitor_ast0_types |
34e49164 C |
60 | |
61 | (* Type inference: | |
62 | Just propagates information based on declarations. Could try to infer | |
63 | more precise information about expression metavariables, but not sure it is | |
64 | worth it. The most obvious goal is to distinguish between test expressions | |
65 | that have pointer, integer, and boolean type when matching isomorphisms, | |
66 | but perhaps other needs will become apparent. *) | |
67 | ||
68 | (* "functions" that return a boolean value *) | |
69 | let bool_functions = ["likely";"unlikely"] | |
70 | ||
71 | let err wrapped ty s = | |
72 | T.typeC ty; Format.print_newline(); | |
73 | failwith (Printf.sprintf "line %d: %s" (Ast0.get_line wrapped) s) | |
74 | ||
ae4735db | 75 | type id = Id of string | Meta of Ast.meta_name |
34e49164 | 76 | |
faf9a90c | 77 | let int_type = T.BaseType(T.IntType) |
8babbc8f | 78 | let void_type = T.BaseType(T.VoidType) |
faf9a90c C |
79 | let bool_type = T.BaseType(T.BoolType) |
80 | let char_type = T.BaseType(T.CharType) | |
81 | let float_type = T.BaseType(T.FloatType) | |
1eddfd50 C |
82 | let size_type = T.BaseType(T.SizeType) |
83 | let ssize_type = T.BaseType(T.SSizeType) | |
84 | let ptrdiff_type = T.BaseType(T.PtrDiffType) | |
faf9a90c | 85 | |
34e49164 C |
86 | let rec lub_type t1 t2 = |
87 | match (t1,t2) with | |
88 | (None,None) -> None | |
89 | | (None,Some t) -> t2 | |
90 | | (Some t,None) -> t1 | |
91 | | (Some t1,Some t2) -> | |
92 | let rec loop = function | |
93 | (T.Unknown,t2) -> t2 | |
94 | | (t1,T.Unknown) -> t1 | |
95 | | (T.ConstVol(cv1,ty1),T.ConstVol(cv2,ty2)) when cv1 = cv2 -> | |
96 | T.ConstVol(cv1,loop(ty1,ty2)) | |
91eba41f C |
97 | |
98 | (* pad: in pointer arithmetic, as in ptr+1, the lub must be ptr *) | |
34e49164 C |
99 | | (T.Pointer(ty1),T.Pointer(ty2)) -> |
100 | T.Pointer(loop(ty1,ty2)) | |
101 | | (ty1,T.Pointer(ty2)) -> T.Pointer(ty2) | |
102 | | (T.Pointer(ty1),ty2) -> T.Pointer(ty1) | |
91eba41f | 103 | |
34e49164 C |
104 | | (T.Array(ty1),T.Array(ty2)) -> T.Array(loop(ty1,ty2)) |
105 | | (T.TypeName(s1),t2) -> t2 | |
106 | | (t1,T.TypeName(s1)) -> t1 | |
107 | | (t1,_) -> t1 in (* arbitrarily pick the first, assume type correct *) | |
108 | Some (loop (t1,t2)) | |
109 | ||
110 | let lub_envs envs = | |
111 | List.fold_left | |
112 | (function acc -> | |
113 | function env -> | |
114 | List.fold_left | |
115 | (function acc -> | |
116 | function (var,ty) -> | |
117 | let (relevant,irrelevant) = | |
118 | List.partition (function (x,_) -> x = var) acc in | |
119 | match relevant with | |
120 | [] -> (var,ty)::acc | |
121 | | [(x,ty1)] -> | |
122 | (match lub_type (Some ty) (Some ty1) with | |
123 | Some new_ty -> (var,new_ty)::irrelevant | |
124 | | None -> irrelevant) | |
125 | | _ -> failwith "bad type environment") | |
126 | acc env) | |
127 | [] envs | |
128 | ||
129 | let rec propagate_types env = | |
130 | let option_default = None in | |
131 | let bind x y = option_default in (* no generic way of combining types *) | |
132 | ||
34e49164 C |
133 | let ident r k i = |
134 | match Ast0.unwrap i with | |
135 | Ast0.Id(id) -> | |
136 | (try Some(List.assoc (Id(Ast0.unwrap_mcode id)) env) | |
137 | with Not_found -> None) | |
8babbc8f | 138 | | Ast0.MetaId(id,_,_,_) -> |
34e49164 C |
139 | (try Some(List.assoc (Meta(Ast0.unwrap_mcode id)) env) |
140 | with Not_found -> None) | |
d3f655c6 C |
141 | | Ast0.DisjId(_,id_list,_,_) -> |
142 | let types = List.map Ast0.get_type id_list in | |
143 | let combined = List.fold_left lub_type None types in | |
144 | (match combined with | |
145 | None -> None | |
146 | | Some t -> | |
147 | List.iter (function i -> Ast0.set_type i (Some t)) id_list; | |
148 | Some t) | |
d6ce1786 | 149 | | Ast0.AsIdent _ -> failwith "not possible" |
34e49164 C |
150 | | _ -> k i in |
151 | ||
152 | let strip_cv = function | |
153 | Some (T.ConstVol(_,t)) -> Some t | |
154 | | t -> t in | |
155 | ||
faf9a90c C |
156 | (* types that might be integer types. should char be allowed? *) |
157 | let rec is_int_type = function | |
158 | T.BaseType(T.IntType) | |
159 | | T.BaseType(T.LongType) | |
160 | | T.BaseType(T.ShortType) | |
d6ce1786 | 161 | | T.BaseType(T.SizeType) |
faf9a90c C |
162 | | T.MetaType(_,_,_) |
163 | | T.TypeName _ | |
0708f913 | 164 | | T.EnumName _ |
faf9a90c C |
165 | | T.SignedT(_,None) -> true |
166 | | T.SignedT(_,Some ty) -> is_int_type ty | |
167 | | _ -> false in | |
168 | ||
34e49164 C |
169 | let expression r k e = |
170 | let res = k e in | |
171 | let ty = | |
172 | match Ast0.unwrap e with | |
951c7801 C |
173 | (* pad: the type of id is set in the ident visitor *) |
174 | Ast0.Ident(id) -> Ast0.set_type e res; res | |
175 | | Ast0.Constant(const) -> | |
176 | (match Ast0.unwrap_mcode const with | |
177 | Ast.String(_) -> Some (T.Pointer(char_type)) | |
178 | | Ast.Char(_) -> Some (char_type) | |
179 | | Ast.Int(_) -> Some (int_type) | |
180 | | Ast.Float(_) -> Some (float_type)) | |
181 | (* pad: note that in C can do either ptr(...) or ( *ptr)(...) | |
182 | * so I am not sure this code is enough. | |
183 | *) | |
184 | | Ast0.FunCall(fn,lp,args,rp) -> | |
185 | (match Ast0.get_type fn with | |
186 | Some (T.FunctionPointer(ty)) -> Some ty | |
187 | | _ -> | |
188 | (match Ast0.unwrap fn with | |
189 | Ast0.Ident(id) -> | |
190 | (match Ast0.unwrap id with | |
191 | Ast0.Id(id) -> | |
192 | if List.mem (Ast0.unwrap_mcode id) bool_functions | |
193 | then Some(bool_type) | |
194 | else None | |
195 | | _ -> None) | |
196 | | _ -> None)) | |
197 | | Ast0.Assignment(exp1,op,exp2,_) -> | |
198 | let ty = lub_type (Ast0.get_type exp1) (Ast0.get_type exp2) in | |
199 | Ast0.set_type exp1 ty; Ast0.set_type exp2 ty; ty | |
17ba0788 | 200 | | Ast0.Sequence(exp1,op,exp2) -> Ast0.get_type exp2 |
951c7801 C |
201 | | Ast0.CondExpr(exp1,why,Some exp2,colon,exp3) -> |
202 | let ty = lub_type (Ast0.get_type exp2) (Ast0.get_type exp3) in | |
203 | Ast0.set_type exp2 ty; Ast0.set_type exp3 ty; ty | |
204 | | Ast0.CondExpr(exp1,why,None,colon,exp3) -> Ast0.get_type exp3 | |
205 | | Ast0.Postfix(exp,op) | Ast0.Infix(exp,op) -> (* op is dec or inc *) | |
206 | Ast0.get_type exp | |
207 | | Ast0.Unary(exp,op) -> | |
208 | (match Ast0.unwrap_mcode op with | |
209 | Ast.GetRef -> | |
210 | (match Ast0.get_type exp with | |
211 | None -> Some (T.Pointer(T.Unknown)) | |
212 | | Some t -> Some (T.Pointer(t))) | |
8babbc8f | 213 | | Ast.GetRefLabel -> Some (T.Pointer(void_type)) |
951c7801 C |
214 | | Ast.DeRef -> |
215 | (match Ast0.get_type exp with | |
216 | Some (T.Pointer(t)) -> Some t | |
217 | | _ -> None) | |
218 | | Ast.UnPlus -> Ast0.get_type exp | |
219 | | Ast.UnMinus -> Ast0.get_type exp | |
220 | | Ast.Tilde -> Ast0.get_type exp | |
221 | | Ast.Not -> Some(bool_type)) | |
222 | | Ast0.Nested(exp1,op,exp2) -> failwith "nested in type inf not possible" | |
223 | | Ast0.Binary(exp1,op,exp2) -> | |
224 | let ty1 = Ast0.get_type exp1 in | |
225 | let ty2 = Ast0.get_type exp2 in | |
226 | let same_type = function | |
227 | (None,None) -> Some (int_type) | |
91eba41f | 228 | |
951c7801 C |
229 | (* pad: pointer arithmetic handling as in ptr+1 *) |
230 | | (Some (T.Pointer ty1),Some ty2) when is_int_type ty2 -> | |
231 | Some (T.Pointer ty1) | |
232 | | (Some ty1,Some (T.Pointer ty2)) when is_int_type ty1 -> | |
233 | Some (T.Pointer ty2) | |
91eba41f | 234 | |
951c7801 C |
235 | | (t1,t2) -> |
236 | let ty = lub_type t1 t2 in | |
237 | Ast0.set_type exp1 ty; Ast0.set_type exp2 ty; ty in | |
238 | (match Ast0.unwrap_mcode op with | |
239 | Ast.Arith(op) -> same_type (ty1, ty2) | |
aa721442 C |
240 | | Ast.Logical(Ast.AndLog) | Ast.Logical(Ast.OrLog) -> |
241 | Some(bool_type) | |
951c7801 C |
242 | | Ast.Logical(op) -> |
243 | let ty = lub_type ty1 ty2 in | |
aa721442 C |
244 | Ast0.set_type exp1 ty; Ast0.set_type exp2 ty; |
245 | Some(bool_type)) | |
951c7801 C |
246 | | Ast0.Paren(lp,exp,rp) -> Ast0.get_type exp |
247 | | Ast0.ArrayAccess(exp1,lb,exp2,rb) -> | |
248 | (match strip_cv (Ast0.get_type exp2) with | |
249 | None -> Ast0.set_type exp2 (Some(int_type)) | |
250 | | Some(ty) when is_int_type ty -> () | |
aa721442 C |
251 | | Some(Type_cocci.Unknown) -> |
252 | (* unknown comes from param types, not sure why this | |
253 | is not just None... *) | |
254 | Ast0.set_type exp2 (Some(int_type)) | |
951c7801 C |
255 | | Some ty -> err exp2 ty "bad type for an array index"); |
256 | (match strip_cv (Ast0.get_type exp1) with | |
257 | None -> None | |
258 | | Some (T.Array(ty)) -> Some ty | |
259 | | Some (T.Pointer(ty)) -> Some ty | |
260 | | Some (T.MetaType(_,_,_)) -> None | |
261 | | Some x -> err exp1 x "ill-typed array reference") | |
262 | (* pad: should handle structure one day and look 'field' in environment *) | |
263 | | Ast0.RecordAccess(exp,pt,field) -> | |
264 | (match strip_cv (Ast0.get_type exp) with | |
265 | None -> None | |
e6509c05 | 266 | | Some (T.StructUnionName(_,_)) -> None |
951c7801 C |
267 | | Some (T.TypeName(_)) -> None |
268 | | Some (T.MetaType(_,_,_)) -> None | |
269 | | Some x -> err exp x "non-structure type in field ref") | |
270 | | Ast0.RecordPtAccess(exp,ar,field) -> | |
271 | (match strip_cv (Ast0.get_type exp) with | |
272 | None -> None | |
273 | | Some (T.Pointer(t)) -> | |
274 | (match strip_cv (Some t) with | |
275 | | Some (T.Unknown) -> None | |
276 | | Some (T.MetaType(_,_,_)) -> None | |
277 | | Some (T.TypeName(_)) -> None | |
e6509c05 | 278 | | Some (T.StructUnionName(_,_)) -> None |
951c7801 C |
279 | | Some x -> |
280 | err exp (T.Pointer(t)) | |
281 | "non-structure pointer type in field ref" | |
282 | | _ -> failwith "not possible") | |
283 | | Some (T.MetaType(_,_,_)) -> None | |
284 | | Some (T.TypeName(_)) -> None | |
285 | | Some x -> err exp x "non-structure pointer type in field ref") | |
286 | | Ast0.Cast(lp,ty,rp,exp) -> Some(Ast0.ast0_type_to_type ty) | |
287 | | Ast0.SizeOfExpr(szf,exp) -> Some(int_type) | |
288 | | Ast0.SizeOfType(szf,lp,ty,rp) -> Some(int_type) | |
289 | | Ast0.TypeExp(ty) -> None | |
7fe62b65 | 290 | | Ast0.Constructor(lp,ty,rp,init) -> Some(Ast0.ast0_type_to_type ty) |
951c7801 C |
291 | | Ast0.MetaErr(name,_,_) -> None |
292 | | Ast0.MetaExpr(name,_,Some [ty],_,_) -> Some ty | |
293 | | Ast0.MetaExpr(name,_,ty,_,_) -> None | |
294 | | Ast0.MetaExprList(name,_,_) -> None | |
295 | | Ast0.EComma(cm) -> None | |
296 | | Ast0.DisjExpr(_,exp_list,_,_) -> | |
297 | let types = List.map Ast0.get_type exp_list in | |
298 | let combined = List.fold_left lub_type None types in | |
299 | (match combined with | |
300 | None -> None | |
301 | | Some t -> | |
302 | List.iter (function e -> Ast0.set_type e (Some t)) exp_list; | |
303 | Some t) | |
304 | | Ast0.NestExpr(starter,expr_dots,ender,None,multi) -> | |
305 | let _ = r.VT0.combiner_rec_expression_dots expr_dots in None | |
306 | | Ast0.NestExpr(starter,expr_dots,ender,Some e,multi) -> | |
307 | let _ = r.VT0.combiner_rec_expression_dots expr_dots in | |
308 | let _ = r.VT0.combiner_rec_expression e in None | |
309 | | Ast0.Edots(_,None) | Ast0.Ecircles(_,None) | Ast0.Estars(_,None) -> | |
310 | None | |
311 | | Ast0.Edots(_,Some e) | Ast0.Ecircles(_,Some e) | |
312 | | Ast0.Estars(_,Some e) -> | |
313 | let _ = r.VT0.combiner_rec_expression e in None | |
314 | | Ast0.OptExp(exp) -> Ast0.get_type exp | |
17ba0788 C |
315 | | Ast0.UniqueExp(exp) -> Ast0.get_type exp |
316 | | Ast0.AsExpr _ -> failwith "not possible" in | |
951c7801 C |
317 | Ast0.set_type e ty; |
318 | ty in | |
34e49164 | 319 | |
34e49164 C |
320 | let rec strip id = |
321 | match Ast0.unwrap id with | |
d3f655c6 | 322 | Ast0.Id(name) -> [Id(Ast0.unwrap_mcode name)] |
8babbc8f | 323 | | Ast0.MetaId(name,_,_,_) -> [Meta(Ast0.unwrap_mcode name)] |
d3f655c6 C |
324 | | Ast0.MetaFunc(name,_,_) -> [Meta(Ast0.unwrap_mcode name)] |
325 | | Ast0.MetaLocalFunc(name,_,_) -> [Meta(Ast0.unwrap_mcode name)] | |
326 | | Ast0.DisjId(_,id_list,_,_) -> List.concat (List.map strip id_list) | |
951c7801 | 327 | | Ast0.OptIdent(id) -> strip id |
d6ce1786 C |
328 | | Ast0.UniqueIdent(id) -> strip id |
329 | | Ast0.AsIdent _ -> failwith "not possible" in | |
34e49164 | 330 | |
1be43e12 | 331 | let process_whencode notfn allfn exp = function |
34e49164 C |
332 | Ast0.WhenNot(x) -> let _ = notfn x in () |
333 | | Ast0.WhenAlways(x) -> let _ = allfn x in () | |
1be43e12 C |
334 | | Ast0.WhenModifier(_) -> () |
335 | | Ast0.WhenNotTrue(x) -> let _ = exp x in () | |
336 | | Ast0.WhenNotFalse(x) -> let _ = exp x in () in | |
34e49164 C |
337 | |
338 | (* assume that all of the declarations are at the beginning of a statement | |
339 | list, which is required by C, but not actually required by the cocci | |
340 | parser *) | |
341 | let rec process_statement_list r acc = function | |
342 | [] -> acc | |
343 | | (s::ss) -> | |
344 | (match Ast0.unwrap s with | |
345 | Ast0.Decl(_,decl) -> | |
fc1ad971 | 346 | let new_acc = (process_decl acc decl)@acc in |
34e49164 C |
347 | process_statement_list r new_acc ss |
348 | | Ast0.Dots(_,wc) -> | |
1be43e12 | 349 | (* why is this case here? why is there none for nests? *) |
34e49164 | 350 | List.iter |
b1b2de81 C |
351 | (process_whencode r.VT0.combiner_rec_statement_dots |
352 | r.VT0.combiner_rec_statement r.VT0.combiner_rec_expression) | |
34e49164 C |
353 | wc; |
354 | process_statement_list r acc ss | |
355 | | Ast0.Disj(_,statement_dots_list,_,_) -> | |
356 | let new_acc = | |
357 | lub_envs | |
358 | (List.map | |
359 | (function x -> process_statement_list r acc (Ast0.undots x)) | |
360 | statement_dots_list) in | |
361 | process_statement_list r new_acc ss | |
362 | | _ -> | |
b1b2de81 | 363 | let _ = (propagate_types acc).VT0.combiner_rec_statement s in |
fc1ad971 C |
364 | process_statement_list r acc ss) |
365 | ||
366 | and process_decl env decl = | |
367 | match Ast0.unwrap decl with | |
190f1acf C |
368 | Ast0.MetaDecl(_,_) | Ast0.MetaField(_,_) |
369 | | Ast0.MetaFieldList(_,_,_) -> [] | |
413ffc02 | 370 | | Ast0.Init(_,ty,id,_,exp,_) -> |
17ba0788 | 371 | let _ = (propagate_types env).VT0.combiner_rec_initialiser exp in |
d3f655c6 C |
372 | let ty = Ast0.ast0_type_to_type ty in |
373 | List.map (function i -> (i,ty)) (strip id) | |
fc1ad971 | 374 | | Ast0.UnInit(_,ty,id,_) -> |
d3f655c6 C |
375 | let ty = Ast0.ast0_type_to_type ty in |
376 | List.map (function i -> (i,ty)) (strip id) | |
fc1ad971 | 377 | | Ast0.MacroDecl(_,_,_,_,_) -> [] |
17ba0788 C |
378 | | Ast0.MacroDeclInit(_,_,_,_,_,exp,_) -> |
379 | let _ = (propagate_types env).VT0.combiner_rec_initialiser exp in | |
380 | [] | |
fc1ad971 C |
381 | | Ast0.TyDecl(ty,_) -> [] |
382 | (* pad: should handle typedef one day and add a binding *) | |
383 | | Ast0.Typedef(_,_,_,_) -> [] | |
384 | | Ast0.DisjDecl(_,disjs,_,_) -> | |
385 | List.concat(List.map (process_decl env) disjs) | |
386 | | Ast0.Ddots(_,_) -> [] (* not in a statement list anyway *) | |
387 | | Ast0.OptDecl(decl) -> process_decl env decl | |
17ba0788 C |
388 | | Ast0.UniqueDecl(decl) -> process_decl env decl |
389 | | Ast0.AsDecl _ -> failwith "not possible" in | |
34e49164 C |
390 | |
391 | let statement_dots r k d = | |
392 | match Ast0.unwrap d with | |
393 | Ast0.DOTS(l) | Ast0.CIRCLES(l) | Ast0.STARS(l) -> | |
394 | let _ = process_statement_list r env l in option_default in | |
fc1ad971 C |
395 | |
396 | let post_bool exp = | |
397 | let rec process_test exp = | |
398 | match (Ast0.unwrap exp,Ast0.get_type exp) with | |
399 | (Ast0.Edots(_,_),_) -> None | |
400 | | (Ast0.NestExpr(_,_,_,_,_),_) -> None | |
401 | | (Ast0.MetaExpr(_,_,_,_,_),_) -> | |
402 | (* if a type is known, it is specified in the decl *) | |
403 | None | |
404 | | (Ast0.Paren(lp,exp,rp),None) -> process_test exp | |
c3e37e97 C |
405 | (* the following doesn't seem like a good idea - triggers int isos |
406 | on all test expressions *) | |
407 | (*| (_,None) -> Some (int_type) *) | |
fc1ad971 C |
408 | | _ -> None in |
409 | let new_expty = process_test exp in | |
410 | (match new_expty with | |
411 | None -> () (* leave things as they are *) | |
412 | | Some ty -> Ast0.set_type exp new_expty) in | |
413 | ||
34e49164 C |
414 | let statement r k s = |
415 | match Ast0.unwrap s with | |
416 | Ast0.FunDecl(_,fninfo,name,lp,params,rp,lbrace,body,rbrace) -> | |
417 | let rec get_binding p = | |
418 | match Ast0.unwrap p with | |
419 | Ast0.Param(ty,Some id) -> | |
d3f655c6 C |
420 | let ty = Ast0.ast0_type_to_type ty in |
421 | List.map (function i -> (i,ty)) (strip id) | |
34e49164 C |
422 | | Ast0.OptParam(param) -> get_binding param |
423 | | _ -> [] in | |
424 | let fenv = List.concat (List.map get_binding (Ast0.undots params)) in | |
b1b2de81 | 425 | (propagate_types (fenv@env)).VT0.combiner_rec_statement_dots body |
34e49164 C |
426 | | Ast0.IfThen(_,_,exp,_,_,_) | Ast0.IfThenElse(_,_,exp,_,_,_,_,_) |
427 | | Ast0.While(_,_,exp,_,_,_) | Ast0.Do(_,_,_,_,exp,_,_) | |
fc1ad971 | 428 | | Ast0.For(_,_,_,_,Some exp,_,_,_,_,_) -> |
34e49164 | 429 | let _ = k s in |
fc1ad971 | 430 | post_bool exp; |
34e49164 | 431 | None |
fc1ad971 C |
432 | | Ast0.Switch(_,_,exp,_,_,decls,cases,_) -> |
433 | let senv = process_statement_list r env (Ast0.undots decls) in | |
434 | let res = | |
435 | (propagate_types (senv@env)).VT0.combiner_rec_case_line_dots cases in | |
436 | post_bool exp; | |
437 | res | |
34e49164 C |
438 | | _ -> k s |
439 | ||
440 | and case_line r k c = | |
441 | match Ast0.unwrap c with | |
fc1ad971 | 442 | Ast0.Case(case,exp,colon,code) -> |
34e49164 C |
443 | let _ = k c in |
444 | (match Ast0.get_type exp with | |
faf9a90c | 445 | None -> Ast0.set_type exp (Some (int_type)) |
34e49164 C |
446 | | _ -> ()); |
447 | None | |
fc1ad971 | 448 | | _ -> k c in |
34e49164 C |
449 | |
450 | V0.combiner bind option_default | |
b1b2de81 C |
451 | {V0.combiner_functions with |
452 | VT0.combiner_dotsstmtfn = statement_dots; | |
453 | VT0.combiner_identfn = ident; | |
454 | VT0.combiner_exprfn = expression; | |
455 | VT0.combiner_stmtfn = statement; | |
456 | VT0.combiner_casefn = case_line} | |
34e49164 C |
457 | |
458 | let type_infer code = | |
459 | let prop = propagate_types [(Id("NULL"),T.Pointer(T.Unknown))] in | |
b1b2de81 | 460 | let fn = prop.VT0.combiner_rec_top_level in |
34e49164 C |
461 | let _ = List.map fn code in |
462 | () |