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