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