parsing_cocci/parse_cocci.ml

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