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