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