parsing_cocci/.#parse_cocci.ml.1.162

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