Commit | Line | Data |
---|---|---|
978fd7e5 C |
1 | (* Yoann Padioleau |
2 | * | |
3 | * Copyright (C) 2006, 2007, 2008 Ecole des Mines de Nantes | |
4 | * | |
5 | * This program is free software; you can redistribute it and/or | |
6 | * modify it under the terms of the GNU General Public License (GPL) | |
7 | * version 2 as published by the Free Software Foundation. | |
8 | * | |
9 | * This program is distributed in the hope that it will be useful, | |
10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
12 | * file license.txt for more details. | |
13 | *) | |
14 | ||
15 | open Common | |
16 | ||
17 | ||
18 | (*****************************************************************************) | |
19 | (* Wrappers *) | |
20 | (*****************************************************************************) | |
21 | let pr2_err, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_parsing | |
22 | ||
23 | (*****************************************************************************) | |
24 | (* Consistency checking *) | |
25 | (*****************************************************************************) | |
26 | ||
27 | (* todo: | |
28 | * could check that an ident has always the same class, be it a typedef | |
29 | * (but sometimes do 'acpi_val acpi_val;'), an ident, a TMacroStatement, | |
30 | * etc. | |
31 | *) | |
32 | ||
33 | type class_ident = | |
34 | | CIdent (* can be var, func, field, tag, enum constant *) | |
35 | | CTypedef | |
36 | ||
37 | let str_of_class_ident = function | |
38 | | CIdent -> "Ident" | |
39 | | CTypedef -> "Typedef" | |
40 | ||
41 | (* | |
42 | | CMacro | |
43 | | CMacroString | |
44 | | CMacroStmt | |
45 | | CMacroDecl | |
46 | | CMacroIterator | |
47 | | CAttr | |
48 | ||
49 | (* but take care that must still be able to use '=' *) | |
50 | type context = InFunction | InEnum | InStruct | InInitializer | InParams | |
51 | type class_token = | |
52 | | CIdent of class_ident | |
53 | ||
54 | | CComment | |
55 | | CSpace | |
56 | | CCommentCpp of cppkind | |
57 | | CCommentMisc | |
58 | | CCppDirective | |
59 | ||
60 | | COPar | |
61 | | CCPar | |
62 | | COBrace | |
63 | | CCBrace | |
64 | ||
65 | | CSymbol | |
66 | | CReservedKwd (type | decl | qualif | flow | misc | attr) | |
67 | *) | |
68 | ||
69 | let ident_to_typename ident : Ast_c.fullType = | |
70 | Ast_c.mk_ty (Ast_c.TypeName (ident, Ast_c.noTypedefDef())) Ast_c.noii | |
71 | ||
72 | ||
73 | (* parse_typedef_fix4 *) | |
74 | let consistency_checking2 xs = | |
75 | ||
76 | (* first phase, gather data *) | |
77 | let stat = Hashtbl.create 101 in | |
78 | ||
79 | (* default value for hash *) | |
80 | let v1 () = Hashtbl.create 101 in | |
81 | let v2 () = ref 0 in | |
82 | ||
83 | let bigf = { Visitor_c.default_visitor_c with | |
84 | ||
85 | Visitor_c.kexpr = (fun (k,bigf) x -> | |
86 | match Ast_c.unwrap_expr x with | |
87 | | Ast_c.Ident (id) -> | |
88 | let s = Ast_c.str_of_name id in | |
89 | stat +> | |
90 | Common.hfind_default s v1 +> Common.hfind_default CIdent v2 +> | |
91 | (fun aref -> incr aref) | |
92 | ||
93 | | _ -> k x | |
94 | ); | |
95 | Visitor_c.ktype = (fun (k,bigf) t -> | |
96 | match Ast_c.unwrap_typeC t with | |
97 | | Ast_c.TypeName (name,_typ) -> | |
98 | let s = Ast_c.str_of_name name in | |
99 | stat +> | |
100 | Common.hfind_default s v1 +> Common.hfind_default CTypedef v2 +> | |
101 | (fun aref -> incr aref) | |
102 | ||
103 | | _ -> k t | |
104 | ); | |
105 | } | |
106 | in | |
107 | xs +> List.iter (fun (p) -> Visitor_c.vk_toplevel bigf p); | |
108 | ||
109 | ||
110 | let ident_to_type = ref [] in | |
111 | ||
112 | ||
113 | (* second phase, analyze data *) | |
114 | stat +> Hashtbl.iter (fun k v -> | |
115 | let xs = Common.hash_to_list v in | |
116 | if List.length xs >= 2 | |
117 | then begin | |
118 | pr2_err ("CONFLICT:" ^ k); | |
119 | let sorted = xs +> List.sort (fun (ka,va) (kb,vb) -> | |
120 | if !va =|= !vb then | |
121 | (match ka, kb with | |
122 | | CTypedef, _ -> 1 (* first is smaller *) | |
123 | | _, CTypedef -> -1 | |
124 | | _ -> 0 | |
125 | ) | |
126 | else compare !va !vb | |
127 | ) in | |
128 | let sorted = List.rev sorted in | |
129 | match sorted with | |
130 | | [CTypedef, i1;CIdent, i2] -> | |
131 | pr2_err ("transforming some ident in typedef"); | |
132 | push2 k ident_to_type; | |
133 | | _ -> | |
134 | pr2_err ("TODO:other transforming?"); | |
135 | ||
136 | end | |
137 | ); | |
138 | ||
139 | (* third phase, update ast. | |
140 | * todo? but normally should try to handle correctly scope ? maybe sometime | |
141 | * sizeof(id) and even if id was for a long time an identifier, maybe | |
142 | * a few time, because of the scope it's actually really a type. | |
143 | *) | |
144 | if (null !ident_to_type) | |
145 | then xs | |
146 | else | |
147 | let bigf = { Visitor_c.default_visitor_c_s with | |
148 | Visitor_c.kdefineval_s = (fun (k,bigf) x -> | |
149 | match x with | |
150 | | Ast_c.DefineExpr e -> | |
151 | (match Ast_c.unwrap_expr e with | |
152 | | Ast_c.Ident (ident) -> | |
153 | let s = Ast_c.str_of_name ident in | |
154 | if List.mem s !ident_to_type | |
155 | then | |
156 | let t = ident_to_typename ident in | |
157 | Ast_c.DefineType t | |
158 | else k x | |
159 | | _ -> k x | |
160 | ) | |
161 | | _ -> k x | |
162 | ); | |
163 | Visitor_c.kexpr_s = (fun (k, bigf) x -> | |
164 | match Ast_c.get_e_and_ii x with | |
165 | | (Ast_c.SizeOfExpr e, tref), isizeof -> | |
166 | let i1 = tuple_of_list1 isizeof in | |
167 | (match Ast_c.get_e_and_ii e with | |
168 | | (Ast_c.ParenExpr e, _), iiparen -> | |
169 | let (i2, i3) = tuple_of_list2 iiparen in | |
170 | (match Ast_c.get_e_and_ii e with | |
171 | | (Ast_c.Ident (ident), _), _ii -> | |
172 | ||
173 | let s = Ast_c.str_of_name ident in | |
174 | if List.mem s !ident_to_type | |
175 | then | |
176 | let t = ident_to_typename ident in | |
177 | (Ast_c.SizeOfType t, tref),[i1;i2;i3] | |
178 | else k x | |
179 | | _ -> k x | |
180 | ) | |
181 | | _ -> k x | |
182 | ) | |
183 | | _ -> k x | |
184 | ); | |
185 | } in | |
186 | xs +> List.map (fun (p) -> | |
187 | Visitor_c.vk_toplevel_s bigf p | |
188 | ) | |
189 | ||
190 | ||
191 | let consistency_checking a = | |
192 | Common.profile_code "C consistencycheck" (fun () -> consistency_checking2 a) | |
193 | ||
194 | ||
195 |