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