--- /dev/null
+(*
+* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
+* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
+* This file is part of Coccinelle.
+*
+* Coccinelle is free software: you can redistribute it and/or modify
+* it under the terms of the GNU General Public License as published by
+* the Free Software Foundation, according to version 2 of the License.
+*
+* Coccinelle is distributed in the hope that it will be useful,
+* but WITHOUT ANY WARRANTY; without even the implied warranty of
+* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+* GNU General Public License for more details.
+*
+* You should have received a copy of the GNU General Public License
+* along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
+*
+* The authors reserve the right to distribute this or future versions of
+* Coccinelle under other licenses.
+*)
+
+
+(* splits the entire file into minus and plus fragments, and parses each
+separately (thus duplicating work for the parsing of the context elements) *)
+
+module D = Data
+module PC = Parser_cocci_menhir
+module V0 = Visitor_ast0
+module Ast = Ast_cocci
+module Ast0 = Ast0_cocci
+let pr = Printf.sprintf
+(*let pr2 s = prerr_string s; prerr_string "\n"; flush stderr*)
+let pr2 s = Printf.printf "%s\n" s
+
+(* for isomorphisms. all should be at the front!!! *)
+let reserved_names =
+ ["all";"optional_storage";"optional_qualifier";"value_format";"comm_assoc"]
+
+(* ----------------------------------------------------------------------- *)
+(* Debugging... *)
+
+let line_type (d,_,_,_,_,_,_,_) = d
+
+let line_type2c tok =
+ match line_type tok with
+ D.MINUS | D.OPTMINUS | D.UNIQUEMINUS -> ":-"
+ | D.PLUS -> ":+"
+ | D.CONTEXT | D.UNIQUE | D.OPT -> ""
+
+let token2c (tok,_) =
+ match tok with
+ PC.TIdentifier -> "identifier"
+ | PC.TType -> "type"
+ | PC.TParameter -> "parameter"
+ | PC.TConstant -> "constant"
+ | PC.TExpression -> "expression"
+ | PC.TIdExpression -> "idexpression"
+ | PC.TInitialiser -> "initialiser"
+ | PC.TStatement -> "statement"
+ | PC.TPosition -> "position"
+ | PC.TPosAny -> "any"
+ | PC.TFunction -> "function"
+ | PC.TLocal -> "local"
+ | PC.Tlist -> "list"
+ | PC.TFresh -> "fresh"
+ | PC.TPure -> "pure"
+ | PC.TContext -> "context"
+ | PC.TTypedef -> "typedef"
+ | PC.TDeclarer -> "declarer"
+ | PC.TIterator -> "iterator"
+ | PC.TName -> "name"
+ | PC.TRuleName str -> "rule_name-"^str
+ | PC.TUsing -> "using"
+ | PC.TPathIsoFile str -> "path_iso_file-"^str
+ | PC.TDisable -> "disable"
+ | PC.TExtends -> "extends"
+ | PC.TDepends -> "depends"
+ | PC.TOn -> "on"
+ | PC.TEver -> "ever"
+ | PC.TNever -> "never"
+ | PC.TExists -> "exists"
+ | PC.TForall -> "forall"
+ | PC.TReverse -> "reverse"
+ | PC.TError -> "error"
+ | PC.TWords -> "words"
+ | PC.TGenerated -> "generated"
+
+ | PC.TNothing -> "nothing"
+
+ | PC.Tchar(clt) -> "char"^(line_type2c clt)
+ | PC.Tshort(clt) -> "short"^(line_type2c clt)
+ | PC.Tint(clt) -> "int"^(line_type2c clt)
+ | PC.Tdouble(clt) -> "double"^(line_type2c clt)
+ | PC.Tfloat(clt) -> "float"^(line_type2c clt)
+ | PC.Tlong(clt) -> "long"^(line_type2c clt)
+ | PC.Tvoid(clt) -> "void"^(line_type2c clt)
+ | PC.Tstruct(clt) -> "struct"^(line_type2c clt)
+ | PC.Tunion(clt) -> "union"^(line_type2c clt)
+ | PC.Tenum(clt) -> "enum"^(line_type2c clt)
+ | PC.Tunsigned(clt) -> "unsigned"^(line_type2c clt)
+ | PC.Tsigned(clt) -> "signed"^(line_type2c clt)
+ | PC.Tstatic(clt) -> "static"^(line_type2c clt)
+ | PC.Tinline(clt) -> "inline"^(line_type2c clt)
+ | PC.Ttypedef(clt) -> "typedef"^(line_type2c clt)
+ | PC.Tattr(s,clt) -> s^(line_type2c clt)
+ | PC.Tauto(clt) -> "auto"^(line_type2c clt)
+ | PC.Tregister(clt) -> "register"^(line_type2c clt)
+ | PC.Textern(clt) -> "extern"^(line_type2c clt)
+ | PC.Tconst(clt) -> "const"^(line_type2c clt)
+ | PC.Tvolatile(clt) -> "volatile"^(line_type2c clt)
+
+ | PC.TPragma(s) -> s
+ | PC.TIncludeL(s,clt) -> (pr "#include \"%s\"" s)^(line_type2c clt)
+ | PC.TIncludeNL(s,clt) -> (pr "#include <%s>" s)^(line_type2c clt)
+ | PC.TDefine(clt,_) -> "#define"^(line_type2c clt)
+ | PC.TDefineParam(clt,_,_) -> "#define_param"^(line_type2c clt)
+ | PC.TMinusFile(s,clt) -> (pr "--- %s" s)^(line_type2c clt)
+ | PC.TPlusFile(s,clt) -> (pr "+++ %s" s)^(line_type2c clt)
+
+ | PC.TInc(clt) -> "++"^(line_type2c clt)
+ | PC.TDec(clt) -> "--"^(line_type2c clt)
+
+ | PC.TIf(clt) -> "if"^(line_type2c clt)
+ | PC.TElse(clt) -> "else"^(line_type2c clt)
+ | PC.TWhile(clt) -> "while"^(line_type2c clt)
+ | PC.TFor(clt) -> "for"^(line_type2c clt)
+ | PC.TDo(clt) -> "do"^(line_type2c clt)
+ | PC.TSwitch(clt) -> "switch"^(line_type2c clt)
+ | PC.TCase(clt) -> "case"^(line_type2c clt)
+ | PC.TDefault(clt) -> "default"^(line_type2c clt)
+ | PC.TReturn(clt) -> "return"^(line_type2c clt)
+ | PC.TBreak(clt) -> "break"^(line_type2c clt)
+ | PC.TContinue(clt) -> "continue"^(line_type2c clt)
+ | PC.TGoto(clt) -> "goto"^(line_type2c clt)
+ | PC.TIdent(s,clt) -> (pr "ident-%s" s)^(line_type2c clt)
+ | PC.TTypeId(s,clt) -> (pr "typename-%s" s)^(line_type2c clt)
+ | PC.TDeclarerId(s,clt) -> (pr "declarername-%s" s)^(line_type2c clt)
+ | PC.TIteratorId(s,clt) -> (pr "iteratorname-%s" s)^(line_type2c clt)
+ | PC.TMetaDeclarer(_,_,_,clt) -> "declmeta"^(line_type2c clt)
+ | PC.TMetaIterator(_,_,_,clt) -> "itermeta"^(line_type2c clt)
+
+ | PC.TSizeof(clt) -> "sizeof"^(line_type2c clt)
+
+ | PC.TString(x,clt) -> x^(line_type2c clt)
+ | PC.TChar(x,clt) -> x^(line_type2c clt)
+ | PC.TFloat(x,clt) -> x^(line_type2c clt)
+ | PC.TInt(x,clt) -> x^(line_type2c clt)
+
+ | PC.TOrLog(clt) -> "||"^(line_type2c clt)
+ | PC.TAndLog(clt) -> "&&"^(line_type2c clt)
+ | PC.TOr(clt) -> "|"^(line_type2c clt)
+ | PC.TXor(clt) -> "^"^(line_type2c clt)
+ | PC.TAnd (clt) -> "&"^(line_type2c clt)
+ | PC.TEqEq(clt) -> "=="^(line_type2c clt)
+ | PC.TNotEq(clt) -> "!="^(line_type2c clt)
+ | PC.TLogOp(op,clt) ->
+ (match op with
+ Ast.Inf -> "<"
+ | Ast.InfEq -> "<="
+ | Ast.Sup -> ">"
+ | Ast.SupEq -> ">="
+ | _ -> failwith "not possible")
+ ^(line_type2c clt)
+ | PC.TShOp(op,clt) ->
+ (match op with
+ Ast.DecLeft -> "<<"
+ | Ast.DecRight -> ">>"
+ | _ -> failwith "not possible")
+ ^(line_type2c clt)
+ | PC.TPlus(clt) -> "+"^(line_type2c clt)
+ | PC.TMinus(clt) -> "-"^(line_type2c clt)
+ | PC.TMul(clt) -> "*"^(line_type2c clt)
+ | PC.TDmOp(op,clt) ->
+ (match op with
+ Ast.Div -> "/"
+ | Ast.Mod -> "%"
+ | _ -> failwith "not possible")
+ ^(line_type2c clt)
+ | PC.TTilde (clt) -> "~"^(line_type2c clt)
+
+ | PC.TMetaParam(_,_,clt) -> "parammeta"^(line_type2c clt)
+ | PC.TMetaParamList(_,_,_,clt) -> "paramlistmeta"^(line_type2c clt)
+ | PC.TMetaConst(_,_,_,_,clt) -> "constmeta"^(line_type2c clt)
+ | PC.TMetaErr(_,_,_,clt) -> "errmeta"^(line_type2c clt)
+ | PC.TMetaExp(_,_,_,_,clt) -> "expmeta"^(line_type2c clt)
+ | PC.TMetaIdExp(_,_,_,_,clt) -> "idexpmeta"^(line_type2c clt)
+ | PC.TMetaLocalIdExp(_,_,_,_,clt) -> "localidexpmeta"^(line_type2c clt)
+ | PC.TMetaExpList(_,_,_,clt) -> "explistmeta"^(line_type2c clt)
+ | PC.TMetaId(_,_,_,clt) -> "idmeta"^(line_type2c clt)
+ | PC.TMetaType(_,_,clt) -> "typemeta"^(line_type2c clt)
+ | PC.TMetaInit(_,_,clt) -> "initmeta"^(line_type2c clt)
+ | PC.TMetaStm(_,_,clt) -> "stmmeta"^(line_type2c clt)
+ | PC.TMetaStmList(_,_,clt) -> "stmlistmeta"^(line_type2c clt)
+ | PC.TMetaFunc(_,_,_,clt) -> "funcmeta"^(line_type2c clt)
+ | PC.TMetaLocalFunc(_,_,_,clt) -> "funcmeta"^(line_type2c clt)
+ | PC.TMetaPos(_,_,_,clt) -> "posmeta"
+ | PC.TMPtVirg -> ";"
+ | PC.TArobArob -> "@@"
+ | PC.TArob -> "@"
+ | PC.TPArob -> "P@"
+ | PC.TScript -> "script"
+
+ | PC.TWhen(clt) -> "WHEN"^(line_type2c clt)
+ | PC.TWhenTrue(clt) -> "WHEN TRUE"^(line_type2c clt)
+ | PC.TWhenFalse(clt) -> "WHEN FALSE"^(line_type2c clt)
+ | PC.TAny(clt) -> "ANY"^(line_type2c clt)
+ | PC.TStrict(clt) -> "STRICT"^(line_type2c clt)
+ | PC.TEllipsis(clt) -> "..."^(line_type2c clt)
+(*
+ | PC.TCircles(clt) -> "ooo"^(line_type2c clt)
+ | PC.TStars(clt) -> "***"^(line_type2c clt)
+*)
+
+ | PC.TOEllipsis(clt) -> "<..."^(line_type2c clt)
+ | PC.TCEllipsis(clt) -> "...>"^(line_type2c clt)
+ | PC.TPOEllipsis(clt) -> "<+..."^(line_type2c clt)
+ | PC.TPCEllipsis(clt) -> "...+>"^(line_type2c clt)
+(*
+ | PC.TOCircles(clt) -> "<ooo"^(line_type2c clt)
+ | PC.TCCircles(clt) -> "ooo>"^(line_type2c clt)
+ | PC.TOStars(clt) -> "<***"^(line_type2c clt)
+ | PC.TCStars(clt) -> "***>"^(line_type2c clt)
+*)
+ | PC.TBang0 -> "!"
+ | PC.TPlus0 -> "+"
+ | PC.TWhy0 -> "?"
+
+ | PC.TWhy(clt) -> "?"^(line_type2c clt)
+ | PC.TDotDot(clt) -> ":"^(line_type2c clt)
+ | PC.TBang(clt) -> "!"^(line_type2c clt)
+ | PC.TOPar(clt) -> "("^(line_type2c clt)
+ | PC.TOPar0(clt) -> "("^(line_type2c clt)
+ | PC.TMid0(clt) -> "|"^(line_type2c clt)
+ | PC.TCPar(clt) -> ")"^(line_type2c clt)
+ | PC.TCPar0(clt) -> ")"^(line_type2c clt)
+
+ | PC.TOBrace(clt) -> "{"^(line_type2c clt)
+ | PC.TCBrace(clt) -> "}"^(line_type2c clt)
+ | PC.TOCro(clt) -> "["^(line_type2c clt)
+ | PC.TCCro(clt) -> "]"^(line_type2c clt)
+ | PC.TOInit(clt) -> "{"^(line_type2c clt)
+
+ | PC.TPtrOp(clt) -> "->"^(line_type2c clt)
+
+ | PC.TEq(clt) -> "="^(line_type2c clt)
+ | PC.TAssign(_,clt) -> "=op"^(line_type2c clt)
+ | PC.TDot(clt) -> "."^(line_type2c clt)
+ | PC.TComma(clt) -> ","^(line_type2c clt)
+ | PC.TPtVirg(clt) -> ";"^(line_type2c clt)
+
+ | PC.EOF -> "eof"
+ | PC.TLineEnd(clt) -> "line end"
+ | PC.TInvalid -> "invalid"
+ | PC.TFunDecl(clt) -> "fundecl"
+
+ | PC.TIso -> "<=>"
+ | PC.TRightIso -> "=>"
+ | PC.TIsoTopLevel -> "TopLevel"
+ | PC.TIsoExpression -> "Expression"
+ | PC.TIsoArgExpression -> "ArgExpression"
+ | PC.TIsoTestExpression -> "TestExpression"
+ | PC.TIsoStatement -> "Statement"
+ | PC.TIsoDeclaration -> "Declaration"
+ | PC.TIsoType -> "Type"
+ | PC.TScriptData s -> s
+
+let print_tokens s tokens =
+ Printf.printf "%s\n" s;
+ List.iter (function x -> Printf.printf "%s " (token2c x)) tokens;
+ Printf.printf "\n\n";
+ flush stdout
+
+type plus = PLUS | NOTPLUS | SKIP
+
+let plus_attachable (tok,_) =
+ match tok with
+ PC.Tchar(clt) | PC.Tshort(clt) | PC.Tint(clt) | PC.Tdouble(clt)
+ | PC.Tfloat(clt) | PC.Tlong(clt) | PC.Tvoid(clt) | PC.Tstruct(clt)
+ | PC.Tunion(clt) | PC.Tenum(clt) | PC.Tunsigned(clt) | PC.Tsigned(clt)
+ | PC.Tstatic(clt)
+ | PC.Tinline(clt) | PC.Ttypedef(clt) | PC.Tattr(_,clt)
+ | PC.Tauto(clt) | PC.Tregister(clt)
+ | PC.Textern(clt) | PC.Tconst(clt) | PC.Tvolatile(clt)
+
+ | PC.TIncludeL(_,clt) | PC.TIncludeNL(_,clt) | PC.TDefine(clt,_)
+ | PC.TDefineParam(clt,_,_) | PC.TMinusFile(_,clt) | PC.TPlusFile(_,clt)
+
+ | PC.TInc(clt) | PC.TDec(clt)
+
+ | PC.TIf(clt) | PC.TElse(clt) | PC.TWhile(clt) | PC.TFor(clt) | PC.TDo(clt)
+ | PC.TSwitch(clt) | PC.TCase(clt) | PC.TDefault(clt) | PC.TReturn(clt)
+ | PC.TBreak(clt) | PC.TContinue(clt) | PC.TGoto(clt) | PC.TIdent(_,clt)
+ | PC.TTypeId(_,clt) | PC.TDeclarerId(_,clt) | PC.TIteratorId(_,clt)
+
+ | PC.TSizeof(clt)
+
+ | PC.TString(_,clt) | PC.TChar(_,clt) | PC.TFloat(_,clt) | PC.TInt(_,clt)
+
+ | PC.TOrLog(clt) | PC.TAndLog(clt) | PC.TOr(clt) | PC.TXor(clt)
+ | PC.TAnd (clt) | PC.TEqEq(clt) | PC.TNotEq(clt) | PC.TLogOp(_,clt)
+ | PC.TShOp(_,clt) | PC.TPlus(clt) | PC.TMinus(clt) | PC.TMul(clt)
+ | PC.TDmOp(_,clt) | PC.TTilde (clt)
+
+ | PC.TMetaParam(_,_,clt) | PC.TMetaParamList(_,_,_,clt)
+ | PC.TMetaConst(_,_,_,_,clt) | PC.TMetaErr(_,_,_,clt)
+ | PC.TMetaExp(_,_,_,_,clt) | PC.TMetaIdExp(_,_,_,_,clt)
+ | PC.TMetaLocalIdExp(_,_,_,_,clt)
+ | PC.TMetaExpList(_,_,_,clt)
+ | PC.TMetaId(_,_,_,clt)
+ | PC.TMetaType(_,_,clt) | PC.TMetaInit(_,_,clt) | PC.TMetaStm(_,_,clt)
+ | PC.TMetaStmList(_,_,clt) | PC.TMetaFunc(_,_,_,clt)
+ | PC.TMetaLocalFunc(_,_,_,clt)
+
+ | PC.TWhen(clt) | PC.TWhenTrue(clt) | PC.TWhenFalse(clt)
+ | PC.TAny(clt) | PC.TStrict(clt) | PC.TEllipsis(clt)
+ (* | PC.TCircles(clt) | PC.TStars(clt) *)
+
+ | PC.TWhy(clt) | PC.TDotDot(clt) | PC.TBang(clt) | PC.TOPar(clt)
+ | PC.TCPar(clt)
+
+ | PC.TOBrace(clt) | PC.TCBrace(clt) | PC.TOCro(clt) | PC.TCCro(clt)
+ | PC.TOInit(clt)
+
+ | PC.TPtrOp(clt)
+
+ | PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt)
+ | PC.TPtVirg(clt) ->
+ if line_type clt = D.PLUS then PLUS else NOTPLUS
+
+ | PC.TOPar0(clt) | PC.TMid0(clt) | PC.TCPar0(clt)
+ | PC.TOEllipsis(clt) | PC.TCEllipsis(clt)
+ | PC.TPOEllipsis(clt) | PC.TPCEllipsis(clt) (* | PC.TOCircles(clt)
+ | PC.TCCircles(clt) | PC.TOStars(clt) | PC.TCStars(clt) *) -> NOTPLUS
+ | PC.TMetaPos(nm,_,_,_) -> NOTPLUS
+
+ | _ -> SKIP
+
+let get_clt (tok,_) =
+ match tok with
+ PC.Tchar(clt) | PC.Tshort(clt) | PC.Tint(clt) | PC.Tdouble(clt)
+ | PC.Tfloat(clt) | PC.Tlong(clt) | PC.Tvoid(clt) | PC.Tstruct(clt)
+ | PC.Tunion(clt) | PC.Tenum(clt) | PC.Tunsigned(clt) | PC.Tsigned(clt)
+ | PC.Tstatic(clt)
+ | PC.Tinline(clt) | PC.Tattr(_,clt) | PC.Tauto(clt) | PC.Tregister(clt)
+ | PC.Textern(clt) | PC.Tconst(clt) | PC.Tvolatile(clt)
+
+ | PC.TIncludeL(_,clt) | PC.TIncludeNL(_,clt) | PC.TDefine(clt,_)
+ | PC.TDefineParam(clt,_,_) | PC.TMinusFile(_,clt) | PC.TPlusFile(_,clt)
+
+ | PC.TInc(clt) | PC.TDec(clt)
+
+ | PC.TIf(clt) | PC.TElse(clt) | PC.TWhile(clt) | PC.TFor(clt) | PC.TDo(clt)
+ | PC.TSwitch(clt) | PC.TCase(clt) | PC.TDefault(clt) | PC.TReturn(clt)
+ | PC.TBreak(clt) | PC.TContinue(clt) | PC.TGoto(clt) | PC.TIdent(_,clt)
+ | PC.TTypeId(_,clt) | PC.TDeclarerId(_,clt) | PC.TIteratorId(_,clt)
+
+ | PC.TSizeof(clt)
+
+ | PC.TString(_,clt) | PC.TChar(_,clt) | PC.TFloat(_,clt) | PC.TInt(_,clt)
+
+ | PC.TOrLog(clt) | PC.TAndLog(clt) | PC.TOr(clt) | PC.TXor(clt)
+ | PC.TAnd (clt) | PC.TEqEq(clt) | PC.TNotEq(clt) | PC.TLogOp(_,clt)
+ | PC.TShOp(_,clt) | PC.TPlus(clt) | PC.TMinus(clt) | PC.TMul(clt)
+ | PC.TDmOp(_,clt) | PC.TTilde (clt)
+
+ | PC.TMetaParam(_,_,clt) | PC.TMetaParamList(_,_,_,clt)
+ | PC.TMetaConst(_,_,_,_,clt) | PC.TMetaErr(_,_,_,clt)
+ | PC.TMetaExp(_,_,_,_,clt) | PC.TMetaIdExp(_,_,_,_,clt)
+ | PC.TMetaLocalIdExp(_,_,_,_,clt)
+ | PC.TMetaExpList(_,_,_,clt)
+ | PC.TMetaId(_,_,_,clt)
+ | PC.TMetaType(_,_,clt) | PC.TMetaInit(_,_,clt) | PC.TMetaStm(_,_,clt)
+ | PC.TMetaStmList(_,_,clt) | PC.TMetaFunc(_,_,_,clt)
+ | PC.TMetaLocalFunc(_,_,_,clt) | PC.TMetaPos(_,_,_,clt)
+
+ | PC.TWhen(clt) | PC.TWhenTrue(clt) | PC.TWhenFalse(clt) |
+ PC.TAny(clt) | PC.TStrict(clt) | PC.TEllipsis(clt)
+ (* | PC.TCircles(clt) | PC.TStars(clt) *)
+
+ | PC.TWhy(clt) | PC.TDotDot(clt) | PC.TBang(clt) | PC.TOPar(clt)
+ | PC.TCPar(clt)
+
+ | PC.TOBrace(clt) | PC.TCBrace(clt) | PC.TOCro(clt) | PC.TCCro(clt)
+ | PC.TOInit(clt)
+
+ | PC.TPtrOp(clt)
+
+ | PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt)
+ | PC.TPtVirg(clt)
+
+ | PC.TOPar0(clt) | PC.TMid0(clt) | PC.TCPar0(clt)
+ | PC.TOEllipsis(clt) | PC.TCEllipsis(clt)
+ | PC.TPOEllipsis(clt) | PC.TPCEllipsis(clt) (* | PC.TOCircles(clt)
+ | PC.TCCircles(clt) | PC.TOStars(clt) | PC.TCStars(clt) *) -> clt
+
+ | _ -> failwith "no clt"
+
+let update_clt (tok,x) clt =
+ match tok with
+ PC.Tchar(_) -> (PC.Tchar(clt),x)
+ | PC.Tshort(_) -> (PC.Tshort(clt),x)
+ | PC.Tint(_) -> (PC.Tint(clt),x)
+ | PC.Tdouble(_) -> (PC.Tdouble(clt),x)
+ | PC.Tfloat(_) -> (PC.Tfloat(clt),x)
+ | PC.Tlong(_) -> (PC.Tlong(clt),x)
+ | PC.Tvoid(_) -> (PC.Tvoid(clt),x)
+ | PC.Tstruct(_) -> (PC.Tstruct(clt),x)
+ | PC.Tunion(_) -> (PC.Tunion(clt),x)
+ | PC.Tenum(_) -> (PC.Tenum(clt),x)
+ | PC.Tunsigned(_) -> (PC.Tunsigned(clt),x)
+ | PC.Tsigned(_) -> (PC.Tsigned(clt),x)
+ | PC.Tstatic(_) -> (PC.Tstatic(clt),x)
+ | PC.Tinline(_) -> (PC.Tinline(clt),x)
+ | PC.Ttypedef(_) -> (PC.Ttypedef(clt),x)
+ | PC.Tattr(s,_) -> (PC.Tattr(s,clt),x)
+ | PC.Tauto(_) -> (PC.Tauto(clt),x)
+ | PC.Tregister(_) -> (PC.Tregister(clt),x)
+ | PC.Textern(_) -> (PC.Textern(clt),x)
+ | PC.Tconst(_) -> (PC.Tconst(clt),x)
+ | PC.Tvolatile(_) -> (PC.Tvolatile(clt),x)
+
+ | PC.TIncludeL(s,_) -> (PC.TIncludeL(s,clt),x)
+ | PC.TIncludeNL(s,_) -> (PC.TIncludeNL(s,clt),x)
+ | PC.TDefine(_,a) -> (PC.TDefine(clt,a),x)
+ | PC.TDefineParam(_,a,b) -> (PC.TDefineParam(clt,a,b),x)
+ | PC.TMinusFile(s,_) -> (PC.TMinusFile(s,clt),x)
+ | PC.TPlusFile(s,_) -> (PC.TPlusFile(s,clt),x)
+
+ | PC.TInc(_) -> (PC.TInc(clt),x)
+ | PC.TDec(_) -> (PC.TDec(clt),x)
+
+ | PC.TIf(_) -> (PC.TIf(clt),x)
+ | PC.TElse(_) -> (PC.TElse(clt),x)
+ | PC.TWhile(_) -> (PC.TWhile(clt),x)
+ | PC.TFor(_) -> (PC.TFor(clt),x)
+ | PC.TDo(_) -> (PC.TDo(clt),x)
+ | PC.TSwitch(_) -> (PC.TSwitch(clt),x)
+ | PC.TCase(_) -> (PC.TCase(clt),x)
+ | PC.TDefault(_) -> (PC.TDefault(clt),x)
+ | PC.TReturn(_) -> (PC.TReturn(clt),x)
+ | PC.TBreak(_) -> (PC.TBreak(clt),x)
+ | PC.TContinue(_) -> (PC.TContinue(clt),x)
+ | PC.TGoto(_) -> (PC.TGoto(clt),x)
+ | PC.TIdent(s,_) -> (PC.TIdent(s,clt),x)
+ | PC.TTypeId(s,_) -> (PC.TTypeId(s,clt),x)
+ | PC.TDeclarerId(s,_) -> (PC.TDeclarerId(s,clt),x)
+ | PC.TIteratorId(s,_) -> (PC.TIteratorId(s,clt),x)
+
+ | PC.TSizeof(_) -> (PC.TSizeof(clt),x)
+
+ | PC.TString(s,_) -> (PC.TString(s,clt),x)
+ | PC.TChar(s,_) -> (PC.TChar(s,clt),x)
+ | PC.TFloat(s,_) -> (PC.TFloat(s,clt),x)
+ | PC.TInt(s,_) -> (PC.TInt(s,clt),x)
+
+ | PC.TOrLog(_) -> (PC.TOrLog(clt),x)
+ | PC.TAndLog(_) -> (PC.TAndLog(clt),x)
+ | PC.TOr(_) -> (PC.TOr(clt),x)
+ | PC.TXor(_) -> (PC.TXor(clt),x)
+ | PC.TAnd (_) -> (PC.TAnd (clt),x)
+ | PC.TEqEq(_) -> (PC.TEqEq(clt),x)
+ | PC.TNotEq(_) -> (PC.TNotEq(clt),x)
+ | PC.TLogOp(op,_) -> (PC.TLogOp(op,clt),x)
+ | PC.TShOp(op,_) -> (PC.TShOp(op,clt),x)
+ | PC.TPlus(_) -> (PC.TPlus(clt),x)
+ | PC.TMinus(_) -> (PC.TMinus(clt),x)
+ | PC.TMul(_) -> (PC.TMul(clt),x)
+ | PC.TDmOp(op,_) -> (PC.TDmOp(op,clt),x)
+ | PC.TTilde (_) -> (PC.TTilde (clt),x)
+
+ | PC.TMetaParam(a,b,_) -> (PC.TMetaParam(a,b,clt),x)
+ | PC.TMetaParamList(a,b,c,_) -> (PC.TMetaParamList(a,b,c,clt),x)
+ | PC.TMetaConst(a,b,c,d,_) -> (PC.TMetaConst(a,b,c,d,clt),x)
+ | PC.TMetaErr(a,b,c,_) -> (PC.TMetaErr(a,b,c,clt),x)
+ | PC.TMetaExp(a,b,c,d,_) -> (PC.TMetaExp(a,b,c,d,clt),x)
+ | PC.TMetaIdExp(a,b,c,d,_) -> (PC.TMetaIdExp(a,b,c,d,clt),x)
+ | PC.TMetaLocalIdExp(a,b,c,d,_) -> (PC.TMetaLocalIdExp(a,b,c,d,clt),x)
+ | PC.TMetaExpList(a,b,c,_) -> (PC.TMetaExpList(a,b,c,clt),x)
+ | PC.TMetaId(a,b,c,_) -> (PC.TMetaId(a,b,c,clt),x)
+ | PC.TMetaType(a,b,_) -> (PC.TMetaType(a,b,clt),x)
+ | PC.TMetaInit(a,b,_) -> (PC.TMetaInit(a,b,clt),x)
+ | PC.TMetaStm(a,b,_) -> (PC.TMetaStm(a,b,clt),x)
+ | PC.TMetaStmList(a,b,_) -> (PC.TMetaStmList(a,b,clt),x)
+ | PC.TMetaFunc(a,b,c,_) -> (PC.TMetaFunc(a,b,c,clt),x)
+ | PC.TMetaLocalFunc(a,b,c,_) -> (PC.TMetaLocalFunc(a,b,c,clt),x)
+
+ | PC.TWhen(_) -> (PC.TWhen(clt),x)
+ | PC.TWhenTrue(_) -> (PC.TWhenTrue(clt),x)
+ | PC.TWhenFalse(_) -> (PC.TWhenFalse(clt),x)
+ | PC.TAny(_) -> (PC.TAny(clt),x)
+ | PC.TStrict(_) -> (PC.TStrict(clt),x)
+ | PC.TEllipsis(_) -> (PC.TEllipsis(clt),x)
+(*
+ | PC.TCircles(_) -> (PC.TCircles(clt),x)
+ | PC.TStars(_) -> (PC.TStars(clt),x)
+*)
+
+ | PC.TOEllipsis(_) -> (PC.TOEllipsis(clt),x)
+ | PC.TCEllipsis(_) -> (PC.TCEllipsis(clt),x)
+ | PC.TPOEllipsis(_) -> (PC.TPOEllipsis(clt),x)
+ | PC.TPCEllipsis(_) -> (PC.TPCEllipsis(clt),x)
+(*
+ | PC.TOCircles(_) -> (PC.TOCircles(clt),x)
+ | PC.TCCircles(_) -> (PC.TCCircles(clt),x)
+ | PC.TOStars(_) -> (PC.TOStars(clt),x)
+ | PC.TCStars(_) -> (PC.TCStars(clt),x)
+*)
+
+ | PC.TWhy(_) -> (PC.TWhy(clt),x)
+ | PC.TDotDot(_) -> (PC.TDotDot(clt),x)
+ | PC.TBang(_) -> (PC.TBang(clt),x)
+ | PC.TOPar(_) -> (PC.TOPar(clt),x)
+ | PC.TOPar0(_) -> (PC.TOPar0(clt),x)
+ | PC.TMid0(_) -> (PC.TMid0(clt),x)
+ | PC.TCPar(_) -> (PC.TCPar(clt),x)
+ | PC.TCPar0(_) -> (PC.TCPar0(clt),x)
+
+ | PC.TOBrace(_) -> (PC.TOBrace(clt),x)
+ | PC.TCBrace(_) -> (PC.TCBrace(clt),x)
+ | PC.TOCro(_) -> (PC.TOCro(clt),x)
+ | PC.TCCro(_) -> (PC.TCCro(clt),x)
+ | PC.TOInit(_) -> (PC.TOInit(clt),x)
+
+ | PC.TPtrOp(_) -> (PC.TPtrOp(clt),x)
+
+ | PC.TEq(_) -> (PC.TEq(clt),x)
+ | PC.TAssign(s,_) -> (PC.TAssign(s,clt),x)
+ | PC.TDot(_) -> (PC.TDot(clt),x)
+ | PC.TComma(_) -> (PC.TComma(clt),x)
+ | PC.TPtVirg(_) -> (PC.TPtVirg(clt),x)
+
+ | PC.TLineEnd(_) -> (PC.TLineEnd(clt),x)
+ | PC.TFunDecl(_) -> (PC.TFunDecl(clt),x)
+
+ | _ -> failwith "no clt"
+
+
+(* ----------------------------------------------------------------------- *)
+
+let make_name prefix ln = Printf.sprintf "%s starting on line %d" prefix ln
+
+(* ----------------------------------------------------------------------- *)
+(* Read tokens *)
+
+let wrap_lexbuf_info lexbuf =
+ (Lexing.lexeme lexbuf, Lexing.lexeme_start lexbuf)
+
+let tokens_all_full token table file get_ats lexbuf end_markers :
+ (bool * ((PC.token * (string * (int * int) * (int * int))) list)) =
+ try
+ let rec aux () =
+ let result = token lexbuf in
+ let info = (Lexing.lexeme lexbuf,
+ (table.(Lexing.lexeme_start lexbuf)),
+ (Lexing.lexeme_start lexbuf, Lexing.lexeme_end lexbuf)) in
+ if result = PC.EOF
+ then
+ if get_ats
+ then failwith "unexpected end of file in a metavariable declaration"
+ else (false,[(result,info)])
+ else if List.mem result end_markers
+ then (true,[(result,info)])
+ else
+ let (more,rest) = aux() in
+ (more,(result, info)::rest)
+ in aux ()
+ with
+ e -> pr2 (Common.error_message file (wrap_lexbuf_info lexbuf) ); raise e
+
+let tokens_all table file get_ats lexbuf end_markers :
+ (bool * ((PC.token * (string * (int * int) * (int * int))) list)) =
+ tokens_all_full Lexer_cocci.token table file get_ats lexbuf end_markers
+
+let tokens_script_all table file get_ats lexbuf end_markers :
+ (bool * ((PC.token * (string * (int * int) * (int * int))) list)) =
+ tokens_all_full Lexer_script.token table file get_ats lexbuf end_markers
+
+(* ----------------------------------------------------------------------- *)
+(* Split tokens into minus and plus fragments *)
+
+let split t clt =
+ let (d,_,_,_,_,_,_,_) = clt in
+ match d with
+ D.MINUS | D.OPTMINUS | D.UNIQUEMINUS -> ([t],[])
+ | D.PLUS -> ([],[t])
+ | D.CONTEXT | D.UNIQUE | D.OPT -> ([t],[t])
+
+let split_token ((tok,_) as t) =
+ match tok with
+ PC.TIdentifier | PC.TConstant | PC.TExpression | PC.TIdExpression
+ | PC.TStatement | PC.TPosition | PC.TPosAny | PC.TInitialiser
+ | PC.TFunction | PC.TTypedef | PC.TDeclarer | PC.TIterator | PC.TName
+ | PC.TType | PC.TParameter | PC.TLocal | PC.Tlist | PC.TFresh | PC.TPure
+ | PC.TContext | PC.TRuleName(_) | PC.TUsing | PC.TDisable | PC.TExtends
+ | PC.TPathIsoFile(_)
+ | PC.TDepends | PC.TOn | PC.TEver | PC.TNever | PC.TExists | PC.TForall
+ | PC.TReverse
+ | PC.TError | PC.TWords | PC.TGenerated | PC.TNothing -> ([t],[t])
+
+ | PC.Tchar(clt) | PC.Tshort(clt) | PC.Tint(clt) | PC.Tdouble(clt)
+ | PC.Tfloat(clt) | PC.Tlong(clt) | PC.Tvoid(clt) | PC.Tstruct(clt)
+ | PC.Tunion(clt) | PC.Tenum(clt) | PC.Tunsigned(clt) | PC.Tsigned(clt)
+ | PC.Tstatic(clt) | PC.Tauto(clt) | PC.Tregister(clt) | PC.Textern(clt)
+ | PC.Tinline(clt) | PC.Ttypedef(clt) | PC.Tattr(_,clt)
+ | PC.Tconst(clt) | PC.Tvolatile(clt) -> split t clt
+
+ | PC.TPragma(s) -> ([],[t]) (* only allowed in + *)
+ | PC.TPlusFile(s,clt) | PC.TMinusFile(s,clt)
+ | PC.TIncludeL(s,clt) | PC.TIncludeNL(s,clt) ->
+ split t clt
+ | PC.TDefine(clt,_) | PC.TDefineParam(clt,_,_) -> split t clt
+
+ | PC.TIf(clt) | PC.TElse(clt) | PC.TWhile(clt) | PC.TFor(clt) | PC.TDo(clt)
+ | PC.TSwitch(clt) | PC.TCase(clt) | PC.TDefault(clt)
+ | PC.TSizeof(clt)
+ | PC.TReturn(clt) | PC.TBreak(clt) | PC.TContinue(clt) | PC.TGoto(clt)
+ | PC.TIdent(_,clt)
+ | PC.TTypeId(_,clt) | PC.TDeclarerId(_,clt) | PC.TIteratorId(_,clt)
+ | PC.TMetaConst(_,_,_,_,clt) | PC.TMetaExp(_,_,_,_,clt)
+ | PC.TMetaIdExp(_,_,_,_,clt) | PC.TMetaLocalIdExp(_,_,_,_,clt)
+ | PC.TMetaExpList(_,_,_,clt)
+ | PC.TMetaParam(_,_,clt) | PC.TMetaParamList(_,_,_,clt)
+ | PC.TMetaId(_,_,_,clt) | PC.TMetaType(_,_,clt) | PC.TMetaInit(_,_,clt)
+ | PC.TMetaStm(_,_,clt) | PC.TMetaStmList(_,_,clt) | PC.TMetaErr(_,_,_,clt)
+ | PC.TMetaFunc(_,_,_,clt) | PC.TMetaLocalFunc(_,_,_,clt)
+ | PC.TMetaDeclarer(_,_,_,clt) | PC.TMetaIterator(_,_,_,clt) -> split t clt
+ | PC.TMPtVirg | PC.TArob | PC.TArobArob | PC.TScript -> ([t],[t])
+ | PC.TPArob | PC.TMetaPos(_,_,_,_) -> ([t],[])
+
+ | PC.TFunDecl(clt)
+ | PC.TWhen(clt) | PC.TWhenTrue(clt) | PC.TWhenFalse(clt)
+ | PC.TAny(clt) | PC.TStrict(clt) | PC.TLineEnd(clt)
+ | PC.TEllipsis(clt) (* | PC.TCircles(clt) | PC.TStars(clt) *) -> split t clt
+
+ | PC.TOEllipsis(_) | PC.TCEllipsis(_) (* clt must be context *)
+ | PC.TPOEllipsis(_) | PC.TPCEllipsis(_) (* clt must be context *)
+(*
+ | PC.TOCircles(_) | PC.TCCircles(_) (* clt must be context *)
+ | PC.TOStars(_) | PC.TCStars(_) (* clt must be context *)
+*)
+ | PC.TBang0 | PC.TPlus0 | PC.TWhy0 ->
+ ([t],[t])
+
+ | PC.TWhy(clt) | PC.TDotDot(clt)
+ | PC.TBang(clt) | PC.TOPar(clt) | PC.TOPar0(clt)
+ | PC.TMid0(clt) | PC.TCPar(clt) | PC.TCPar0(clt) -> split t clt
+
+ | PC.TInc(clt) | PC.TDec(clt) -> split t clt
+
+ | PC.TString(_,clt) | PC.TChar(_,clt) | PC.TFloat(_,clt) | PC.TInt(_,clt) ->
+ split t clt
+
+ | PC.TOrLog(clt) | PC.TAndLog(clt) | PC.TOr(clt) | PC.TXor(clt)
+ | PC.TAnd (clt) | PC.TEqEq(clt) | PC.TNotEq(clt) | PC.TLogOp(_,clt)
+ | PC.TShOp(_,clt) | PC.TPlus(clt) | PC.TMinus(clt) | PC.TMul(clt)
+ | PC.TDmOp(_,clt) | PC.TTilde (clt) -> split t clt
+
+ | PC.TOBrace(clt) | PC.TCBrace(clt) | PC.TOInit(clt) -> split t clt
+ | PC.TOCro(clt) | PC.TCCro(clt) -> split t clt
+
+ | PC.TPtrOp(clt) -> split t clt
+
+ | PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt)
+ | PC.TPtVirg(clt) -> split t clt
+
+ | PC.EOF | PC.TInvalid -> ([t],[t])
+
+ | PC.TIso | PC.TRightIso
+ | PC.TIsoExpression | PC.TIsoStatement | PC.TIsoDeclaration | PC.TIsoType
+ | PC.TIsoTopLevel | PC.TIsoArgExpression | PC.TIsoTestExpression ->
+ failwith "unexpected tokens"
+ | PC.TScriptData s -> ([t],[t])
+
+let split_token_stream tokens =
+ let rec loop = function
+ [] -> ([],[])
+ | token::tokens ->
+ let (minus,plus) = split_token token in
+ let (minus_stream,plus_stream) = loop tokens in
+ (minus@minus_stream,plus@plus_stream) in
+ loop tokens
+
+(* ----------------------------------------------------------------------- *)
+(* Find function names *)
+(* This addresses a shift-reduce problem in the parser, allowing us to
+distinguish a function declaration from a function call even if the latter
+has no return type. Undoubtedly, this is not very nice, but it doesn't
+seem very convenient to refactor the grammar to get around the problem. *)
+
+let rec find_function_names = function
+ [] -> []
+ | ((PC.TIdent(_,clt),info) as t1) :: ((PC.TOPar(_),_) as t2) :: rest
+ | ((PC.TMetaId(_,_,_,clt),info) as t1) :: ((PC.TOPar(_),_) as t2) :: rest
+ | ((PC.TMetaFunc(_,_,_,clt),info) as t1) :: ((PC.TOPar(_),_) as t2) :: rest
+ | ((PC.TMetaLocalFunc(_,_,_,clt),info) as t1)::((PC.TOPar(_),_) as t2)::rest
+ ->
+ let rec skip level = function
+ [] -> ([],false,[])
+ | ((PC.TCPar(_),_) as t)::rest ->
+ let level = level - 1 in
+ if level = 0
+ then ([t],true,rest)
+ else let (pre,found,post) = skip level rest in (t::pre,found,post)
+ | ((PC.TOPar(_),_) as t)::rest ->
+ let level = level + 1 in
+ let (pre,found,post) = skip level rest in (t::pre,found,post)
+ | ((PC.TArobArob,_) as t)::rest
+ | ((PC.TArob,_) as t)::rest
+ | ((PC.EOF,_) as t)::rest -> ([t],false,rest)
+ | t::rest ->
+ let (pre,found,post) = skip level rest in (t::pre,found,post) in
+ let (pre,found,post) = skip 1 rest in
+ (match (found,post) with
+ (true,((PC.TOBrace(_),_) as t3)::rest) ->
+ (PC.TFunDecl(clt),info) :: t1 :: t2 :: pre @
+ t3 :: (find_function_names rest)
+ | _ -> t1 :: t2 :: pre @ find_function_names post)
+ | t :: rest -> t :: find_function_names rest
+
+(* ----------------------------------------------------------------------- *)
+(* an attribute is an identifier that preceeds another identifier and
+ begins with __ *)
+
+let rec detect_attr l =
+ let is_id = function
+ (PC.TIdent(_,_),_) | (PC.TMetaId(_,_,_,_),_) | (PC.TMetaFunc(_,_,_,_),_)
+ | (PC.TMetaLocalFunc(_,_,_,_),_) -> true
+ | _ -> false in
+ let rec loop = function
+ [] -> []
+ | [x] -> [x]
+ | ((PC.TIdent(nm,clt),info) as t1)::id::rest when is_id id ->
+ if String.length nm > 2 && String.sub nm 0 2 = "__"
+ then (PC.Tattr(nm,clt),info)::(loop (id::rest))
+ else t1::(loop (id::rest))
+ | x::xs -> x::(loop xs) in
+ loop l
+
+(* ----------------------------------------------------------------------- *)
+(* Look for variable declarations where the name is a typedef name.
+We assume that C code does not contain a multiplication as a top-level
+statement. *)
+
+(* bug: once a type, always a type, even if the same name is later intended
+ to be used as a real identifier *)
+let detect_types in_meta_decls l =
+ let is_delim infn = function
+ (PC.TOEllipsis(_),_) (* | (PC.TOCircles(_),_) | (PC.TOStars(_),_) *)
+ | (PC.TPOEllipsis(_),_) (* | (PC.TOCircles(_),_) | (PC.TOStars(_),_) *)
+ | (PC.TEllipsis(_),_) (* | (PC.TCircles(_),_) | (PC.TStars(_),_) *)
+ | (PC.TPtVirg(_),_) | (PC.TOBrace(_),_) | (PC.TOInit(_),_)
+ | (PC.TCBrace(_),_)
+ | (PC.TPure,_) | (PC.TContext,_)
+ | (PC.Tstatic(_),_) | (PC.Textern(_),_)
+ | (PC.Tinline(_),_) | (PC.Ttypedef(_),_) | (PC.Tattr(_),_) -> true
+ | (PC.TComma(_),_) when infn > 0 or in_meta_decls -> true
+ | (PC.TDotDot(_),_) when in_meta_decls -> true
+ | _ -> false in
+ let is_choices_delim = function
+ (PC.TOBrace(_),_) | (PC.TComma(_),_) -> true | _ -> false in
+ let is_id = function
+ (PC.TIdent(_,_),_) | (PC.TMetaId(_,_,_,_),_) | (PC.TMetaFunc(_,_,_,_),_)
+ | (PC.TMetaLocalFunc(_,_,_,_),_) -> true
+ | (PC.TMetaParam(_,_,_),_)
+ | (PC.TMetaParamList(_,_,_,_),_)
+ | (PC.TMetaConst(_,_,_,_,_),_)
+ | (PC.TMetaErr(_,_,_,_),_)
+ | (PC.TMetaExp(_,_,_,_,_),_)
+ | (PC.TMetaIdExp(_,_,_,_,_),_)
+ | (PC.TMetaLocalIdExp(_,_,_,_,_),_)
+ | (PC.TMetaExpList(_,_,_,_),_)
+ | (PC.TMetaType(_,_,_),_)
+ | (PC.TMetaInit(_,_,_),_)
+ | (PC.TMetaStm(_,_,_),_)
+ | (PC.TMetaStmList(_,_,_),_)
+ | (PC.TMetaPos(_,_,_,_),_) -> in_meta_decls
+ | _ -> false in
+ let redo_id ident clt v =
+ !Data.add_type_name ident;
+ (PC.TTypeId(ident,clt),v) in
+ let rec loop start infn type_names = function
+ (* infn: 0 means not in a function header
+ > 0 means in a function header, after infn - 1 unmatched open parens*)
+ [] -> []
+ | ((PC.TOBrace(clt),v)::_) as all when in_meta_decls ->
+ collect_choices type_names all (* never a function header *)
+ | delim::(PC.TIdent(ident,clt),v)::((PC.TMul(_),_) as x)::rest
+ when is_delim infn delim ->
+ let newid = redo_id ident clt v in
+ delim::newid::x::(loop false infn (ident::type_names) rest)
+ | delim::(PC.TIdent(ident,clt),v)::id::rest
+ when is_delim infn delim && is_id id ->
+ let newid = redo_id ident clt v in
+ delim::newid::id::(loop false infn (ident::type_names) rest)
+ | ((PC.TFunDecl(_),_) as fn)::rest ->
+ fn::(loop false 1 type_names rest)
+ | ((PC.TOPar(_),_) as lp)::rest when infn > 0 ->
+ lp::(loop false (infn + 1) type_names rest)
+ | ((PC.TCPar(_),_) as rp)::rest when infn > 0 ->
+ if infn - 1 = 1
+ then rp::(loop false 0 type_names rest) (* 0 means not in fn header *)
+ else rp::(loop false (infn - 1) type_names rest)
+ | (PC.TIdent(ident,clt),v)::((PC.TMul(_),_) as x)::rest when start ->
+ let newid = redo_id ident clt v in
+ newid::x::(loop false infn (ident::type_names) rest)
+ | (PC.TIdent(ident,clt),v)::id::rest when start && is_id id ->
+ let newid = redo_id ident clt v in
+ newid::id::(loop false infn (ident::type_names) rest)
+ | (PC.TIdent(ident,clt),v)::rest when List.mem ident type_names ->
+ (PC.TTypeId(ident,clt),v)::(loop false infn type_names rest)
+ | ((PC.TIdent(ident,clt),v) as x)::rest ->
+ x::(loop false infn type_names rest)
+ | x::rest -> x::(loop false infn type_names rest)
+ and collect_choices type_names = function
+ [] -> [] (* should happen, but let the parser detect that *)
+ | (PC.TCBrace(clt),v)::rest ->
+ (PC.TCBrace(clt),v)::(loop false 0 type_names rest)
+ | delim::(PC.TIdent(ident,clt),v)::rest
+ when is_choices_delim delim ->
+ let newid = redo_id ident clt v in
+ delim::newid::(collect_choices (ident::type_names) rest)
+ | x::rest -> x::(collect_choices type_names rest) in
+ loop true 0 [] l
+
+
+(* ----------------------------------------------------------------------- *)
+(* Insert TLineEnd tokens at the end of a line that contains a WHEN.
+ WHEN is restricted to a single line, to avoid ambiguity in eg:
+ ... WHEN != x
+ +3 *)
+
+let token2line (tok,_) =
+ match tok with
+ PC.Tchar(clt) | PC.Tshort(clt) | PC.Tint(clt) | PC.Tdouble(clt)
+ | PC.Tfloat(clt) | PC.Tlong(clt) | PC.Tvoid(clt) | PC.Tstruct(clt)
+ | PC.Tunion(clt) | PC.Tenum(clt) | PC.Tunsigned(clt) | PC.Tsigned(clt)
+ | PC.Tstatic(clt) | PC.Tauto(clt) | PC.Tregister(clt) | PC.Textern(clt)
+ | PC.Tinline(clt) | PC.Ttypedef(clt) | PC.Tattr(_,clt) | PC.Tconst(clt)
+ | PC.Tvolatile(clt)
+
+ | PC.TInc(clt) | PC.TDec(clt)
+
+ | PC.TIf(clt) | PC.TElse(clt) | PC.TWhile(clt) | PC.TFor(clt) | PC.TDo(clt)
+ | PC.TSwitch (clt) | PC.TCase (clt) | PC.TDefault (clt) | PC.TSizeof (clt)
+ | PC.TReturn(clt) | PC.TBreak(clt) | PC.TContinue(clt) | PC.TGoto(clt)
+ | PC.TIdent(_,clt)
+ | PC.TTypeId(_,clt) | PC.TDeclarerId(_,clt) | PC.TIteratorId(_,clt)
+ | PC.TMetaDeclarer(_,_,_,clt) | PC.TMetaIterator(_,_,_,clt)
+
+ | PC.TString(_,clt) | PC.TChar(_,clt) | PC.TFloat(_,clt) | PC.TInt(_,clt)
+
+ | PC.TOrLog(clt) | PC.TAndLog(clt) | PC.TOr(clt) | PC.TXor(clt)
+ | PC.TAnd (clt) | PC.TEqEq(clt) | PC.TNotEq(clt) | PC.TLogOp(_,clt)
+ | PC.TShOp(_,clt) | PC.TPlus(clt) | PC.TMinus(clt) | PC.TMul(clt)
+ | PC.TDmOp(_,clt) | PC.TTilde (clt)
+
+ | PC.TMetaParam(_,_,clt) | PC.TMetaParamList(_,_,_,clt)
+ | PC.TMetaConst(_,_,_,_,clt) | PC.TMetaExp(_,_,_,_,clt)
+ | PC.TMetaIdExp(_,_,_,_,clt) | PC.TMetaLocalIdExp(_,_,_,_,clt)
+ | PC.TMetaExpList(_,_,_,clt)
+ | PC.TMetaId(_,_,_,clt) | PC.TMetaType(_,_,clt) | PC.TMetaInit(_,_,clt)
+ | PC.TMetaStm(_,_,clt) | PC.TMetaStmList(_,_,clt) | PC.TMetaFunc(_,_,_,clt)
+ | PC.TMetaLocalFunc(_,_,_,clt) | PC.TMetaPos(_,_,_,clt)
+
+ | PC.TFunDecl(clt)
+ | PC.TWhen(clt) | PC.TWhenTrue(clt) | PC.TWhenFalse(clt)
+ | PC.TAny(clt) | PC.TStrict(clt) | PC.TEllipsis(clt)
+ (* | PC.TCircles(clt) | PC.TStars(clt) *)
+
+ | PC.TOEllipsis(clt) | PC.TCEllipsis(clt)
+ | PC.TPOEllipsis(clt) | PC.TPCEllipsis(clt) (*| PC.TOCircles(clt)
+ | PC.TCCircles(clt) | PC.TOStars(clt) | PC.TCStars(clt) *)
+
+ | PC.TWhy(clt) | PC.TDotDot(clt) | PC.TBang(clt) | PC.TOPar(clt)
+ | PC.TOPar0(clt) | PC.TMid0(clt) | PC.TCPar(clt)
+ | PC.TCPar0(clt)
+
+ | PC.TOBrace(clt) | PC.TCBrace(clt) | PC.TOCro(clt) | PC.TCCro(clt)
+ | PC.TOInit(clt)
+
+ | PC.TPtrOp(clt)
+
+ | PC.TDefine(clt,_) | PC.TDefineParam(clt,_,_)
+ | PC.TIncludeL(_,clt) | PC.TIncludeNL(_,clt)
+
+ | PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt)
+ | PC.TPtVirg(clt) ->
+ let (_,line,_,_,_,_,_,_) = clt in Some line
+
+ | _ -> None
+
+let rec insert_line_end = function
+ [] -> []
+ | (((PC.TWhen(clt),q) as x)::xs) ->
+ x::(find_line_end true (token2line x) clt q xs)
+ | (((PC.TDefine(clt,_),q) as x)::xs)
+ | (((PC.TDefineParam(clt,_,_),q) as x)::xs) ->
+ x::(find_line_end false (token2line x) clt q xs)
+ | x::xs -> x::(insert_line_end xs)
+
+and find_line_end inwhen line clt q = function
+ (* don't know what 2nd component should be so just use the info of
+ the When. Also inherit - of when, if any *)
+ [] -> [(PC.TLineEnd(clt),q)]
+ | ((PC.TIdent("strict",clt),a) as x)::xs when token2line x = line ->
+ (PC.TStrict(clt),a) :: (find_line_end inwhen line clt q xs)
+ | ((PC.TIdent("STRICT",clt),a) as x)::xs when token2line x = line ->
+ (PC.TStrict(clt),a) :: (find_line_end inwhen line clt q xs)
+ | ((PC.TIdent("any",clt),a) as x)::xs when token2line x = line ->
+ (PC.TAny(clt),a) :: (find_line_end inwhen line clt q xs)
+ | ((PC.TIdent("ANY",clt),a) as x)::xs when token2line x = line ->
+ (PC.TAny(clt),a) :: (find_line_end inwhen line clt q xs)
+ | ((PC.TIdent("forall",clt),a) as x)::xs when token2line x = line ->
+ (PC.TForall,a) :: (find_line_end inwhen line clt q xs)
+ | ((PC.TIdent("exists",clt),a) as x)::xs when token2line x = line ->
+ (PC.TExists,a) :: (find_line_end inwhen line clt q xs)
+ | ((PC.TComma(clt),a) as x)::xs when token2line x = line ->
+ (PC.TComma(clt),a) :: (find_line_end inwhen line clt q xs)
+ | ((PC.TPArob,a) as x)::xs -> (* no line #, just assume on the same line *)
+ x :: (find_line_end inwhen line clt q xs)
+ | x::xs when token2line x = line -> x :: (find_line_end inwhen line clt q xs)
+ | xs -> (PC.TLineEnd(clt),q)::(insert_line_end xs)
+
+let rec translate_when_true_false = function
+ [] -> []
+ | (PC.TWhen(clt),q)::((PC.TNotEq(_),_) as x)::(PC.TIdent("true",_),_)::xs ->
+ (PC.TWhenTrue(clt),q)::x::(translate_when_true_false xs)
+ | (PC.TWhen(clt),q)::((PC.TNotEq(_),_) as x)::(PC.TIdent("false",_),_)::xs ->
+ (PC.TWhenFalse(clt),q)::x::(translate_when_true_false xs)
+ | x::xs -> x :: (translate_when_true_false xs)
+
+(* ----------------------------------------------------------------------- *)
+(* top level initializers: a sequence of braces followed by a dot *)
+
+let find_top_init tokens =
+ match tokens with
+ (PC.TOBrace(clt),q) :: rest ->
+ let rec dot_start acc = function
+ ((PC.TOBrace(_),_) as x) :: rest ->
+ dot_start (x::acc) rest
+ | ((PC.TDot(_),_) :: rest) as x ->
+ Some ((PC.TOInit(clt),q) :: (List.rev acc) @ x)
+ | l -> None in
+ let rec comma_end acc = function
+ ((PC.TCBrace(_),_) as x) :: rest ->
+ comma_end (x::acc) rest
+ | ((PC.TComma(_),_) :: rest) as x ->
+ Some ((PC.TOInit(clt),q) :: (List.rev x) @ acc)
+ | l -> None in
+ (match dot_start [] rest with
+ Some x -> x
+ | None ->
+ (match List.rev rest with
+ (* not super sure what this does, but EOF, @, and @@ should be
+ the same, markind the end of a rule *)
+ ((PC.EOF,_) as x)::rest | ((PC.TArob,_) as x)::rest
+ | ((PC.TArobArob,_) as x)::rest ->
+ (match comma_end [x] rest with
+ Some x -> x
+ | None -> tokens)
+ | _ ->
+ failwith "unexpected empty token list"))
+ | _ -> tokens
+
+(* ----------------------------------------------------------------------- *)
+(* process pragmas: they can only be used in + code, and adjacent to
+another + token. They are concatenated to the string representation of
+that other token. *)
+
+let rec collect_all_pragmas collected = function
+ (PC.TPragma(s),_)::rest -> collect_all_pragmas (s::collected) rest
+ | l -> (List.rev collected,l)
+
+let rec collect_up_to_pragmas skipped = function
+ [] -> None (* didn't reach a pragma, so nothing to do *)
+ | ((PC.TPragma(s),_) as t)::rest ->
+ let (pragmas,rest) = collect_all_pragmas [] (t::rest) in
+ Some (List.rev skipped,pragmas,rest)
+ | x::xs ->
+ match plus_attachable x with
+ PLUS -> None
+ | NOTPLUS -> None
+ | SKIP -> collect_up_to_pragmas (x::skipped) xs
+
+let rec collect_up_to_plus skipped = function
+ [] -> failwith "nothing to attach a pragma to (empty)"
+ | x::xs ->
+ match plus_attachable x with
+ PLUS -> (List.rev skipped,x,xs)
+ | NOTPLUS -> failwith "nothing to attach a pragma to"
+ | SKIP -> collect_up_to_plus (x::skipped) xs
+
+let rec process_pragmas = function
+ [] -> []
+ | ((PC.TPragma(s),_)::_) as l ->
+ let (pragmas,rest) = collect_all_pragmas [] l in
+ let (skipped,aft,rest) = collect_up_to_plus [] rest in
+ let (a,b,c,d,e,strbef,straft,pos) = get_clt aft in
+ skipped@
+ (process_pragmas ((update_clt aft (a,b,c,d,e,pragmas,straft,pos))::rest))
+ | bef::xs ->
+ (match plus_attachable bef with
+ PLUS ->
+ (match collect_up_to_pragmas [] xs with
+ Some(skipped,pragmas,rest) ->
+ let (a,b,c,d,e,strbef,straft,pos) = get_clt bef in
+ (update_clt bef (a,b,c,d,e,strbef,pragmas,pos))::
+ skipped@(process_pragmas rest)
+ | None -> bef::(process_pragmas xs))
+ | _ -> bef::(process_pragmas xs))
+
+(* ----------------------------------------------------------------------- *)
+(* Drop ... ... . This is only allowed in + code, and arises when there is
+some - code between the ... *)
+(* drop whens as well - they serve no purpose in + code and they cause
+problems for drop_double_dots *)
+
+let rec drop_when = function
+ [] -> []
+ | (PC.TWhen(clt),info)::xs ->
+ let rec loop = function
+ [] -> []
+ | (PC.TLineEnd(_),info)::xs -> drop_when xs
+ | x::xs -> loop xs in
+ loop xs
+ | x::xs -> x::drop_when xs
+
+(* instead of dropping the double dots, we put TNothing in between them.
+these vanish after the parser, but keeping all the ...s in the + code makes
+it easier to align the + and - code in context_neg and in preparation for the
+isomorphisms. This shouldn't matter because the context code of the +
+slice is mostly ignored anyway *)
+let minus_to_nothing l =
+ (* for cases like | <..., which may or may not arise from removing minus
+ code, depending on whether <... is a statement or expression *)
+ let is_minus tok =
+ try
+ let (d,_,_,_,_,_,_,_) = get_clt tok in
+ (match d with
+ D.MINUS | D.OPTMINUS | D.UNIQUEMINUS -> true
+ | D.PLUS -> false
+ | D.CONTEXT | D.UNIQUE | D.OPT -> false)
+ with _ -> false in
+ let rec minus_loop = function
+ [] -> []
+ | (d::ds) as l -> if is_minus d then minus_loop ds else l in
+ let rec loop = function
+ [] -> []
+ | ((PC.TMid0(clt),i) as x)::t1::ts when is_minus t1 ->
+ (match minus_loop ts with
+ ((PC.TOEllipsis(_),_)::_) | ((PC.TPOEllipsis(_),_)::_)
+ | ((PC.TEllipsis(_),_)::_) as l -> x::(PC.TNothing,i)::(loop l)
+ | l -> x::(loop l))
+ | t::ts -> t::(loop ts) in
+ loop l
+
+let rec drop_double_dots l =
+ let start = function
+ (PC.TOEllipsis(_),_) | (PC.TPOEllipsis(_),_)
+ (* | (PC.TOCircles(_),_) | (PC.TOStars(_),_) *) ->
+ true
+ | _ -> false in
+ let middle = function
+ (PC.TEllipsis(_),_) (* | (PC.TCircles(_),_) | (PC.TStars(_),_) *) -> true
+ | _ -> false in
+ let whenline = function
+ (PC.TLineEnd(_),_) -> true
+ (*| (PC.TMid0(_),_) -> true*)
+ | _ -> false in
+ let final = function
+ (PC.TCEllipsis(_),_) | (PC.TPCEllipsis(_),_)
+ (* | (PC.TCCircles(_),_) | (PC.TCStars(_),_) *) ->
+ true
+ | _ -> false in
+ let any_before x = start x or middle x or final x or whenline x in
+ let any_after x = start x or middle x or final x in
+ let rec loop ((_,i) as prev) = function
+ [] -> []
+ | x::rest when any_before prev && any_after x ->
+ (PC.TNothing,i)::x::(loop x rest)
+ | x::rest -> x :: (loop x rest) in
+ match l with
+ [] -> []
+ | (x::xs) -> x :: loop x xs
+
+let rec fix f l =
+ let cur = f l in
+ if l = cur then l else fix f cur
+
+(* ( | ... | ) also causes parsing problems *)
+
+exception Not_empty
+
+let rec drop_empty_thing starter middle ender = function
+ [] -> []
+ | hd::rest when starter hd ->
+ let rec loop = function
+ x::rest when middle x -> loop rest
+ | x::rest when ender x -> rest
+ | _ -> raise Not_empty in
+ (match try Some(loop rest) with Not_empty -> None with
+ Some x -> drop_empty_thing starter middle ender x
+ | None -> hd :: drop_empty_thing starter middle ender rest)
+ | x::rest -> x :: drop_empty_thing starter middle ender rest
+
+let drop_empty_or =
+ drop_empty_thing
+ (function (PC.TOPar0(_),_) -> true | _ -> false)
+ (function (PC.TMid0(_),_) -> true | _ -> false)
+ (function (PC.TCPar0(_),_) -> true | _ -> false)
+
+let drop_empty_nest = drop_empty_thing
+
+(* ----------------------------------------------------------------------- *)
+(* Read tokens *)
+
+let get_s_starts (_, (s,_,(starts, ends))) =
+ Printf.printf "%d %d\n" starts ends; (s, starts)
+
+let pop2 l =
+ let v = List.hd !l in
+ l := List.tl !l;
+ v
+
+let reinit _ =
+ PC.reinit (function _ -> PC.TArobArob (* a handy token *))
+ (Lexing.from_function
+ (function buf -> function n -> raise Common.Impossible))
+
+let parse_one str parsefn file toks =
+ let all_tokens = ref toks in
+ let cur_tok = ref (List.hd !all_tokens) in
+
+ let lexer_function _ =
+ let (v, info) = pop2 all_tokens in
+ cur_tok := (v, info);
+ v in
+
+ let lexbuf_fake =
+ Lexing.from_function
+ (function buf -> function n -> raise Common.Impossible)
+ in
+
+ reinit();
+
+ try parsefn lexer_function lexbuf_fake
+ with
+ Lexer_cocci.Lexical s ->
+ failwith
+ (Printf.sprintf "%s: lexical error: %s\n =%s\n" str s
+ (Common.error_message file (get_s_starts !cur_tok) ))
+ | Parser_cocci_menhir.Error ->
+ failwith
+ (Printf.sprintf "%s: parse error: \n = %s\n" str
+ (Common.error_message file (get_s_starts !cur_tok) ))
+ | Semantic_cocci.Semantic s ->
+ failwith
+ (Printf.sprintf "%s: semantic error: %s\n =%s\n" str s
+ (Common.error_message file (get_s_starts !cur_tok) ))
+
+ | e -> raise e
+
+let prepare_tokens tokens =
+ find_top_init
+ (translate_when_true_false (* after insert_line_end *)
+ (insert_line_end
+ (detect_types false (find_function_names (detect_attr tokens)))))
+
+let prepare_mv_tokens tokens =
+ detect_types false (detect_attr tokens)
+
+let rec consume_minus_positions = function
+ [] -> []
+ | ((PC.TOPar0(_),_) as x)::xs | ((PC.TCPar0(_),_) as x)::xs
+ | ((PC.TMid0(_),_) as x)::xs -> x::consume_minus_positions xs
+ | x::(PC.TPArob,_)::(PC.TMetaPos(name,constraints,per,clt),_)::xs ->
+ let (arity,ln,lln,offset,col,strbef,straft,_) = get_clt x in
+ let name = Parse_aux.clt2mcode name clt in
+ let x =
+ update_clt x
+ (arity,ln,lln,offset,col,strbef,straft,
+ Ast0.MetaPos(name,constraints,per)) in
+ x::(consume_minus_positions xs)
+ | x::xs -> x::consume_minus_positions xs
+
+let any_modif rule =
+ let mcode x =
+ match Ast0.get_mcode_mcodekind x with
+ Ast0.MINUS _ | Ast0.PLUS -> true
+ | _ -> false in
+ let donothing r k e = k e in
+ let bind x y = x or y in
+ let option_default = false in
+ let fn =
+ V0.combiner bind option_default
+ mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
+ donothing donothing donothing donothing donothing donothing
+ donothing donothing donothing donothing donothing donothing donothing
+ donothing donothing in
+ List.exists fn.V0.combiner_top_level rule
+
+let drop_last extra l = List.rev(extra@(List.tl(List.rev l)))
+
+let partition_either l =
+ let rec part_either left right = function
+ | [] -> (List.rev left, List.rev right)
+ | x :: l ->
+ (match x with
+ | Common.Left e -> part_either (e :: left) right l
+ | Common.Right e -> part_either left (e :: right) l) in
+ part_either [] [] l
+
+let get_metavars parse_fn table file lexbuf =
+ let rec meta_loop acc (* read one decl at a time *) =
+ let (_,tokens) =
+ tokens_all table file true lexbuf [PC.TArobArob;PC.TMPtVirg] in
+ let tokens = prepare_mv_tokens tokens in
+ match tokens with
+ [(PC.TArobArob,_)] -> List.rev acc
+ | _ ->
+ let metavars = parse_one "meta" parse_fn file tokens in
+ meta_loop (metavars@acc) in
+ partition_either (meta_loop [])
+
+let get_script_metavars parse_fn table file lexbuf =
+ let rec meta_loop acc =
+ let (_, tokens) =
+ tokens_all table file true lexbuf [PC.TArobArob; PC.TMPtVirg] in
+ let tokens = prepare_tokens tokens in
+ match tokens with
+ [(PC.TArobArob, _)] -> List.rev acc
+ | _ ->
+ let metavar = parse_one "scriptmeta" parse_fn file tokens in
+ meta_loop (metavar :: acc)
+ in
+ meta_loop []
+
+let get_rule_name parse_fn starts_with_name get_tokens file prefix =
+ Data.in_rule_name := true;
+ let mknm _ = make_name prefix (!Lexer_cocci.line) in
+ let name_res =
+ if starts_with_name
+ then
+ let (_,tokens) = get_tokens [PC.TArob] in
+ let check_name = function
+ None -> Some (mknm())
+ | Some nm ->
+ (if List.mem nm reserved_names
+ then failwith (Printf.sprintf "invalid name %s\n" nm));
+ Some nm in
+ match parse_one "rule name" parse_fn file tokens with
+ Ast.CocciRulename (nm,a,b,c,d,e) ->
+ Ast.CocciRulename (check_name nm,a,b,c,d,e)
+ | Ast.GeneratedRulename (nm,a,b,c,d,e) ->
+ Ast.GeneratedRulename (check_name nm,a,b,c,d,e)
+ | Ast.ScriptRulename(s,deps) -> Ast.ScriptRulename(s,deps)
+ else
+ Ast.CocciRulename(Some(mknm()),Ast.NoDep,[],[],Ast.Undetermined,false) in
+ Data.in_rule_name := false;
+ name_res
+
+let parse_iso file =
+ let table = Common.full_charpos_to_pos file in
+ Common.with_open_infile file (fun channel ->
+ let lexbuf = Lexing.from_channel channel in
+ let get_tokens = tokens_all table file false lexbuf in
+ let res =
+ match get_tokens [PC.TArobArob;PC.TArob] with
+ (true,start) ->
+ let parse_start start =
+ let rev = List.rev start in
+ let (arob,_) = List.hd rev in
+ (arob = PC.TArob,List.rev(List.tl rev)) in
+ let (starts_with_name,start) = parse_start start in
+ let rec loop starts_with_name start =
+ (!Data.init_rule)();
+ (* get metavariable declarations - have to be read before the
+ rest *)
+ let (rule_name,_,_,_,_,_) =
+ match get_rule_name PC.iso_rule_name starts_with_name get_tokens
+ file ("iso file "^file) with
+ Ast.CocciRulename (Some n,a,b,c,d,e) -> (n,a,b,c,d,e)
+ | _ -> failwith "Script rules cannot appear in isomorphism rules"
+ in
+ Ast0.rule_name := rule_name;
+ Data.in_meta := true;
+ let iso_metavars =
+ match get_metavars PC.iso_meta_main table file lexbuf with
+ (iso_metavars,[]) -> iso_metavars
+ | _ -> failwith "unexpected inheritance in iso" in
+ Data.in_meta := false;
+ (* get the rule *)
+ let (more,tokens) =
+ get_tokens
+ [PC.TIsoStatement;PC.TIsoExpression;PC.TIsoArgExpression;
+ PC.TIsoTestExpression;
+ PC.TIsoDeclaration;PC.TIsoType;PC.TIsoTopLevel] in
+ let next_start = List.hd(List.rev tokens) in
+ let dummy_info = ("",(-1,-1),(-1,-1)) in
+ let tokens = drop_last [(PC.EOF,dummy_info)] tokens in
+ let tokens = prepare_tokens (start@tokens) in
+ (*
+ print_tokens "iso tokens" tokens;
+ *)
+ let entry = parse_one "iso main" PC.iso_main file tokens in
+ let entry = List.map (List.map Test_exps.process_anything) entry in
+ if more
+ then (* The code below allows a header like Statement list,
+ which is more than one word. We don't have that any more,
+ but the code is left here in case it is put back. *)
+ match get_tokens [PC.TArobArob;PC.TArob] with
+ (true,start) ->
+ let (starts_with_name,start) = parse_start start in
+ (iso_metavars,entry,rule_name) ::
+ (loop starts_with_name (next_start::start))
+ | _ -> failwith "isomorphism ends early"
+ else [(iso_metavars,entry,rule_name)] in
+ loop starts_with_name start
+ | (false,_) -> [] in
+ res)
+
+let parse_iso_files existing_isos iso_files extra_path =
+ let get_names = List.map (function (_,_,nm) -> nm) in
+ let old_names = get_names existing_isos in
+ Data.in_iso := true;
+ let (res,_) =
+ List.fold_left
+ (function (prev,names) ->
+ function file ->
+ Lexer_cocci.init ();
+ let file =
+ match file with
+ Common.Left(fl) -> Filename.concat extra_path fl
+ | Common.Right(fl) -> Filename.concat Config.path fl in
+ let current = parse_iso file in
+ let new_names = get_names current in
+ if List.exists (function x -> List.mem x names) new_names
+ then failwith (Printf.sprintf "repeated iso name found in %s" file);
+ (current::prev,new_names @ names))
+ ([],old_names) iso_files in
+ Data.in_iso := false;
+ existing_isos@(List.concat (List.rev res))
+
+let parse file =
+ let table = Common.full_charpos_to_pos file in
+ Common.with_open_infile file (fun channel ->
+ let lexbuf = Lexing.from_channel channel in
+ let get_tokens = tokens_all table file false lexbuf in
+ Data.in_prolog := true;
+ let initial_tokens = get_tokens [PC.TArobArob;PC.TArob] in
+ Data.in_prolog := false;
+ let res =
+ match initial_tokens with
+ (true,data) ->
+ (match List.rev data with
+ ((PC.TArobArob as x),_)::_ | ((PC.TArob as x),_)::_ ->
+ let iso_files =
+ parse_one "iso file names" PC.include_main file data in
+
+ let parse_cocci_rule ruletype old_metas
+ (rule_name, dependencies, iso, dropiso, exists, is_expression) =
+ Ast0.rule_name := rule_name;
+ Data.inheritable_positions :=
+ rule_name :: !Data.inheritable_positions;
+
+ (* get metavariable declarations *)
+ Data.in_meta := true;
+ let (metavars, inherited_metavars) =
+ get_metavars PC.meta_main table file lexbuf in
+ Data.in_meta := false;
+ Hashtbl.add Data.all_metadecls rule_name metavars;
+ Hashtbl.add Lexer_cocci.rule_names rule_name ();
+ Hashtbl.add Lexer_cocci.all_metavariables rule_name
+ (Hashtbl.fold
+ (fun key v rest -> (key,v)::rest)
+ Lexer_cocci.metavariables []);
+
+ (* get transformation rules *)
+ let (more, tokens) = get_tokens [PC.TArobArob; PC.TArob] in
+ let (minus_tokens, _) = split_token_stream tokens in
+ let (_, plus_tokens) =
+ split_token_stream (minus_to_nothing tokens) in
+
+ let minus_tokens = consume_minus_positions minus_tokens in
+ let minus_tokens = prepare_tokens minus_tokens in
+ let plus_tokens = prepare_tokens plus_tokens in
+
+ (*
+ print_tokens "minus tokens" minus_tokens;
+ print_tokens "plus tokens" plus_tokens;
+ *)
+
+ let plus_tokens =
+ process_pragmas
+ (fix (function x -> drop_double_dots (drop_empty_or x))
+ (drop_when plus_tokens)) in
+ (*
+ print_tokens "plus tokens" plus_tokens;
+ Printf.printf "before minus parse\n";
+ *)
+ let minus_res =
+ if is_expression
+ then parse_one "minus" PC.minus_exp_main file minus_tokens
+ else parse_one "minus" PC.minus_main file minus_tokens in
+ (*
+ Unparse_ast0.unparse minus_res;
+ Printf.printf "before plus parse\n";
+ *)
+ let plus_res =
+ if !Flag.sgrep_mode2
+ then (* not actually used for anything, except context_neg *)
+ List.map
+ (Iso_pattern.rebuild_mcode None).V0.rebuilder_top_level
+ minus_res
+ else
+ if is_expression
+ then parse_one "plus" PC.plus_exp_main file plus_tokens
+ else parse_one "plus" PC.plus_main file plus_tokens in
+ (*
+ Printf.printf "after plus parse\n";
+ *)
+
+ (if not !Flag.sgrep_mode2 &&
+ (any_modif minus_res or any_modif plus_res)
+ then Data.inheritable_positions := []);
+
+ Check_meta.check_meta rule_name old_metas inherited_metavars
+ metavars minus_res plus_res;
+
+ (more, Ast0.CocciRule ((minus_res, metavars,
+ (iso, dropiso, dependencies, rule_name, exists)),
+ (plus_res, metavars), ruletype), metavars, tokens) in
+
+ let parse_script_rule language old_metas deps =
+ let get_tokens = tokens_script_all table file false lexbuf in
+
+ (* meta-variables *)
+ Data.in_meta := true;
+ let metavars =
+ get_script_metavars PC.script_meta_main table file lexbuf in
+ Data.in_meta := false;
+
+ let exists_in old_metas (py,(r,m)) =
+ let test (rr,mr) x =
+ let (ro,vo) = Ast.get_meta_name x in
+ ro = rr && vo = mr in
+ List.exists (test (r,m)) old_metas in
+
+ List.iter
+ (function x ->
+ let meta2c (r,n) = Printf.sprintf "%s.%s" r n in
+ if not (exists_in old_metas x) then
+ failwith
+ (Printf.sprintf
+ "Script references unknown meta-variable: %s"
+ (meta2c(snd x))))
+ metavars;
+
+ (* script code *)
+ let (more, tokens) = get_tokens [PC.TArobArob; PC.TArob] in
+ let data =
+ match List.hd tokens with
+ (PC.TScriptData(s),_) -> s
+ | (PC.TArobArob,_) | (PC.TArob,_) -> ""
+ | _ -> failwith "Malformed script rule" in
+ (more,Ast0.ScriptRule(language, deps, metavars, data),[],tokens) in
+
+ let parse_rule old_metas starts_with_name =
+ let rulename =
+ get_rule_name PC.rule_name starts_with_name get_tokens file
+ "rule" in
+ match rulename with
+ Ast.CocciRulename (Some s, a, b, c, d, e) ->
+ parse_cocci_rule Ast.Normal old_metas (s, a, b, c, d, e)
+ | Ast.GeneratedRulename (Some s, a, b, c, d, e) ->
+ Data.in_generating := true;
+ let res =
+ parse_cocci_rule Ast.Generated old_metas (s,a,b,c,d,e) in
+ Data.in_generating := false;
+ res
+ | Ast.ScriptRulename (l,deps) -> parse_script_rule l old_metas deps
+ | _ -> failwith "Malformed rule name"
+ in
+
+ let rec loop old_metas starts_with_name =
+ (!Data.init_rule)();
+
+ let gen_starts_with_name more tokens =
+ more &&
+ (match List.hd (List.rev tokens) with
+ (PC.TArobArob,_) -> false
+ | (PC.TArob,_) -> true
+ | _ -> failwith "unexpected token")
+ in
+
+ let (more, rule, metavars, tokens) =
+ parse_rule old_metas starts_with_name in
+ if more then
+ rule::
+ (loop (metavars @ old_metas) (gen_starts_with_name more tokens))
+ else [rule];
+
+ in
+
+ (iso_files, loop [] (x = PC.TArob))
+ | _ -> failwith "unexpected code before the first rule\n")
+ | (false,[(PC.TArobArob,_)]) | (false,[(PC.TArob,_)]) ->
+ ([],([] : Ast0.parsed_rule list))
+ | _ -> failwith "unexpected code before the first rule\n" in
+ res)
+
+(* parse to ast0 and then convert to ast *)
+let process file isofile verbose =
+ let extra_path = Filename.dirname file in
+ Lexer_cocci.init();
+ let (iso_files, rules) = parse file in
+ let std_isos =
+ match isofile with
+ None -> []
+ | Some iso_file -> parse_iso_files [] [Common.Left iso_file] "" in
+ let global_isos = parse_iso_files std_isos iso_files extra_path in
+ let rules = Unitary_ast0.do_unitary rules in
+ let parsed =
+ List.map
+ (function
+ Ast0.ScriptRule (a,b,c,d) -> [([],Ast.ScriptRule (a,b,c,d))]
+ | Ast0.CocciRule
+ ((minus, metavarsm,
+ (iso, dropiso, dependencies, rule_name, exists)),
+ (plus, metavars),ruletype) ->
+ let chosen_isos =
+ parse_iso_files global_isos
+ (List.map (function x -> Common.Left x) iso)
+ extra_path in
+ let chosen_isos =
+ (* check that dropped isos are actually available *)
+ (try
+ let iso_names =
+ List.map (function (_,_,nm) -> nm) chosen_isos in
+ let local_iso_names = reserved_names @ iso_names in
+ let bad_dropped =
+ List.find
+ (function dropped ->
+ not (List.mem dropped local_iso_names))
+ dropiso in
+ failwith
+ ("invalid iso name " ^ bad_dropped ^ " in " ^ rule_name)
+ with Not_found -> ());
+ if List.mem "all" dropiso
+ then
+ if List.length dropiso = 1
+ then []
+ else failwith "disable all should only be by itself"
+ else (* drop those isos *)
+ List.filter
+ (function (_,_,nm) -> not (List.mem nm dropiso))
+ chosen_isos in
+ List.iter Iso_compile.process chosen_isos;
+ let dropped_isos =
+ match reserved_names with
+ "all"::others ->
+ (match dropiso with
+ ["all"] -> others
+ | _ ->
+ List.filter (function x -> List.mem x dropiso) others)
+ | _ ->
+ failwith
+ "bad list of reserved names - all must be at start" in
+ let minus = Test_exps.process minus in
+ let minus = Compute_lines.compute_lines minus in
+ let plus = Compute_lines.compute_lines plus in
+ let is_exp =
+ (* only relevant to Flag.make_hrule *)
+ (* doesn't handle multiple minirules properly, but since
+ we don't really handle them in lots of other ways, it
+ doesn't seem very important *)
+ match plus with
+ [] -> [false]
+ | p::_ ->
+ [match Ast0.unwrap p with
+ Ast0.CODE c ->
+ (match List.map Ast0.unwrap (Ast0.undots c) with
+ [Ast0.Exp e] -> true | _ -> false)
+ | _ -> false] in
+ let minus = Arity.minus_arity minus in
+ let ((metavars,minus),function_prototypes) =
+ Function_prototypes.process
+ rule_name metavars dropped_isos minus plus ruletype in
+ (* warning! context_neg side-effects its arguments *)
+ let (m,p) = List.split (Context_neg.context_neg minus plus) in
+ Type_infer.type_infer p;
+ (if not !Flag.sgrep_mode2
+ then Insert_plus.insert_plus m p (chosen_isos = []));
+ Type_infer.type_infer minus;
+ let (extra_meta, minus) =
+ match (chosen_isos,ruletype) with
+ (* separate case for [] because applying isos puts
+ some restrictions on the -+ code *)
+ ([],_) | (_,Ast.Generated) -> ([],minus)
+ | _ -> Iso_pattern.apply_isos chosen_isos minus rule_name in
+ let minus = Comm_assoc.comm_assoc minus rule_name dropiso in
+ let minus =
+ if !Flag.sgrep_mode2 then minus
+ else Single_statement.single_statement minus in
+ let minus = Simple_assignments.simple_assignments minus in
+ let minus_ast =
+ Ast0toast.ast0toast rule_name dependencies dropped_isos
+ exists minus is_exp ruletype in
+ match function_prototypes with
+ None -> [(extra_meta @ metavars, minus_ast)]
+ | Some mv_fp ->
+ [(extra_meta @ metavars, minus_ast); mv_fp])
+(* Ast0.CocciRule ((minus, metavarsm, (iso, dropiso, dependencies, rule_name, exists)), (plus, metavars))*)
+ rules in
+ let parsed = List.concat parsed in
+ let disjd = Disjdistr.disj parsed in
+
+ let (metavars,code,fvs,neg_pos,ua,pos) = Free_vars.free_vars disjd in
+ if !Flag_parsing_cocci.show_SP
+ then List.iter Pretty_print_cocci.unparse code;
+
+ let grep_tokens =
+ Common.profile_code "get_constants"
+ (fun () -> Get_constants.get_constants code) in (* for grep *)
+ let glimpse_tokens2 =
+ Common.profile_code "get_glimpse_constants"
+ (fun () -> Get_constants2.get_constants code neg_pos) in(* for glimpse *)
+ (metavars,code,fvs,neg_pos,ua,pos,grep_tokens,glimpse_tokens2)
HCoop / bpt / coccinelle.git / blobdiff