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