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