parsing_cocci/parse_cocci.ml

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