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