HCoop / bpt / coccinelle.git / blob
? search:


bd217ccc53b72da6f0bbd2deda7b1aab26881926
[bpt/coccinelle.git] / parsing_cocci / .#parse_cocci.ml.1.178
1 (*
2 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
4 * This file is part of Coccinelle.
5 *
6 * Coccinelle is free software: you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation, according to version 2 of the License.
9 *
10 * Coccinelle is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
17 *
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
20 *)
21
22
23 (* splits the entire file into minus and plus fragments, and parses each
24 separately (thus duplicating work for the parsing of the context elements) *)
25
26 module D = Data
27 module PC = Parser_cocci_menhir
28 module V0 = Visitor_ast0
29 module Ast = Ast_cocci
30 module Ast0 = Ast0_cocci
31 let pr = Printf.sprintf
32 (*let pr2 s = prerr_string s; prerr_string "\n"; flush stderr*)
33 let pr2 s = Printf.printf "%s\n" s
34
35 (* for isomorphisms. all should be at the front!!! *)
36 let reserved_names =
37 ["all";"optional_storage";"optional_qualifier";"value_format";"comm_assoc"]
38
39 (* ----------------------------------------------------------------------- *)
40 (* Debugging... *)
41
42 let line_type (d,_,_,_,_,_,_,_) = d
43
44 let line_type2c tok =
45 match line_type tok with
46 D.MINUS | D.OPTMINUS | D.UNIQUEMINUS -> ":-"
47 | D.PLUS -> ":+"
48 | D.CONTEXT | D.UNIQUE | D.OPT -> ""
49
50 let token2c (tok,_) =
51 match tok with
52 PC.TIdentifier -> "identifier"
53 | PC.TType -> "type"
54 | PC.TParameter -> "parameter"
55 | PC.TConstant -> "constant"
56 | PC.TExpression -> "expression"
57 | PC.TIdExpression -> "idexpression"
58 | PC.TStatement -> "statement"
59 | PC.TPosition -> "position"
60 | PC.TPosAny -> "any"
61 | PC.TFunction -> "function"
62 | PC.TLocal -> "local"
63 | PC.Tlist -> "list"
64 | PC.TFresh -> "fresh"
65 | PC.TPure -> "pure"
66 | PC.TContext -> "context"
67 | PC.TTypedef -> "typedef"
68 | PC.TDeclarer -> "declarer"
69 | PC.TIterator -> "iterator"
70 | PC.TName -> "name"
71 | PC.TRuleName str -> "rule_name-"^str
72 | PC.TUsing -> "using"
73 | PC.TPathIsoFile str -> "path_iso_file-"^str
74 | PC.TDisable -> "disable"
75 | PC.TExtends -> "extends"
76 | PC.TDepends -> "depends"
77 | PC.TOn -> "on"
78 | PC.TEver -> "ever"
79 | PC.TNever -> "never"
80 | PC.TExists -> "exists"
81 | PC.TForall -> "forall"
82 | PC.TReverse -> "reverse"
83 | PC.TError -> "error"
84 | PC.TWords -> "words"
85 | PC.TGenerated -> "generated"
86
87 | PC.TNothing -> "nothing"
88
89 | PC.Tchar(clt) -> "char"^(line_type2c clt)
90 | PC.Tshort(clt) -> "short"^(line_type2c clt)
91 | PC.Tint(clt) -> "int"^(line_type2c clt)
92 | PC.Tdouble(clt) -> "double"^(line_type2c clt)
93 | PC.Tfloat(clt) -> "float"^(line_type2c clt)
94 | PC.Tlong(clt) -> "long"^(line_type2c clt)
95 | PC.Tvoid(clt) -> "void"^(line_type2c clt)
96 | PC.Tstruct(clt) -> "struct"^(line_type2c clt)
97 | PC.Tunion(clt) -> "union"^(line_type2c clt)
98 | PC.Tenum(clt) -> "enum"^(line_type2c clt)
99 | PC.Tunsigned(clt) -> "unsigned"^(line_type2c clt)
100 | PC.Tsigned(clt) -> "signed"^(line_type2c clt)
101 | PC.Tstatic(clt) -> "static"^(line_type2c clt)
102 | PC.Tinline(clt) -> "inline"^(line_type2c clt)
103 | PC.Ttypedef(clt) -> "typedef"^(line_type2c clt)
104 | PC.Tattr(s,clt) -> s^(line_type2c clt)
105 | PC.Tauto(clt) -> "auto"^(line_type2c clt)
106 | PC.Tregister(clt) -> "register"^(line_type2c clt)
107 | PC.Textern(clt) -> "extern"^(line_type2c clt)
108 | PC.Tconst(clt) -> "const"^(line_type2c clt)
109 | PC.Tvolatile(clt) -> "volatile"^(line_type2c clt)
110
111 | PC.TPragma(s) -> s
112 | PC.TIncludeL(s,clt) -> (pr "#include \"%s\"" s)^(line_type2c clt)
113 | PC.TIncludeNL(s,clt) -> (pr "#include <%s>" s)^(line_type2c clt)
114 | PC.TDefine(clt,_) -> "#define"^(line_type2c clt)
115 | PC.TDefineParam(clt,_,_) -> "#define_param"^(line_type2c clt)
116 | PC.TMinusFile(s,clt) -> (pr "--- %s" s)^(line_type2c clt)
117 | PC.TPlusFile(s,clt) -> (pr "+++ %s" s)^(line_type2c clt)
118
119 | PC.TInc(clt) -> "++"^(line_type2c clt)
120 | PC.TDec(clt) -> "--"^(line_type2c clt)
121
122 | PC.TIf(clt) -> "if"^(line_type2c clt)
123 | PC.TElse(clt) -> "else"^(line_type2c clt)
124 | PC.TWhile(clt) -> "while"^(line_type2c clt)
125 | PC.TFor(clt) -> "for"^(line_type2c clt)
126 | PC.TDo(clt) -> "do"^(line_type2c clt)
127 | PC.TSwitch(clt) -> "switch"^(line_type2c clt)
128 | PC.TCase(clt) -> "case"^(line_type2c clt)
129 | PC.TDefault(clt) -> "default"^(line_type2c clt)
130 | PC.TReturn(clt) -> "return"^(line_type2c clt)
131 | PC.TBreak(clt) -> "break"^(line_type2c clt)
132 | PC.TContinue(clt) -> "continue"^(line_type2c clt)
133 | PC.TGoto(clt) -> "goto"^(line_type2c clt)
134 | PC.TIdent(s,clt) -> (pr "ident-%s" s)^(line_type2c clt)
135 | PC.TTypeId(s,clt) -> (pr "typename-%s" s)^(line_type2c clt)
136 | PC.TDeclarerId(s,clt) -> (pr "declarername-%s" s)^(line_type2c clt)
137 | PC.TIteratorId(s,clt) -> (pr "iteratorname-%s" s)^(line_type2c clt)
138 | PC.TMetaDeclarer(_,_,_,clt) -> "declmeta"^(line_type2c clt)
139 | PC.TMetaIterator(_,_,_,clt) -> "itermeta"^(line_type2c clt)
140
141 | PC.TSizeof(clt) -> "sizeof"^(line_type2c clt)
142
143 | PC.TString(x,clt) -> x^(line_type2c clt)
144 | PC.TChar(x,clt) -> x^(line_type2c clt)
145 | PC.TFloat(x,clt) -> x^(line_type2c clt)
146 | PC.TInt(x,clt) -> x^(line_type2c clt)
147
148 | PC.TOrLog(clt) -> "||"^(line_type2c clt)
149 | PC.TAndLog(clt) -> "&&"^(line_type2c clt)
150 | PC.TOr(clt) -> "|"^(line_type2c clt)
151 | PC.TXor(clt) -> "^"^(line_type2c clt)
152 | PC.TAnd (clt) -> "&"^(line_type2c clt)
153 | PC.TEqEq(clt) -> "=="^(line_type2c clt)
154 | PC.TNotEq(clt) -> "!="^(line_type2c clt)
155 | PC.TLogOp(op,clt) ->
156 (match op with
157 Ast.Inf -> "<"
158 | Ast.InfEq -> "<="
159 | Ast.Sup -> ">"
160 | Ast.SupEq -> ">="
161 | _ -> failwith "not possible")
162 ^(line_type2c clt)
163 | PC.TShOp(op,clt) ->
164 (match op with
165 Ast.DecLeft -> "<<"
166 | Ast.DecRight -> ">>"
167 | _ -> failwith "not possible")
168 ^(line_type2c clt)
169 | PC.TPlus(clt) -> "+"^(line_type2c clt)
170 | PC.TMinus(clt) -> "-"^(line_type2c clt)
171 | PC.TMul(clt) -> "*"^(line_type2c clt)
172 | PC.TDmOp(op,clt) ->
173 (match op with
174 Ast.Div -> "/"
175 | Ast.Mod -> "%"
176 | _ -> failwith "not possible")
177 ^(line_type2c clt)
178 | PC.TTilde (clt) -> "~"^(line_type2c clt)
179
180 | PC.TMetaParam(_,_,clt) -> "parammeta"^(line_type2c clt)
181 | PC.TMetaParamList(_,_,_,clt) -> "paramlistmeta"^(line_type2c clt)
182 | PC.TMetaConst(_,_,_,_,clt) -> "constmeta"^(line_type2c clt)
183 | PC.TMetaErr(_,_,_,clt) -> "errmeta"^(line_type2c clt)
184 | PC.TMetaExp(_,_,_,_,clt) -> "expmeta"^(line_type2c clt)
185 | PC.TMetaIdExp(_,_,_,_,clt) -> "idexpmeta"^(line_type2c clt)
186 | PC.TMetaLocalIdExp(_,_,_,_,clt) -> "localidexpmeta"^(line_type2c clt)
187 | PC.TMetaExpList(_,_,_,clt) -> "explistmeta"^(line_type2c clt)
188 | PC.TMetaId(_,_,_,clt) -> "idmeta"^(line_type2c clt)
189 | PC.TMetaType(_,_,clt) -> "typemeta"^(line_type2c clt)
190 | PC.TMetaStm(_,_,clt) -> "stmmeta"^(line_type2c clt)
191 | PC.TMetaStmList(_,_,clt) -> "stmlistmeta"^(line_type2c clt)
192 | PC.TMetaFunc(_,_,_,clt) -> "funcmeta"^(line_type2c clt)
193 | PC.TMetaLocalFunc(_,_,_,clt) -> "funcmeta"^(line_type2c clt)
194 | PC.TMetaPos(_,_,_,clt) -> "posmeta"
195 | PC.TMPtVirg -> ";"
196 | PC.TArobArob -> "@@"
197 | PC.TArob -> "@"
198 | PC.TPArob -> "P@"
199 | PC.TScript -> "script"
200
201 | PC.TWhen(clt) -> "WHEN"^(line_type2c clt)
202 | PC.TWhenTrue(clt) -> "WHEN TRUE"^(line_type2c clt)
203 | PC.TWhenFalse(clt) -> "WHEN FALSE"^(line_type2c clt)
204 | PC.TAny(clt) -> "ANY"^(line_type2c clt)
205 | PC.TStrict(clt) -> "STRICT"^(line_type2c clt)
206 | PC.TEllipsis(clt) -> "..."^(line_type2c clt)
207 (*
208 | PC.TCircles(clt) -> "ooo"^(line_type2c clt)
209 | PC.TStars(clt) -> "***"^(line_type2c clt)
210 *)
211
212 | PC.TOEllipsis(clt) -> "<..."^(line_type2c clt)
213 | PC.TCEllipsis(clt) -> "...>"^(line_type2c clt)
214 | PC.TPOEllipsis(clt) -> "<+..."^(line_type2c clt)
215 | PC.TPCEllipsis(clt) -> "...+>"^(line_type2c clt)
216 (*
217 | PC.TOCircles(clt) -> "<ooo"^(line_type2c clt)
218 | PC.TCCircles(clt) -> "ooo>"^(line_type2c clt)
219 | PC.TOStars(clt) -> "<***"^(line_type2c clt)
220 | PC.TCStars(clt) -> "***>"^(line_type2c clt)
221 *)
222 | PC.TBang0 -> "!"
223 | PC.TPlus0 -> "+"
224 | PC.TWhy0 -> "?"
225
226 | PC.TWhy(clt) -> "?"^(line_type2c clt)
227 | PC.TDotDot(clt) -> ":"^(line_type2c clt)
228 | PC.TBang(clt) -> "!"^(line_type2c clt)
229 | PC.TOPar(clt) -> "("^(line_type2c clt)
230 | PC.TOPar0(clt) -> "("^(line_type2c clt)
231 | PC.TMid0(clt) -> "|"^(line_type2c clt)
232 | PC.TCPar(clt) -> ")"^(line_type2c clt)
233 | PC.TCPar0(clt) -> ")"^(line_type2c clt)
234
235 | PC.TOBrace(clt) -> "{"^(line_type2c clt)
236 | PC.TCBrace(clt) -> "}"^(line_type2c clt)
237 | PC.TOCro(clt) -> "["^(line_type2c clt)
238 | PC.TCCro(clt) -> "]"^(line_type2c clt)
239 | PC.TOInit(clt) -> "{"^(line_type2c clt)
240
241 | PC.TPtrOp(clt) -> "->"^(line_type2c clt)
242
243 | PC.TEq(clt) -> "="^(line_type2c clt)
244 | PC.TAssign(_,clt) -> "=op"^(line_type2c clt)
245 | PC.TDot(clt) -> "."^(line_type2c clt)
246 | PC.TComma(clt) -> ","^(line_type2c clt)
247 | PC.TPtVirg(clt) -> ";"^(line_type2c clt)
248
249 | PC.EOF -> "eof"
250 | PC.TLineEnd(clt) -> "line end"
251 | PC.TInvalid -> "invalid"
252 | PC.TFunDecl(clt) -> "fundecl"
253
254 | PC.TIso -> "<=>"
255 | PC.TRightIso -> "=>"
256 | PC.TIsoTopLevel -> "TopLevel"
257 | PC.TIsoExpression -> "Expression"
258 | PC.TIsoArgExpression -> "ArgExpression"
259 | PC.TIsoTestExpression -> "TestExpression"
260 | PC.TIsoStatement -> "Statement"
261 | PC.TIsoDeclaration -> "Declaration"
262 | PC.TIsoType -> "Type"
263 | PC.TScriptData s -> s
264
265 let print_tokens s tokens =
266 Printf.printf "%s\n" s;
267 List.iter (function x -> Printf.printf "%s " (token2c x)) tokens;
268 Printf.printf "\n\n";
269 flush stdout
270
271 type plus = PLUS | NOTPLUS | SKIP
272
273 let plus_attachable (tok,_) =
274 match tok with
275 PC.Tchar(clt) | PC.Tshort(clt) | PC.Tint(clt) | PC.Tdouble(clt)
276 | PC.Tfloat(clt) | PC.Tlong(clt) | PC.Tvoid(clt) | PC.Tstruct(clt)
277 | PC.Tunion(clt) | PC.Tenum(clt) | PC.Tunsigned(clt) | PC.Tsigned(clt)
278 | PC.Tstatic(clt)
279 | PC.Tinline(clt) | PC.Ttypedef(clt) | PC.Tattr(_,clt)
280 | PC.Tauto(clt) | PC.Tregister(clt)
281 | PC.Textern(clt) | PC.Tconst(clt) | PC.Tvolatile(clt)
282
283 | PC.TIncludeL(_,clt) | PC.TIncludeNL(_,clt) | PC.TDefine(clt,_)
284 | PC.TDefineParam(clt,_,_) | PC.TMinusFile(_,clt) | PC.TPlusFile(_,clt)
285
286 | PC.TInc(clt) | PC.TDec(clt)
287
288 | PC.TIf(clt) | PC.TElse(clt) | PC.TWhile(clt) | PC.TFor(clt) | PC.TDo(clt)
289 | PC.TSwitch(clt) | PC.TCase(clt) | PC.TDefault(clt) | PC.TReturn(clt)
290 | PC.TBreak(clt) | PC.TContinue(clt) | PC.TGoto(clt) | PC.TIdent(_,clt)
291 | PC.TTypeId(_,clt) | PC.TDeclarerId(_,clt) | PC.TIteratorId(_,clt)
292
293 | PC.TSizeof(clt)
294
295 | PC.TString(_,clt) | PC.TChar(_,clt) | PC.TFloat(_,clt) | PC.TInt(_,clt)
296
297 | PC.TOrLog(clt) | PC.TAndLog(clt) | PC.TOr(clt) | PC.TXor(clt)
298 | PC.TAnd (clt) | PC.TEqEq(clt) | PC.TNotEq(clt) | PC.TLogOp(_,clt)
299 | PC.TShOp(_,clt) | PC.TPlus(clt) | PC.TMinus(clt) | PC.TMul(clt)
300 | PC.TDmOp(_,clt) | PC.TTilde (clt)
301
302 | PC.TMetaParam(_,_,clt) | PC.TMetaParamList(_,_,_,clt)
303 | PC.TMetaConst(_,_,_,_,clt) | PC.TMetaErr(_,_,_,clt)
304 | PC.TMetaExp(_,_,_,_,clt) | PC.TMetaIdExp(_,_,_,_,clt)
305 | PC.TMetaLocalIdExp(_,_,_,_,clt)
306 | PC.TMetaExpList(_,_,_,clt)
307 | PC.TMetaId(_,_,_,clt)
308 | PC.TMetaType(_,_,clt) | PC.TMetaStm(_,_,clt)
309 | PC.TMetaStmList(_,_,clt) | PC.TMetaFunc(_,_,_,clt)
310 | PC.TMetaLocalFunc(_,_,_,clt)
311
312 | PC.TWhen(clt) | PC.TWhenTrue(clt) | PC.TWhenFalse(clt)
313 | PC.TAny(clt) | PC.TStrict(clt) | PC.TEllipsis(clt)
314 (* | PC.TCircles(clt) | PC.TStars(clt) *)
315
316 | PC.TWhy(clt) | PC.TDotDot(clt) | PC.TBang(clt) | PC.TOPar(clt)
317 | PC.TCPar(clt)
318
319 | PC.TOBrace(clt) | PC.TCBrace(clt) | PC.TOCro(clt) | PC.TCCro(clt)
320 | PC.TOInit(clt)
321
322 | PC.TPtrOp(clt)
323
324 | PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt)
325 | PC.TPtVirg(clt) ->
326 if line_type clt = D.PLUS then PLUS else NOTPLUS
327
328 | PC.TOPar0(clt) | PC.TMid0(clt) | PC.TCPar0(clt)
329 | PC.TOEllipsis(clt) | PC.TCEllipsis(clt)
330 | PC.TPOEllipsis(clt) | PC.TPCEllipsis(clt) (* | PC.TOCircles(clt)
331 | PC.TCCircles(clt) | PC.TOStars(clt) | PC.TCStars(clt) *) -> NOTPLUS
332 | PC.TMetaPos(nm,_,_,_) -> NOTPLUS
333
334 | _ -> SKIP
335
336 let get_clt (tok,_) =
337 match tok with
338 PC.Tchar(clt) | PC.Tshort(clt) | PC.Tint(clt) | PC.Tdouble(clt)
339 | PC.Tfloat(clt) | PC.Tlong(clt) | PC.Tvoid(clt) | PC.Tstruct(clt)
340 | PC.Tunion(clt) | PC.Tenum(clt) | PC.Tunsigned(clt) | PC.Tsigned(clt)
341 | PC.Tstatic(clt)
342 | PC.Tinline(clt) | PC.Tattr(_,clt) | PC.Tauto(clt) | PC.Tregister(clt)
343 | PC.Textern(clt) | PC.Tconst(clt) | PC.Tvolatile(clt)
344
345 | PC.TIncludeL(_,clt) | PC.TIncludeNL(_,clt) | PC.TDefine(clt,_)
346 | PC.TDefineParam(clt,_,_) | PC.TMinusFile(_,clt) | PC.TPlusFile(_,clt)
347
348 | PC.TInc(clt) | PC.TDec(clt)
349
350 | PC.TIf(clt) | PC.TElse(clt) | PC.TWhile(clt) | PC.TFor(clt) | PC.TDo(clt)
351 | PC.TSwitch(clt) | PC.TCase(clt) | PC.TDefault(clt) | PC.TReturn(clt)
352 | PC.TBreak(clt) | PC.TContinue(clt) | PC.TGoto(clt) | PC.TIdent(_,clt)
353 | PC.TTypeId(_,clt) | PC.TDeclarerId(_,clt) | PC.TIteratorId(_,clt)
354
355 | PC.TSizeof(clt)
356
357 | PC.TString(_,clt) | PC.TChar(_,clt) | PC.TFloat(_,clt) | PC.TInt(_,clt)
358
359 | PC.TOrLog(clt) | PC.TAndLog(clt) | PC.TOr(clt) | PC.TXor(clt)
360 | PC.TAnd (clt) | PC.TEqEq(clt) | PC.TNotEq(clt) | PC.TLogOp(_,clt)
361 | PC.TShOp(_,clt) | PC.TPlus(clt) | PC.TMinus(clt) | PC.TMul(clt)
362 | PC.TDmOp(_,clt) | PC.TTilde (clt)
363
364 | PC.TMetaParam(_,_,clt) | PC.TMetaParamList(_,_,_,clt)
365 | PC.TMetaConst(_,_,_,_,clt) | PC.TMetaErr(_,_,_,clt)
366 | PC.TMetaExp(_,_,_,_,clt) | PC.TMetaIdExp(_,_,_,_,clt)
367 | PC.TMetaLocalIdExp(_,_,_,_,clt)
368 | PC.TMetaExpList(_,_,_,clt)
369 | PC.TMetaId(_,_,_,clt)
370 | PC.TMetaType(_,_,clt) | PC.TMetaStm(_,_,clt)
371 | PC.TMetaStmList(_,_,clt) | PC.TMetaFunc(_,_,_,clt)
372 | PC.TMetaLocalFunc(_,_,_,clt) | PC.TMetaPos(_,_,_,clt)
373
374 | PC.TWhen(clt) | PC.TWhenTrue(clt) | PC.TWhenFalse(clt) |
375 PC.TAny(clt) | PC.TStrict(clt) | PC.TEllipsis(clt)
376 (* | PC.TCircles(clt) | PC.TStars(clt) *)
377
378 | PC.TWhy(clt) | PC.TDotDot(clt) | PC.TBang(clt) | PC.TOPar(clt)
379 | PC.TCPar(clt)
380
381 | PC.TOBrace(clt) | PC.TCBrace(clt) | PC.TOCro(clt) | PC.TCCro(clt)
382 | PC.TOInit(clt)
383
384 | PC.TPtrOp(clt)
385
386 | PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt)
387 | PC.TPtVirg(clt)
388
389 | PC.TOPar0(clt) | PC.TMid0(clt) | PC.TCPar0(clt)
390 | PC.TOEllipsis(clt) | PC.TCEllipsis(clt)
391 | PC.TPOEllipsis(clt) | PC.TPCEllipsis(clt) (* | PC.TOCircles(clt)
392 | PC.TCCircles(clt) | PC.TOStars(clt) | PC.TCStars(clt) *) -> clt
393
394 | _ -> failwith "no clt"
395
396 let update_clt (tok,x) clt =
397 match tok with
398 PC.Tchar(_) -> (PC.Tchar(clt),x)
399 | PC.Tshort(_) -> (PC.Tshort(clt),x)
400 | PC.Tint(_) -> (PC.Tint(clt),x)
401 | PC.Tdouble(_) -> (PC.Tdouble(clt),x)
402 | PC.Tfloat(_) -> (PC.Tfloat(clt),x)
403 | PC.Tlong(_) -> (PC.Tlong(clt),x)
404 | PC.Tvoid(_) -> (PC.Tvoid(clt),x)
405 | PC.Tstruct(_) -> (PC.Tstruct(clt),x)
406 | PC.Tunion(_) -> (PC.Tunion(clt),x)
407 | PC.Tenum(_) -> (PC.Tenum(clt),x)
408 | PC.Tunsigned(_) -> (PC.Tunsigned(clt),x)
409 | PC.Tsigned(_) -> (PC.Tsigned(clt),x)
410 | PC.Tstatic(_) -> (PC.Tstatic(clt),x)
411 | PC.Tinline(_) -> (PC.Tinline(clt),x)
412 | PC.Ttypedef(_) -> (PC.Ttypedef(clt),x)
413 | PC.Tattr(s,_) -> (PC.Tattr(s,clt),x)
414 | PC.Tauto(_) -> (PC.Tauto(clt),x)
415 | PC.Tregister(_) -> (PC.Tregister(clt),x)
416 | PC.Textern(_) -> (PC.Textern(clt),x)
417 | PC.Tconst(_) -> (PC.Tconst(clt),x)
418 | PC.Tvolatile(_) -> (PC.Tvolatile(clt),x)
419
420 | PC.TIncludeL(s,_) -> (PC.TIncludeL(s,clt),x)
421 | PC.TIncludeNL(s,_) -> (PC.TIncludeNL(s,clt),x)
422 | PC.TDefine(_,a) -> (PC.TDefine(clt,a),x)
423 | PC.TDefineParam(_,a,b) -> (PC.TDefineParam(clt,a,b),x)
424 | PC.TMinusFile(s,_) -> (PC.TMinusFile(s,clt),x)
425 | PC.TPlusFile(s,_) -> (PC.TPlusFile(s,clt),x)
426
427 | PC.TInc(_) -> (PC.TInc(clt),x)
428 | PC.TDec(_) -> (PC.TDec(clt),x)
429
430 | PC.TIf(_) -> (PC.TIf(clt),x)
431 | PC.TElse(_) -> (PC.TElse(clt),x)
432 | PC.TWhile(_) -> (PC.TWhile(clt),x)
433 | PC.TFor(_) -> (PC.TFor(clt),x)
434 | PC.TDo(_) -> (PC.TDo(clt),x)
435 | PC.TSwitch(_) -> (PC.TSwitch(clt),x)
436 | PC.TCase(_) -> (PC.TCase(clt),x)
437 | PC.TDefault(_) -> (PC.TDefault(clt),x)
438 | PC.TReturn(_) -> (PC.TReturn(clt),x)
439 | PC.TBreak(_) -> (PC.TBreak(clt),x)
440 | PC.TContinue(_) -> (PC.TContinue(clt),x)
441 | PC.TGoto(_) -> (PC.TGoto(clt),x)
442 | PC.TIdent(s,_) -> (PC.TIdent(s,clt),x)
443 | PC.TTypeId(s,_) -> (PC.TTypeId(s,clt),x)
444 | PC.TDeclarerId(s,_) -> (PC.TDeclarerId(s,clt),x)
445 | PC.TIteratorId(s,_) -> (PC.TIteratorId(s,clt),x)
446
447 | PC.TSizeof(_) -> (PC.TSizeof(clt),x)
448
449 | PC.TString(s,_) -> (PC.TString(s,clt),x)
450 | PC.TChar(s,_) -> (PC.TChar(s,clt),x)
451 | PC.TFloat(s,_) -> (PC.TFloat(s,clt),x)
452 | PC.TInt(s,_) -> (PC.TInt(s,clt),x)
453
454 | PC.TOrLog(_) -> (PC.TOrLog(clt),x)
455 | PC.TAndLog(_) -> (PC.TAndLog(clt),x)
456 | PC.TOr(_) -> (PC.TOr(clt),x)
457 | PC.TXor(_) -> (PC.TXor(clt),x)
458 | PC.TAnd (_) -> (PC.TAnd (clt),x)
459 | PC.TEqEq(_) -> (PC.TEqEq(clt),x)
460 | PC.TNotEq(_) -> (PC.TNotEq(clt),x)
461 | PC.TLogOp(op,_) -> (PC.TLogOp(op,clt),x)
462 | PC.TShOp(op,_) -> (PC.TShOp(op,clt),x)
463 | PC.TPlus(_) -> (PC.TPlus(clt),x)
464 | PC.TMinus(_) -> (PC.TMinus(clt),x)
465 | PC.TMul(_) -> (PC.TMul(clt),x)
466 | PC.TDmOp(op,_) -> (PC.TDmOp(op,clt),x)
467 | PC.TTilde (_) -> (PC.TTilde (clt),x)
468
469 | PC.TMetaParam(a,b,_) -> (PC.TMetaParam(a,b,clt),x)
470 | PC.TMetaParamList(a,b,c,_) -> (PC.TMetaParamList(a,b,c,clt),x)
471 | PC.TMetaConst(a,b,c,d,_) -> (PC.TMetaConst(a,b,c,d,clt),x)
472 | PC.TMetaErr(a,b,c,_) -> (PC.TMetaErr(a,b,c,clt),x)
473 | PC.TMetaExp(a,b,c,d,_) -> (PC.TMetaExp(a,b,c,d,clt),x)
474 | PC.TMetaIdExp(a,b,c,d,_) -> (PC.TMetaIdExp(a,b,c,d,clt),x)
475 | PC.TMetaLocalIdExp(a,b,c,d,_) -> (PC.TMetaLocalIdExp(a,b,c,d,clt),x)
476 | PC.TMetaExpList(a,b,c,_) -> (PC.TMetaExpList(a,b,c,clt),x)
477 | PC.TMetaId(a,b,c,_) -> (PC.TMetaId(a,b,c,clt),x)
478 | PC.TMetaType(a,b,_) -> (PC.TMetaType(a,b,clt),x)
479 | PC.TMetaStm(a,b,_) -> (PC.TMetaStm(a,b,clt),x)
480 | PC.TMetaStmList(a,b,_) -> (PC.TMetaStmList(a,b,clt),x)
481 | PC.TMetaFunc(a,b,c,_) -> (PC.TMetaFunc(a,b,c,clt),x)
482 | PC.TMetaLocalFunc(a,b,c,_) -> (PC.TMetaLocalFunc(a,b,c,clt),x)
483
484 | PC.TWhen(_) -> (PC.TWhen(clt),x)
485 | PC.TWhenTrue(_) -> (PC.TWhenTrue(clt),x)
486 | PC.TWhenFalse(_) -> (PC.TWhenFalse(clt),x)
487 | PC.TAny(_) -> (PC.TAny(clt),x)
488 | PC.TStrict(_) -> (PC.TStrict(clt),x)
489 | PC.TEllipsis(_) -> (PC.TEllipsis(clt),x)
490 (*
491 | PC.TCircles(_) -> (PC.TCircles(clt),x)
492 | PC.TStars(_) -> (PC.TStars(clt),x)
493 *)
494
495 | PC.TOEllipsis(_) -> (PC.TOEllipsis(clt),x)
496 | PC.TCEllipsis(_) -> (PC.TCEllipsis(clt),x)
497 | PC.TPOEllipsis(_) -> (PC.TPOEllipsis(clt),x)
498 | PC.TPCEllipsis(_) -> (PC.TPCEllipsis(clt),x)
499 (*
500 | PC.TOCircles(_) -> (PC.TOCircles(clt),x)
501 | PC.TCCircles(_) -> (PC.TCCircles(clt),x)
502 | PC.TOStars(_) -> (PC.TOStars(clt),x)
503 | PC.TCStars(_) -> (PC.TCStars(clt),x)
504 *)
505
506 | PC.TWhy(_) -> (PC.TWhy(clt),x)
507 | PC.TDotDot(_) -> (PC.TDotDot(clt),x)
508 | PC.TBang(_) -> (PC.TBang(clt),x)
509 | PC.TOPar(_) -> (PC.TOPar(clt),x)
510 | PC.TOPar0(_) -> (PC.TOPar0(clt),x)
511 | PC.TMid0(_) -> (PC.TMid0(clt),x)
512 | PC.TCPar(_) -> (PC.TCPar(clt),x)
513 | PC.TCPar0(_) -> (PC.TCPar0(clt),x)
514
515 | PC.TOBrace(_) -> (PC.TOBrace(clt),x)
516 | PC.TCBrace(_) -> (PC.TCBrace(clt),x)
517 | PC.TOCro(_) -> (PC.TOCro(clt),x)
518 | PC.TCCro(_) -> (PC.TCCro(clt),x)
519 | PC.TOInit(_) -> (PC.TOInit(clt),x)
520
521 | PC.TPtrOp(_) -> (PC.TPtrOp(clt),x)
522
523 | PC.TEq(_) -> (PC.TEq(clt),x)
524 | PC.TAssign(s,_) -> (PC.TAssign(s,clt),x)
525 | PC.TDot(_) -> (PC.TDot(clt),x)
526 | PC.TComma(_) -> (PC.TComma(clt),x)
527 | PC.TPtVirg(_) -> (PC.TPtVirg(clt),x)
528
529 | PC.TLineEnd(_) -> (PC.TLineEnd(clt),x)
530 | PC.TFunDecl(_) -> (PC.TFunDecl(clt),x)
531
532 | _ -> failwith "no clt"
533
534
535 (* ----------------------------------------------------------------------- *)
536
537 let make_name prefix ln = Printf.sprintf "%s starting on line %d" prefix ln
538
539 (* ----------------------------------------------------------------------- *)
540 (* Read tokens *)
541
542 let wrap_lexbuf_info lexbuf =
543 (Lexing.lexeme lexbuf, Lexing.lexeme_start lexbuf)
544
545 let tokens_all_full token table file get_ats lexbuf end_markers :
546 (bool * ((PC.token * (string * (int * int) * (int * int))) list)) =
547 try
548 let rec aux () =
549 let result = token lexbuf in
550 let info = (Lexing.lexeme lexbuf,
551 (table.(Lexing.lexeme_start lexbuf)),
552 (Lexing.lexeme_start lexbuf, Lexing.lexeme_end lexbuf)) in
553 if result = PC.EOF
554 then
555 if get_ats
556 then failwith "unexpected end of file in a metavariable declaration"
557 else (false,[(result,info)])
558 else if List.mem result end_markers
559 then (true,[(result,info)])
560 else
561 let (more,rest) = aux() in
562 (more,(result, info)::rest)
563 in aux ()
564 with
565 e -> pr2 (Common.error_message file (wrap_lexbuf_info lexbuf) ); raise e
566
567 let tokens_all table file get_ats lexbuf end_markers :
568 (bool * ((PC.token * (string * (int * int) * (int * int))) list)) =
569 tokens_all_full Lexer_cocci.token table file get_ats lexbuf end_markers
570
571 let tokens_script_all table file get_ats lexbuf end_markers :
572 (bool * ((PC.token * (string * (int * int) * (int * int))) list)) =
573 tokens_all_full Lexer_script.token table file get_ats lexbuf end_markers
574
575 (* ----------------------------------------------------------------------- *)
576 (* Split tokens into minus and plus fragments *)
577
578 let split t clt =
579 let (d,_,_,_,_,_,_,_) = clt in
580 match d with
581 D.MINUS | D.OPTMINUS | D.UNIQUEMINUS -> ([t],[])
582 | D.PLUS -> ([],[t])
583 | D.CONTEXT | D.UNIQUE | D.OPT -> ([t],[t])
584
585 let split_token ((tok,_) as t) =
586 match tok with
587 PC.TIdentifier | PC.TConstant | PC.TExpression | PC.TIdExpression
588 | PC.TStatement | PC.TPosition | PC.TPosAny
589 | PC.TFunction | PC.TTypedef | PC.TDeclarer | PC.TIterator | PC.TName
590 | PC.TType | PC.TParameter | PC.TLocal | PC.Tlist | PC.TFresh | PC.TPure
591 | PC.TContext | PC.TRuleName(_) | PC.TUsing | PC.TDisable | PC.TExtends
592 | PC.TPathIsoFile(_)
593 | PC.TDepends | PC.TOn | PC.TEver | PC.TNever | PC.TExists | PC.TForall
594 | PC.TReverse
595 | PC.TError | PC.TWords | PC.TGenerated | PC.TNothing -> ([t],[t])
596
597 | PC.Tchar(clt) | PC.Tshort(clt) | PC.Tint(clt) | PC.Tdouble(clt)
598 | PC.Tfloat(clt) | PC.Tlong(clt) | PC.Tvoid(clt) | PC.Tstruct(clt)
599 | PC.Tunion(clt) | PC.Tenum(clt) | PC.Tunsigned(clt) | PC.Tsigned(clt)
600 | PC.Tstatic(clt) | PC.Tauto(clt) | PC.Tregister(clt) | PC.Textern(clt)
601 | PC.Tinline(clt) | PC.Ttypedef(clt) | PC.Tattr(_,clt)
602 | PC.Tconst(clt) | PC.Tvolatile(clt) -> split t clt
603
604 | PC.TPragma(s) -> ([],[t]) (* only allowed in + *)
605 | PC.TPlusFile(s,clt) | PC.TMinusFile(s,clt)
606 | PC.TIncludeL(s,clt) | PC.TIncludeNL(s,clt) ->
607 split t clt
608 | PC.TDefine(clt,_) | PC.TDefineParam(clt,_,_) -> split t clt
609
610 | PC.TIf(clt) | PC.TElse(clt) | PC.TWhile(clt) | PC.TFor(clt) | PC.TDo(clt)
611 | PC.TSwitch(clt) | PC.TCase(clt) | PC.TDefault(clt)
612 | PC.TSizeof(clt)
613 | PC.TReturn(clt) | PC.TBreak(clt) | PC.TContinue(clt) | PC.TGoto(clt)
614 | PC.TIdent(_,clt)
615 | PC.TTypeId(_,clt) | PC.TDeclarerId(_,clt) | PC.TIteratorId(_,clt)
616 | PC.TMetaConst(_,_,_,_,clt) | PC.TMetaExp(_,_,_,_,clt)
617 | PC.TMetaIdExp(_,_,_,_,clt) | PC.TMetaLocalIdExp(_,_,_,_,clt)
618 | PC.TMetaExpList(_,_,_,clt)
619 | PC.TMetaParam(_,_,clt) | PC.TMetaParamList(_,_,_,clt)
620 | PC.TMetaId(_,_,_,clt) | PC.TMetaType(_,_,clt)
621 | PC.TMetaStm(_,_,clt) | PC.TMetaStmList(_,_,clt) | PC.TMetaErr(_,_,_,clt)
622 | PC.TMetaFunc(_,_,_,clt) | PC.TMetaLocalFunc(_,_,_,clt)
623 | PC.TMetaDeclarer(_,_,_,clt) | PC.TMetaIterator(_,_,_,clt) -> split t clt
624 | PC.TMPtVirg | PC.TArob | PC.TArobArob | PC.TScript -> ([t],[t])
625 | PC.TPArob | PC.TMetaPos(_,_,_,_) -> ([t],[])
626
627 | PC.TFunDecl(clt)
628 | PC.TWhen(clt) | PC.TWhenTrue(clt) | PC.TWhenFalse(clt)
629 | PC.TAny(clt) | PC.TStrict(clt) | PC.TLineEnd(clt)
630 | PC.TEllipsis(clt) (* | PC.TCircles(clt) | PC.TStars(clt) *) -> split t clt
631
632 | PC.TOEllipsis(_) | PC.TCEllipsis(_) (* clt must be context *)
633 | PC.TPOEllipsis(_) | PC.TPCEllipsis(_) (* clt must be context *)
634 (*
635 | PC.TOCircles(_) | PC.TCCircles(_) (* clt must be context *)
636 | PC.TOStars(_) | PC.TCStars(_) (* clt must be context *)
637 *)
638 | PC.TBang0 | PC.TPlus0 | PC.TWhy0 ->
639 ([t],[t])
640
641 | PC.TWhy(clt) | PC.TDotDot(clt)
642 | PC.TBang(clt) | PC.TOPar(clt) | PC.TOPar0(clt)
643 | PC.TMid0(clt) | PC.TCPar(clt) | PC.TCPar0(clt) -> split t clt
644
645 | PC.TInc(clt) | PC.TDec(clt) -> split t clt
646
647 | PC.TString(_,clt) | PC.TChar(_,clt) | PC.TFloat(_,clt) | PC.TInt(_,clt) ->
648 split t clt
649
650 | PC.TOrLog(clt) | PC.TAndLog(clt) | PC.TOr(clt) | PC.TXor(clt)
651 | PC.TAnd (clt) | PC.TEqEq(clt) | PC.TNotEq(clt) | PC.TLogOp(_,clt)
652 | PC.TShOp(_,clt) | PC.TPlus(clt) | PC.TMinus(clt) | PC.TMul(clt)
653 | PC.TDmOp(_,clt) | PC.TTilde (clt) -> split t clt
654
655 | PC.TOBrace(clt) | PC.TCBrace(clt) | PC.TOInit(clt) -> split t clt
656 | PC.TOCro(clt) | PC.TCCro(clt) -> split t clt
657
658 | PC.TPtrOp(clt) -> split t clt
659
660 | PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt)
661 | PC.TPtVirg(clt) -> split t clt
662
663 | PC.EOF | PC.TInvalid -> ([t],[t])
664
665 | PC.TIso | PC.TRightIso
666 | PC.TIsoExpression | PC.TIsoStatement | PC.TIsoDeclaration | PC.TIsoType
667 | PC.TIsoTopLevel | PC.TIsoArgExpression | PC.TIsoTestExpression ->
668 failwith "unexpected tokens"
669 | PC.TScriptData s -> ([t],[t])
670
671 let split_token_stream tokens =
672 let rec loop = function
673 [] -> ([],[])
674 | token::tokens ->
675 let (minus,plus) = split_token token in
676 let (minus_stream,plus_stream) = loop tokens in
677 (minus@minus_stream,plus@plus_stream) in
678 loop tokens
679
680 (* ----------------------------------------------------------------------- *)
681 (* Find function names *)
682 (* This addresses a shift-reduce problem in the parser, allowing us to
683 distinguish a function declaration from a function call even if the latter
684 has no return type. Undoubtedly, this is not very nice, but it doesn't
685 seem very convenient to refactor the grammar to get around the problem. *)
686
687 let rec find_function_names = function
688 [] -> []
689 | ((PC.TIdent(_,clt),info) as t1) :: ((PC.TOPar(_),_) as t2) :: rest
690 | ((PC.TMetaId(_,_,_,clt),info) as t1) :: ((PC.TOPar(_),_) as t2) :: rest
691 | ((PC.TMetaFunc(_,_,_,clt),info) as t1) :: ((PC.TOPar(_),_) as t2) :: rest
692 | ((PC.TMetaLocalFunc(_,_,_,clt),info) as t1)::((PC.TOPar(_),_) as t2)::rest
693 ->
694 let rec skip level = function
695 [] -> ([],false,[])
696 | ((PC.TCPar(_),_) as t)::rest ->
697 let level = level - 1 in
698 if level = 0
699 then ([t],true,rest)
700 else let (pre,found,post) = skip level rest in (t::pre,found,post)
701 | ((PC.TOPar(_),_) as t)::rest ->
702 let level = level + 1 in
703 let (pre,found,post) = skip level rest in (t::pre,found,post)
704 | ((PC.TArobArob,_) as t)::rest
705 | ((PC.TArob,_) as t)::rest
706 | ((PC.EOF,_) as t)::rest -> ([t],false,rest)
707 | t::rest ->
708 let (pre,found,post) = skip level rest in (t::pre,found,post) in
709 let (pre,found,post) = skip 1 rest in
710 (match (found,post) with
711 (true,((PC.TOBrace(_),_) as t3)::rest) ->
712 (PC.TFunDecl(clt),info) :: t1 :: t2 :: pre @
713 t3 :: (find_function_names rest)
714 | _ -> t1 :: t2 :: pre @ find_function_names post)
715 | t :: rest -> t :: find_function_names rest
716
717 (* ----------------------------------------------------------------------- *)
718 (* an attribute is an identifier that preceeds another identifier and
719 begins with __ *)
720
721 let rec detect_attr l =
722 let is_id = function
723 (PC.TIdent(_,_),_) | (PC.TMetaId(_,_,_,_),_) | (PC.TMetaFunc(_,_,_,_),_)
724 | (PC.TMetaLocalFunc(_,_,_,_),_) -> true
725 | _ -> false in
726 let rec loop = function
727 [] -> []
728 | [x] -> [x]
729 | ((PC.TIdent(nm,clt),info) as t1)::id::rest when is_id id ->
730 if String.length nm > 2 && String.sub nm 0 2 = "__"
731 then (PC.Tattr(nm,clt),info)::(loop (id::rest))
732 else t1::(loop (id::rest))
733 | x::xs -> x::(loop xs) in
734 loop l
735
736 (* ----------------------------------------------------------------------- *)
737 (* Look for variable declarations where the name is a typedef name.
738 We assume that C code does not contain a multiplication as a top-level
739 statement. *)
740
741 (* bug: once a type, always a type, even if the same name is later intended
742 to be used as a real identifier *)
743 let detect_types in_meta_decls l =
744 let is_delim infn = function
745 (PC.TOEllipsis(_),_) (* | (PC.TOCircles(_),_) | (PC.TOStars(_),_) *)
746 | (PC.TPOEllipsis(_),_) (* | (PC.TOCircles(_),_) | (PC.TOStars(_),_) *)
747 | (PC.TEllipsis(_),_) (* | (PC.TCircles(_),_) | (PC.TStars(_),_) *)
748 | (PC.TPtVirg(_),_) | (PC.TOBrace(_),_) | (PC.TOInit(_),_)
749 | (PC.TCBrace(_),_)
750 | (PC.TPure,_) | (PC.TContext,_)
751 | (PC.Tstatic(_),_) | (PC.Textern(_),_)
752 | (PC.Tinline(_),_) | (PC.Ttypedef(_),_) | (PC.Tattr(_),_) -> true
753 | (PC.TComma(_),_) when infn > 0 or in_meta_decls -> true
754 | (PC.TDotDot(_),_) when in_meta_decls -> true
755 | _ -> false in
756 let is_choices_delim = function
757 (PC.TOBrace(_),_) | (PC.TComma(_),_) -> true | _ -> false in
758 let is_id = function
759 (PC.TIdent(_,_),_) | (PC.TMetaId(_,_,_,_),_) | (PC.TMetaFunc(_,_,_,_),_)
760 | (PC.TMetaLocalFunc(_,_,_,_),_) -> true
761 | (PC.TMetaParam(_,_,_),_)
762 | (PC.TMetaParamList(_,_,_,_),_)
763 | (PC.TMetaConst(_,_,_,_,_),_)
764 | (PC.TMetaErr(_,_,_,_),_)
765 | (PC.TMetaExp(_,_,_,_,_),_)
766 | (PC.TMetaIdExp(_,_,_,_,_),_)
767 | (PC.TMetaLocalIdExp(_,_,_,_,_),_)
768 | (PC.TMetaExpList(_,_,_,_),_)
769 | (PC.TMetaType(_,_,_),_)
770 | (PC.TMetaStm(_,_,_),_)
771 | (PC.TMetaStmList(_,_,_),_)
772 | (PC.TMetaPos(_,_,_,_),_) -> in_meta_decls
773 | _ -> false in
774 let redo_id ident clt v =
775 !Data.add_type_name ident;
776 (PC.TTypeId(ident,clt),v) in
777 let rec loop start infn type_names = function
778 (* infn: 0 means not in a function header
779 > 0 means in a function header, after infn - 1 unmatched open parens*)
780 [] -> []
781 | ((PC.TOBrace(clt),v)::_) as all when in_meta_decls ->
782 collect_choices type_names all (* never a function header *)
783 | delim::(PC.TIdent(ident,clt),v)::((PC.TMul(_),_) as x)::rest
784 when is_delim infn delim ->
785 let newid = redo_id ident clt v in
786 delim::newid::x::(loop false infn (ident::type_names) rest)
787 | delim::(PC.TIdent(ident,clt),v)::id::rest
788 when is_delim infn delim && is_id id ->
789 let newid = redo_id ident clt v in
790 delim::newid::id::(loop false infn (ident::type_names) rest)
791 | ((PC.TFunDecl(_),_) as fn)::rest ->
792 fn::(loop false 1 type_names rest)
793 | ((PC.TOPar(_),_) as lp)::rest when infn > 0 ->
794 lp::(loop false (infn + 1) type_names rest)
795 | ((PC.TCPar(_),_) as rp)::rest when infn > 0 ->
796 if infn - 1 = 1
797 then rp::(loop false 0 type_names rest) (* 0 means not in fn header *)
798 else rp::(loop false (infn - 1) type_names rest)
799 | (PC.TIdent(ident,clt),v)::((PC.TMul(_),_) as x)::rest when start ->
800 let newid = redo_id ident clt v in
801 newid::x::(loop false infn (ident::type_names) rest)
802 | (PC.TIdent(ident,clt),v)::id::rest when start && is_id id ->
803 let newid = redo_id ident clt v in
804 newid::id::(loop false infn (ident::type_names) rest)
805 | (PC.TIdent(ident,clt),v)::rest when List.mem ident type_names ->
806 (PC.TTypeId(ident,clt),v)::(loop false infn type_names rest)
807 | ((PC.TIdent(ident,clt),v) as x)::rest ->
808 x::(loop false infn type_names rest)
809 | x::rest -> x::(loop false infn type_names rest)
810 and collect_choices type_names = function
811 [] -> [] (* should happen, but let the parser detect that *)
812 | (PC.TCBrace(clt),v)::rest ->
813 (PC.TCBrace(clt),v)::(loop false 0 type_names rest)
814 | delim::(PC.TIdent(ident,clt),v)::rest
815 when is_choices_delim delim ->
816 let newid = redo_id ident clt v in
817 delim::newid::(collect_choices (ident::type_names) rest)
818 | x::rest -> x::(collect_choices type_names rest) in
819 loop true 0 [] l
820
821
822 (* ----------------------------------------------------------------------- *)
823 (* Insert TLineEnd tokens at the end of a line that contains a WHEN.
824 WHEN is restricted to a single line, to avoid ambiguity in eg:
825 ... WHEN != x
826 +3 *)
827
828 let token2line (tok,_) =
829 match tok with
830 PC.Tchar(clt) | PC.Tshort(clt) | PC.Tint(clt) | PC.Tdouble(clt)
831 | PC.Tfloat(clt) | PC.Tlong(clt) | PC.Tvoid(clt) | PC.Tstruct(clt)
832 | PC.Tunion(clt) | PC.Tenum(clt) | PC.Tunsigned(clt) | PC.Tsigned(clt)
833 | PC.Tstatic(clt) | PC.Tauto(clt) | PC.Tregister(clt) | PC.Textern(clt)
834 | PC.Tinline(clt) | PC.Ttypedef(clt) | PC.Tattr(_,clt) | PC.Tconst(clt)
835 | PC.Tvolatile(clt)
836
837 | PC.TInc(clt) | PC.TDec(clt)
838
839 | PC.TIf(clt) | PC.TElse(clt) | PC.TWhile(clt) | PC.TFor(clt) | PC.TDo(clt)
840 | PC.TSwitch (clt) | PC.TCase (clt) | PC.TDefault (clt) | PC.TSizeof (clt)
841 | PC.TReturn(clt) | PC.TBreak(clt) | PC.TContinue(clt) | PC.TGoto(clt)
842 | PC.TIdent(_,clt)
843 | PC.TTypeId(_,clt) | PC.TDeclarerId(_,clt) | PC.TIteratorId(_,clt)
844 | PC.TMetaDeclarer(_,_,_,clt) | PC.TMetaIterator(_,_,_,clt)
845
846 | PC.TString(_,clt) | PC.TChar(_,clt) | PC.TFloat(_,clt) | PC.TInt(_,clt)
847
848 | PC.TOrLog(clt) | PC.TAndLog(clt) | PC.TOr(clt) | PC.TXor(clt)
849 | PC.TAnd (clt) | PC.TEqEq(clt) | PC.TNotEq(clt) | PC.TLogOp(_,clt)
850 | PC.TShOp(_,clt) | PC.TPlus(clt) | PC.TMinus(clt) | PC.TMul(clt)
851 | PC.TDmOp(_,clt) | PC.TTilde (clt)
852
853 | PC.TMetaParam(_,_,clt) | PC.TMetaParamList(_,_,_,clt)
854 | PC.TMetaConst(_,_,_,_,clt) | PC.TMetaExp(_,_,_,_,clt)
855 | PC.TMetaIdExp(_,_,_,_,clt) | PC.TMetaLocalIdExp(_,_,_,_,clt)
856 | PC.TMetaExpList(_,_,_,clt)
857 | PC.TMetaId(_,_,_,clt) | PC.TMetaType(_,_,clt)
858 | PC.TMetaStm(_,_,clt) | PC.TMetaStmList(_,_,clt) | PC.TMetaFunc(_,_,_,clt)
859 | PC.TMetaLocalFunc(_,_,_,clt) | PC.TMetaPos(_,_,_,clt)
860
861 | PC.TFunDecl(clt)
862 | PC.TWhen(clt) | PC.TWhenTrue(clt) | PC.TWhenFalse(clt)
863 | PC.TAny(clt) | PC.TStrict(clt) | PC.TEllipsis(clt)
864 (* | PC.TCircles(clt) | PC.TStars(clt) *)
865
866 | PC.TOEllipsis(clt) | PC.TCEllipsis(clt)
867 | PC.TPOEllipsis(clt) | PC.TPCEllipsis(clt) (*| PC.TOCircles(clt)
868 | PC.TCCircles(clt) | PC.TOStars(clt) | PC.TCStars(clt) *)
869
870 | PC.TWhy(clt) | PC.TDotDot(clt) | PC.TBang(clt) | PC.TOPar(clt)
871 | PC.TOPar0(clt) | PC.TMid0(clt) | PC.TCPar(clt)
872 | PC.TCPar0(clt)
873
874 | PC.TOBrace(clt) | PC.TCBrace(clt) | PC.TOCro(clt) | PC.TCCro(clt)
875 | PC.TOInit(clt)
876
877 | PC.TPtrOp(clt)
878
879 | PC.TDefine(clt,_) | PC.TDefineParam(clt,_,_)
880 | PC.TIncludeL(_,clt) | PC.TIncludeNL(_,clt)
881
882 | PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt)
883 | PC.TPtVirg(clt) ->
884 let (_,line,_,_,_,_,_,_) = clt in Some line
885
886 | _ -> None
887
888 let rec insert_line_end = function
889 [] -> []
890 | (((PC.TWhen(clt),q) as x)::xs) ->
891 x::(find_line_end true (token2line x) clt q xs)
892 | (((PC.TDefine(clt,_),q) as x)::xs)
893 | (((PC.TDefineParam(clt,_,_),q) as x)::xs) ->
894 x::(find_line_end false (token2line x) clt q xs)
895 | x::xs -> x::(insert_line_end xs)
896
897 and find_line_end inwhen line clt q = function
898 (* don't know what 2nd component should be so just use the info of
899 the When. Also inherit - of when, if any *)
900 [] -> [(PC.TLineEnd(clt),q)]
901 | ((PC.TIdent("strict",clt),a) as x)::xs when token2line x = line ->
902 (PC.TStrict(clt),a) :: (find_line_end inwhen line clt q xs)
903 | ((PC.TIdent("STRICT",clt),a) as x)::xs when token2line x = line ->
904 (PC.TStrict(clt),a) :: (find_line_end inwhen line clt q xs)
905 | ((PC.TIdent("any",clt),a) as x)::xs when token2line x = line ->
906 (PC.TAny(clt),a) :: (find_line_end inwhen line clt q xs)
907 | ((PC.TIdent("ANY",clt),a) as x)::xs when token2line x = line ->
908 (PC.TAny(clt),a) :: (find_line_end inwhen line clt q xs)
909 | ((PC.TIdent("forall",clt),a) as x)::xs when token2line x = line ->
910 (PC.TForall,a) :: (find_line_end inwhen line clt q xs)
911 | ((PC.TIdent("exists",clt),a) as x)::xs when token2line x = line ->
912 (PC.TExists,a) :: (find_line_end inwhen line clt q xs)
913 | ((PC.TComma(clt),a) as x)::xs when token2line x = line ->
914 (PC.TComma(clt),a) :: (find_line_end inwhen line clt q xs)
915 | ((PC.TPArob,a) as x)::xs -> (* no line #, just assume on the same line *)
916 x :: (find_line_end inwhen line clt q xs)
917 | x::xs when token2line x = line -> x :: (find_line_end inwhen line clt q xs)
918 | xs -> (PC.TLineEnd(clt),q)::(insert_line_end xs)
919
920 let rec translate_when_true_false = function
921 [] -> []
922 | (PC.TWhen(clt),q)::((PC.TNotEq(_),_) as x)::(PC.TIdent("true",_),_)::xs ->
923 (PC.TWhenTrue(clt),q)::x::(translate_when_true_false xs)
924 | (PC.TWhen(clt),q)::((PC.TNotEq(_),_) as x)::(PC.TIdent("false",_),_)::xs ->
925 (PC.TWhenFalse(clt),q)::x::(translate_when_true_false xs)
926 | x::xs -> x :: (translate_when_true_false xs)
927
928 (* ----------------------------------------------------------------------- *)
929 (* top level initializers: a sequence of braces followed by a dot *)
930
931 let find_top_init tokens =
932 match tokens with
933 (PC.TOBrace(clt),q) :: rest ->
934 let rec dot_start acc = function
935 ((PC.TOBrace(_),_) as x) :: rest ->
936 dot_start (x::acc) rest
937 | ((PC.TDot(_),_) :: rest) as x ->
938 Some ((PC.TOInit(clt),q) :: (List.rev acc) @ x)
939 | l -> None in
940 let rec comma_end acc = function
941 ((PC.TCBrace(_),_) as x) :: rest ->
942 comma_end (x::acc) rest
943 | ((PC.TComma(_),_) :: rest) as x ->
944 Some ((PC.TOInit(clt),q) :: (List.rev x) @ acc)
945 | l -> None in
946 (match dot_start [] rest with
947 Some x -> x
948 | None ->
949 (match List.rev rest with
950 (* not super sure what this does, but EOF, @, and @@ should be
951 the same, markind the end of a rule *)
952 ((PC.EOF,_) as x)::rest | ((PC.TArob,_) as x)::rest
953 | ((PC.TArobArob,_) as x)::rest ->
954 (match comma_end [x] rest with
955 Some x -> x
956 | None -> tokens)
957 | _ ->
958 failwith "unexpected empty token list"))
959 | _ -> tokens
960
961 (* ----------------------------------------------------------------------- *)
962 (* process pragmas: they can only be used in + code, and adjacent to
963 another + token. They are concatenated to the string representation of
964 that other token. *)
965
966 let rec collect_all_pragmas collected = function
967 (PC.TPragma(s),_)::rest -> collect_all_pragmas (s::collected) rest
968 | l -> (List.rev collected,l)
969
970 let rec collect_up_to_pragmas skipped = function
971 [] -> None (* didn't reach a pragma, so nothing to do *)
972 | ((PC.TPragma(s),_) as t)::rest ->
973 let (pragmas,rest) = collect_all_pragmas [] (t::rest) in
974 Some (List.rev skipped,pragmas,rest)
975 | x::xs ->
976 match plus_attachable x with
977 PLUS -> None
978 | NOTPLUS -> None
979 | SKIP -> collect_up_to_pragmas (x::skipped) xs
980
981 let rec collect_up_to_plus skipped = function
982 [] -> failwith "nothing to attach a pragma to (empty)"
983 | x::xs ->
984 match plus_attachable x with
985 PLUS -> (List.rev skipped,x,xs)
986 | NOTPLUS -> failwith "nothing to attach a pragma to"
987 | SKIP -> collect_up_to_plus (x::skipped) xs
988
989 let rec process_pragmas = function
990 [] -> []
991 | ((PC.TPragma(s),_)::_) as l ->
992 let (pragmas,rest) = collect_all_pragmas [] l in
993 let (skipped,aft,rest) = collect_up_to_plus [] rest in
994 let (a,b,c,d,e,strbef,straft,pos) = get_clt aft in
995 skipped@
996 (process_pragmas ((update_clt aft (a,b,c,d,e,pragmas,straft,pos))::rest))
997 | bef::xs ->
998 (match plus_attachable bef with
999 PLUS ->
1000 (match collect_up_to_pragmas [] xs with
1001 Some(skipped,pragmas,rest) ->
1002 let (a,b,c,d,e,strbef,straft,pos) = get_clt bef in
1003 (update_clt bef (a,b,c,d,e,strbef,pragmas,pos))::
1004 skipped@(process_pragmas rest)
1005 | None -> bef::(process_pragmas xs))
1006 | _ -> bef::(process_pragmas xs))
1007
1008 (* ----------------------------------------------------------------------- *)
1009 (* Drop ... ... . This is only allowed in + code, and arises when there is
1010 some - code between the ... *)
1011 (* drop whens as well - they serve no purpose in + code and they cause
1012 problems for drop_double_dots *)
1013
1014 let rec drop_when = function
1015 [] -> []
1016 | (PC.TWhen(clt),info)::xs ->
1017 let rec loop = function
1018 [] -> []
1019 | (PC.TLineEnd(_),info)::xs -> drop_when xs
1020 | x::xs -> loop xs in
1021 loop xs
1022 | x::xs -> x::drop_when xs
1023
1024 (* instead of dropping the double dots, we put TNothing in between them.
1025 these vanish after the parser, but keeping all the ...s in the + code makes
1026 it easier to align the + and - code in context_neg and in preparation for the
1027 isomorphisms. This shouldn't matter because the context code of the +
1028 slice is mostly ignored anyway *)
1029 let rec drop_double_dots l =
1030 let start = function
1031 (PC.TOEllipsis(_),_) | (PC.TPOEllipsis(_),_)
1032 (* | (PC.TOCircles(_),_) | (PC.TOStars(_),_) *) ->
1033 true
1034 | _ -> false in
1035 let middle = function
1036 (PC.TEllipsis(_),_) (* | (PC.TCircles(_),_) | (PC.TStars(_),_) *) -> true
1037 | _ -> false in
1038 let whenline = function
1039 (PC.TLineEnd(_),_) -> true
1040 | (PC.TMid0(_),_) -> true
1041 | _ -> false in
1042 let final = function
1043 (PC.TCEllipsis(_),_) | (PC.TPCEllipsis(_),_)
1044 (* | (PC.TCCircles(_),_) | (PC.TCStars(_),_) *) ->
1045 true
1046 | _ -> false in
1047 let any_before x = start x or middle x or final x or whenline x in
1048 let any_after x = start x or middle x or final x in
1049 let rec loop ((_,i) as prev) = function
1050 [] -> []
1051 | x::rest when any_before prev && any_after x ->
1052 (PC.TNothing,i)::x::(loop x rest)
1053 | x::rest -> x :: (loop x rest) in
1054 match l with
1055 [] -> []
1056 | (x::xs) -> x :: loop x xs
1057
1058 let rec fix f l =
1059 let cur = f l in
1060 if l = cur then l else fix f cur
1061
1062 (* ( | ... | ) also causes parsing problems *)
1063
1064 exception Not_empty
1065
1066 let rec drop_empty_thing starter middle ender = function
1067 [] -> []
1068 | hd::rest when starter hd ->
1069 let rec loop = function
1070 x::rest when middle x -> loop rest
1071 | x::rest when ender x -> rest
1072 | _ -> raise Not_empty in
1073 (match try Some(loop rest) with Not_empty -> None with
1074 Some x -> drop_empty_thing starter middle ender x
1075 | None -> hd :: drop_empty_thing starter middle ender rest)
1076 | x::rest -> x :: drop_empty_thing starter middle ender rest
1077
1078 let drop_empty_or =
1079 drop_empty_thing
1080 (function (PC.TOPar0(_),_) -> true | _ -> false)
1081 (function (PC.TMid0(_),_) -> true | _ -> false)
1082 (function (PC.TCPar0(_),_) -> true | _ -> false)
1083
1084 let drop_empty_nest = drop_empty_thing
1085
1086 (* ----------------------------------------------------------------------- *)
1087 (* Read tokens *)
1088
1089 let get_s_starts (_, (s,_,(starts, ends))) =
1090 Printf.printf "%d %d\n" starts ends; (s, starts)
1091
1092 let pop2 l =
1093 let v = List.hd !l in
1094 l := List.tl !l;
1095 v
1096
1097 let reinit _ =
1098 PC.reinit (function _ -> PC.TArobArob (* a handy token *))
1099 (Lexing.from_function
1100 (function buf -> function n -> raise Common.Impossible))
1101
1102 let parse_one str parsefn file toks =
1103 let all_tokens = ref toks in
1104 let cur_tok = ref (List.hd !all_tokens) in
1105
1106 let lexer_function _ =
1107 let (v, info) = pop2 all_tokens in
1108 cur_tok := (v, info);
1109 v in
1110
1111 let lexbuf_fake =
1112 Lexing.from_function
1113 (function buf -> function n -> raise Common.Impossible)
1114 in
1115
1116 reinit();
1117
1118 try parsefn lexer_function lexbuf_fake
1119 with
1120 Lexer_cocci.Lexical s ->
1121 failwith
1122 (Printf.sprintf "%s: lexical error: %s\n =%s\n" str s
1123 (Common.error_message file (get_s_starts !cur_tok) ))
1124 | Parser_cocci_menhir.Error ->
1125 failwith
1126 (Printf.sprintf "%s: parse error: \n = %s\n" str
1127 (Common.error_message file (get_s_starts !cur_tok) ))
1128 | Semantic_cocci.Semantic s ->
1129 failwith
1130 (Printf.sprintf "%s: semantic error: %s\n =%s\n" str s
1131 (Common.error_message file (get_s_starts !cur_tok) ))
1132
1133 | e -> raise e
1134
1135 let prepare_tokens tokens =
1136 find_top_init
1137 (translate_when_true_false (* after insert_line_end *)
1138 (insert_line_end
1139 (detect_types false (find_function_names (detect_attr tokens)))))
1140
1141 let prepare_mv_tokens tokens =
1142 detect_types false (detect_attr tokens)
1143
1144 let rec consume_minus_positions = function
1145 [] -> []
1146 | ((PC.TOPar0(_),_) as x)::xs | ((PC.TCPar0(_),_) as x)::xs
1147 | ((PC.TMid0(_),_) as x)::xs -> x::consume_minus_positions xs
1148 | x::(PC.TPArob,_)::(PC.TMetaPos(name,constraints,per,clt),_)::xs ->
1149 let (arity,ln,lln,offset,col,strbef,straft,_) = get_clt x in
1150 let name = Parse_aux.clt2mcode name clt in
1151 let x =
1152 update_clt x
1153 (arity,ln,lln,offset,col,strbef,straft,
1154 Ast0.MetaPos(name,constraints,per)) in
1155 x::(consume_minus_positions xs)
1156 | x::xs -> x::consume_minus_positions xs
1157
1158 let any_modif rule =
1159 let mcode x =
1160 match Ast0.get_mcode_mcodekind x with
1161 Ast0.MINUS _ | Ast0.PLUS -> true
1162 | _ -> false in
1163 let donothing r k e = k e in
1164 let bind x y = x or y in
1165 let option_default = false in
1166 let fn =
1167 V0.combiner bind option_default
1168 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
1169 donothing donothing donothing donothing donothing donothing
1170 donothing donothing donothing donothing donothing donothing donothing
1171 donothing donothing in
1172 List.exists fn.V0.combiner_top_level rule
1173
1174 let drop_last extra l = List.rev(extra@(List.tl(List.rev l)))
1175
1176 let partition_either l =
1177 let rec part_either left right = function
1178 | [] -> (List.rev left, List.rev right)
1179 | x :: l ->
1180 (match x with
1181 | Common.Left e -> part_either (e :: left) right l
1182 | Common.Right e -> part_either left (e :: right) l) in
1183 part_either [] [] l
1184
1185 let get_metavars parse_fn table file lexbuf =
1186 let rec meta_loop acc (* read one decl at a time *) =
1187 let (_,tokens) =
1188 tokens_all table file true lexbuf [PC.TArobArob;PC.TMPtVirg] in
1189 let tokens = prepare_mv_tokens tokens in
1190 match tokens with
1191 [(PC.TArobArob,_)] -> List.rev acc
1192 | _ ->
1193 let metavars = parse_one "meta" parse_fn file tokens in
1194 meta_loop (metavars@acc) in
1195 partition_either (meta_loop [])
1196
1197 let get_script_metavars parse_fn table file lexbuf =
1198 let rec meta_loop acc =
1199 let (_, tokens) =
1200 tokens_all table file true lexbuf [PC.TArobArob; PC.TMPtVirg] in
1201 let tokens = prepare_tokens tokens in
1202 match tokens with
1203 [(PC.TArobArob, _)] -> List.rev acc
1204 | _ ->
1205 let metavar = parse_one "scriptmeta" parse_fn file tokens in
1206 meta_loop (metavar :: acc)
1207 in
1208 meta_loop []
1209
1210 let get_rule_name parse_fn starts_with_name get_tokens file prefix =
1211 Data.in_rule_name := true;
1212 let mknm _ = make_name prefix (!Lexer_cocci.line) in
1213 let name_res =
1214 if starts_with_name
1215 then
1216 let (_,tokens) = get_tokens [PC.TArob] in
1217 let check_name = function
1218 None -> Some (mknm())
1219 | Some nm ->
1220 (if List.mem nm reserved_names
1221 then failwith (Printf.sprintf "invalid name %s\n" nm));
1222 Some nm in
1223 match parse_one "rule name" parse_fn file tokens with
1224 Ast.CocciRulename (nm,a,b,c,d,e) ->
1225 Ast.CocciRulename (check_name nm,a,b,c,d,e)
1226 | Ast.GeneratedRulename (nm,a,b,c,d,e) ->
1227 Ast.GeneratedRulename (check_name nm,a,b,c,d,e)
1228 | Ast.ScriptRulename(s,deps) -> Ast.ScriptRulename(s,deps)
1229 else
1230 Ast.CocciRulename(Some(mknm()),Ast.NoDep,[],[],Ast.Undetermined,false) in
1231 Data.in_rule_name := false;
1232 name_res
1233
1234 let parse_iso file =
1235 let table = Common.full_charpos_to_pos file in
1236 Common.with_open_infile file (fun channel ->
1237 let lexbuf = Lexing.from_channel channel in
1238 let get_tokens = tokens_all table file false lexbuf in
1239 let res =
1240 match get_tokens [PC.TArobArob;PC.TArob] with
1241 (true,start) ->
1242 let parse_start start =
1243 let rev = List.rev start in
1244 let (arob,_) = List.hd rev in
1245 (arob = PC.TArob,List.rev(List.tl rev)) in
1246 let (starts_with_name,start) = parse_start start in
1247 let rec loop starts_with_name start =
1248 (!Data.init_rule)();
1249 (* get metavariable declarations - have to be read before the
1250 rest *)
1251 let (rule_name,_,_,_,_,_) =
1252 match get_rule_name PC.iso_rule_name starts_with_name get_tokens
1253 file ("iso file "^file) with
1254 Ast.CocciRulename (Some n,a,b,c,d,e) -> (n,a,b,c,d,e)
1255 | _ -> failwith "Script rules cannot appear in isomorphism rules"
1256 in
1257 Ast0.rule_name := rule_name;
1258 Data.in_meta := true;
1259 let iso_metavars =
1260 match get_metavars PC.iso_meta_main table file lexbuf with
1261 (iso_metavars,[]) -> iso_metavars
1262 | _ -> failwith "unexpected inheritance in iso" in
1263 Data.in_meta := false;
1264 (* get the rule *)
1265 let (more,tokens) =
1266 get_tokens
1267 [PC.TIsoStatement;PC.TIsoExpression;PC.TIsoArgExpression;
1268 PC.TIsoTestExpression;
1269 PC.TIsoDeclaration;PC.TIsoType;PC.TIsoTopLevel] in
1270 let next_start = List.hd(List.rev tokens) in
1271 let dummy_info = ("",(-1,-1),(-1,-1)) in
1272 let tokens = drop_last [(PC.EOF,dummy_info)] tokens in
1273 let tokens = prepare_tokens (start@tokens) in
1274 (*
1275 print_tokens "iso tokens" tokens;
1276 *)
1277 let entry = parse_one "iso main" PC.iso_main file tokens in
1278 let entry = List.map (List.map Test_exps.process_anything) entry in
1279 if more
1280 then (* The code below allows a header like Statement list,
1281 which is more than one word. We don't have that any more,
1282 but the code is left here in case it is put back. *)
1283 match get_tokens [PC.TArobArob;PC.TArob] with
1284 (true,start) ->
1285 let (starts_with_name,start) = parse_start start in
1286 (iso_metavars,entry,rule_name) ::
1287 (loop starts_with_name (next_start::start))
1288 | _ -> failwith "isomorphism ends early"
1289 else [(iso_metavars,entry,rule_name)] in
1290 loop starts_with_name start
1291 | (false,_) -> [] in
1292 res)
1293
1294 let parse_iso_files existing_isos iso_files extra_path =
1295 let get_names = List.map (function (_,_,nm) -> nm) in
1296 let old_names = get_names existing_isos in
1297 Data.in_iso := true;
1298 let (res,_) =
1299 List.fold_left
1300 (function (prev,names) ->
1301 function file ->
1302 Lexer_cocci.init ();
1303 let file =
1304 match file with
1305 Common.Left(fl) -> Filename.concat extra_path fl
1306 | Common.Right(fl) -> Filename.concat Config.path fl in
1307 let current = parse_iso file in
1308 let new_names = get_names current in
1309 if List.exists (function x -> List.mem x names) new_names
1310 then failwith (Printf.sprintf "repeated iso name found in %s" file);
1311 (current::prev,new_names @ names))
1312 ([],old_names) iso_files in
1313 Data.in_iso := false;
1314 existing_isos@(List.concat (List.rev res))
1315
1316 let parse file =
1317 let table = Common.full_charpos_to_pos file in
1318 Common.with_open_infile file (fun channel ->
1319 let lexbuf = Lexing.from_channel channel in
1320 let get_tokens = tokens_all table file false lexbuf in
1321 Data.in_prolog := true;
1322 let initial_tokens = get_tokens [PC.TArobArob;PC.TArob] in
1323 Data.in_prolog := false;
1324 let res =
1325 match initial_tokens with
1326 (true,data) ->
1327 (match List.rev data with
1328 ((PC.TArobArob as x),_)::_ | ((PC.TArob as x),_)::_ ->
1329 let iso_files =
1330 parse_one "iso file names" PC.include_main file data in
1331
1332 let parse_cocci_rule ruletype old_metas
1333 (rule_name, dependencies, iso, dropiso, exists, is_expression) =
1334 Ast0.rule_name := rule_name;
1335 Data.inheritable_positions :=
1336 rule_name :: !Data.inheritable_positions;
1337
1338 (* get metavariable declarations *)
1339 Data.in_meta := true;
1340 let (metavars, inherited_metavars) =
1341 get_metavars PC.meta_main table file lexbuf in
1342 Data.in_meta := false;
1343 Hashtbl.add Data.all_metadecls rule_name metavars;
1344 Hashtbl.add Lexer_cocci.rule_names rule_name ();
1345 Hashtbl.add Lexer_cocci.all_metavariables rule_name
1346 (Hashtbl.fold
1347 (fun key v rest -> (key,v)::rest)
1348 Lexer_cocci.metavariables []);
1349
1350 (* get transformation rules *)
1351 let (more, tokens) = get_tokens [PC.TArobArob; PC.TArob] in
1352 let (minus_tokens, plus_tokens) = split_token_stream tokens in
1353
1354 let minus_tokens = consume_minus_positions minus_tokens in
1355 let minus_tokens = prepare_tokens minus_tokens in
1356 let plus_tokens = prepare_tokens plus_tokens in
1357
1358 (*
1359 print_tokens "minus tokens" minus_tokens;
1360 print_tokens "plus tokens" plus_tokens;
1361 *)
1362
1363 let plus_tokens =
1364 process_pragmas
1365 (fix (function x -> drop_double_dots (drop_empty_or x))
1366 (drop_when plus_tokens)) in
1367 (*
1368 print_tokens "plus tokens" plus_tokens;
1369 Printf.printf "before minus parse\n";
1370 *)
1371 let minus_res =
1372 if is_expression
1373 then parse_one "minus" PC.minus_exp_main file minus_tokens
1374 else parse_one "minus" PC.minus_main file minus_tokens in
1375 (*
1376 Unparse_ast0.unparse minus_res;
1377 Printf.printf "before plus parse\n";
1378 *)
1379 let plus_res =
1380 if !Flag.sgrep_mode2
1381 then (* not actually used for anything, except context_neg *)
1382 List.map
1383 (Iso_pattern.rebuild_mcode None).V0.rebuilder_top_level
1384 minus_res
1385 else
1386 if is_expression
1387 then parse_one "plus" PC.plus_exp_main file plus_tokens
1388 else parse_one "plus" PC.plus_main file plus_tokens in
1389 (*
1390 Printf.printf "after plus parse\n";
1391 *)
1392
1393 (if not !Flag.sgrep_mode2 &&
1394 (any_modif minus_res or any_modif plus_res)
1395 then Data.inheritable_positions := []);
1396
1397 Check_meta.check_meta rule_name old_metas inherited_metavars
1398 metavars minus_res plus_res;
1399
1400 (more, Ast0.CocciRule ((minus_res, metavars,
1401 (iso, dropiso, dependencies, rule_name, exists)),
1402 (plus_res, metavars), ruletype), metavars, tokens) in
1403
1404 let parse_script_rule language old_metas deps =
1405 let get_tokens = tokens_script_all table file false lexbuf in
1406
1407 (* meta-variables *)
1408 Data.in_meta := true;
1409 let metavars =
1410 get_script_metavars PC.script_meta_main table file lexbuf in
1411 Data.in_meta := false;
1412
1413 let exists_in old_metas (py,(r,m)) =
1414 let test (rr,mr) x =
1415 let (ro,vo) = Ast.get_meta_name x in
1416 ro = rr && vo = mr in
1417 List.exists (test (r,m)) old_metas in
1418
1419 List.iter
1420 (function x ->
1421 let meta2c (r,n) = Printf.sprintf "%s.%s" r n in
1422 if not (exists_in old_metas x) then
1423 failwith
1424 (Printf.sprintf
1425 "Script references unknown meta-variable: %s"
1426 (meta2c(snd x))))
1427 metavars;
1428
1429 (* script code *)
1430 let (more, tokens) = get_tokens [PC.TArobArob; PC.TArob] in
1431 let data =
1432 match List.hd tokens with
1433 (PC.TScriptData(s),_) -> s
1434 | (PC.TArobArob,_) | (PC.TArob,_) -> ""
1435 | _ -> failwith "Malformed script rule" in
1436 (more,Ast0.ScriptRule(language, deps, metavars, data),[],tokens) in
1437
1438 let parse_rule old_metas starts_with_name =
1439 let rulename =
1440 get_rule_name PC.rule_name starts_with_name get_tokens file
1441 "rule" in
1442 match rulename with
1443 Ast.CocciRulename (Some s, a, b, c, d, e) ->
1444 parse_cocci_rule Ast.Normal old_metas (s, a, b, c, d, e)
1445 | Ast.GeneratedRulename (Some s, a, b, c, d, e) ->
1446 Data.in_generating := true;
1447 let res =
1448 parse_cocci_rule Ast.Generated old_metas (s,a,b,c,d,e) in
1449 Data.in_generating := false;
1450 res
1451 | Ast.ScriptRulename (l,deps) -> parse_script_rule l old_metas deps
1452 | _ -> failwith "Malformed rule name"
1453 in
1454
1455 let rec loop old_metas starts_with_name =
1456 (!Data.init_rule)();
1457
1458 let gen_starts_with_name more tokens =
1459 more &&
1460 (match List.hd (List.rev tokens) with
1461 (PC.TArobArob,_) -> false
1462 | (PC.TArob,_) -> true
1463 | _ -> failwith "unexpected token")
1464 in
1465
1466 let (more, rule, metavars, tokens) =
1467 parse_rule old_metas starts_with_name in
1468 if more then
1469 rule::
1470 (loop (metavars @ old_metas) (gen_starts_with_name more tokens))
1471 else [rule];
1472
1473 in
1474
1475 (iso_files, loop [] (x = PC.TArob))
1476 | _ -> failwith "unexpected code before the first rule\n")
1477 | (false,[(PC.TArobArob,_)]) | (false,[(PC.TArob,_)]) ->
1478 ([],([] : Ast0.parsed_rule list))
1479 | _ -> failwith "unexpected code before the first rule\n" in
1480 res)
1481
1482 (* parse to ast0 and then convert to ast *)
1483 let process file isofile verbose =
1484 let extra_path = Filename.dirname file in
1485 Lexer_cocci.init();
1486 let (iso_files, rules) = parse file in
1487 let std_isos =
1488 match isofile with
1489 None -> []
1490 | Some iso_file -> parse_iso_files [] [Common.Left iso_file] "" in
1491 let global_isos = parse_iso_files std_isos iso_files extra_path in
1492 let rules = Unitary_ast0.do_unitary rules in
1493 let parsed =
1494 List.map
1495 (function
1496 Ast0.ScriptRule (a,b,c,d) -> [([],Ast.ScriptRule (a,b,c,d))]
1497 | Ast0.CocciRule
1498 ((minus, metavarsm,
1499 (iso, dropiso, dependencies, rule_name, exists)),
1500 (plus, metavars),ruletype) ->
1501 let chosen_isos =
1502 parse_iso_files global_isos
1503 (List.map (function x -> Common.Left x) iso)
1504 extra_path in
1505 let chosen_isos =
1506 (* check that dropped isos are actually available *)
1507 (try
1508 let iso_names =
1509 List.map (function (_,_,nm) -> nm) chosen_isos in
1510 let local_iso_names = reserved_names @ iso_names in
1511 let bad_dropped =
1512 List.find
1513 (function dropped ->
1514 not (List.mem dropped local_iso_names))
1515 dropiso in
1516 failwith
1517 ("invalid iso name " ^ bad_dropped ^ " in " ^ rule_name)
1518 with Not_found -> ());
1519 if List.mem "all" dropiso
1520 then
1521 if List.length dropiso = 1
1522 then []
1523 else failwith "disable all should only be by itself"
1524 else (* drop those isos *)
1525 List.filter
1526 (function (_,_,nm) -> not (List.mem nm dropiso))
1527 chosen_isos in
1528 List.iter Iso_compile.process chosen_isos;
1529 let dropped_isos =
1530 match reserved_names with
1531 "all"::others ->
1532 (match dropiso with
1533 ["all"] -> others
1534 | _ ->
1535 List.filter (function x -> List.mem x dropiso) others)
1536 | _ ->
1537 failwith
1538 "bad list of reserved names - all must be at start" in
1539 let minus = Test_exps.process minus in
1540 let minus = Compute_lines.compute_lines minus in
1541 let plus = Compute_lines.compute_lines plus in
1542 let is_exp =
1543 (* only relevant to Flag.make_hrule *)
1544 (* doesn't handle multiple minirules properly, but since
1545 we don't really handle them in lots of other ways, it
1546 doesn't seem very important *)
1547 match plus with
1548 [] -> [false]
1549 | p::_ ->
1550 [match Ast0.unwrap p with
1551 Ast0.CODE c ->
1552 (match List.map Ast0.unwrap (Ast0.undots c) with
1553 [Ast0.Exp e] -> true | _ -> false)
1554 | _ -> false] in
1555 let minus = Arity.minus_arity minus in
1556 let ((metavars,minus),function_prototypes) =
1557 Function_prototypes.process
1558 rule_name metavars dropped_isos minus plus ruletype in
1559 (* warning! context_neg side-effects its arguments *)
1560 let (m,p) = List.split (Context_neg.context_neg minus plus) in
1561 Type_infer.type_infer p;
1562 (if not !Flag.sgrep_mode2
1563 then Insert_plus.insert_plus m p (chosen_isos = []));
1564 Type_infer.type_infer minus;
1565 let (extra_meta, minus) =
1566 match (chosen_isos,ruletype) with
1567 (* separate case for [] because applying isos puts
1568 some restrictions on the -+ code *)
1569 ([],_) | (_,Ast.Generated) -> ([],minus)
1570 | _ -> Iso_pattern.apply_isos chosen_isos minus rule_name in
1571 let minus = Comm_assoc.comm_assoc minus rule_name dropiso in
1572 let minus =
1573 if !Flag.sgrep_mode2 then minus
1574 else Single_statement.single_statement minus in
1575 let minus = Simple_assignments.simple_assignments minus in
1576 let minus_ast =
1577 Ast0toast.ast0toast rule_name dependencies dropped_isos
1578 exists minus is_exp ruletype in
1579 match function_prototypes with
1580 None -> [(extra_meta @ metavars, minus_ast)]
1581 | Some mv_fp ->
1582 [(extra_meta @ metavars, minus_ast); mv_fp])
1583 (* Ast0.CocciRule ((minus, metavarsm, (iso, dropiso, dependencies, rule_name, exists)), (plus, metavars))*)
1584 rules in
1585 let parsed = List.concat parsed in
1586 let disjd = Disjdistr.disj parsed in
1587
1588 let (metavars,code,fvs,neg_pos,ua,pos) = Free_vars.free_vars disjd in
1589 if !Flag_parsing_cocci.show_SP
1590 then List.iter Pretty_print_cocci.unparse code;
1591
1592 let grep_tokens =
1593 Common.profile_code "get_constants"
1594 (fun () -> Get_constants.get_constants code) in (* for grep *)
1595 let glimpse_tokens2 =
1596 Common.profile_code "get_glimpse_constants"
1597 (fun () -> Get_constants2.get_constants code neg_pos) in(* for glimpse *)
1598 (metavars,code,fvs,neg_pos,ua,pos,grep_tokens,glimpse_tokens2)
Unnamed repository; edit this file 'description' to name the repository.