parsing_cocci/.#parse_cocci.ml.1.180

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