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