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