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