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