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