X-Git-Url: http://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/faf9a90c4f9e1e85931cb6b01de660587416eb97..413ffc021412f98847aeb825928e9e0e79dd2648:/parsing_cocci/ast_cocci.ml diff --git a/parsing_cocci/ast_cocci.ml b/parsing_cocci/ast_cocci.ml index 4521d24..8e7b4a2 100644 --- a/parsing_cocci/ast_cocci.ml +++ b/parsing_cocci/ast_cocci.ml @@ -1,30 +1,35 @@ (* -* 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 . -* -* The authors reserve the right to distribute this or future versions of -* Coccinelle under other licenses. -*) + * Copyright 2010, INRIA, University of Copenhagen + * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix + * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen + * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix + * 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 . + * + * The authors reserve the right to distribute this or future versions of + * Coccinelle under other licenses. + *) (* --------------------------------------------------------------------- *) (* Modified code *) +type added_string = Noindent of string | Indent of string + type info = { line : int; column : int; - strbef : string list; straft : string list } + strbef : (added_string * int (* line *) * int (* col *)) list; + straft : (added_string * int (* line *) * int (* col *)) list } type line = int type meta_name = string * string (* need to be careful about rewrapping, to avoid duplicating pos info @@ -34,7 +39,7 @@ type 'a wrap = node_line : line; free_vars : meta_name list; (*free vars*) minus_free_vars : meta_name list; (*minus free vars*) - fresh_vars : meta_name list; (*fresh vars*) + fresh_vars : (meta_name * seed) list; (*fresh vars*) inherited : meta_name list; (*inherited vars*) saved_witness : meta_name list; (*witness vars*) bef_aft : dots_bef_aft; @@ -45,21 +50,33 @@ type 'a wrap = iso_info : (string*anything) list } and 'a befaft = - BEFORE of 'a list list - | AFTER of 'a list list - | BEFOREAFTER of 'a list list * 'a list list + BEFORE of 'a list list * count + | AFTER of 'a list list * count + | BEFOREAFTER of 'a list list * 'a list list * count | NOTHING and 'a mcode = 'a * info * mcodekind * meta_pos (* pos variable *) - (* pos is an offset indicating where in the C code the mcodekind has an - effect *) - and mcodekind = - MINUS of pos * anything list list + (* pos is an offset indicating where in the C code the mcodekind + has an effect *) + (* int list is the match instances, which are only meaningful in annotated + C code *) + (* int is the adjacency index, which is incremented on context dots *) +(* iteration is only allowed on contect code, the intuition vaguely being +that there is no way to replace something more than once. Actually, +allowing iterated additions on minus code would cause problems with some +heuristics for adding braces, because one couldn't identify simple +replacements with certainty. Anyway, iteration doesn't seem to be needed +on - code for the moment. Although it may be confusing that there can be +iterated addition of code before context code where the context code is +immediately followed by removed code. *) +and mcodekind = + MINUS of pos * int list * int * anything list list | CONTEXT of pos * anything befaft - | PLUS - and fixpos = + | PLUS of count +and count = ONE (* + *) | MANY (* ++ *) +and fixpos = Real of int (* charpos *) | Virt of int * int (* charpos + offset *) - and pos = NoPos | DontCarePos | FixPos of (fixpos * fixpos) +and pos = NoPos | DontCarePos | FixPos of (fixpos * fixpos) and dots_bef_aft = NoDots @@ -71,8 +88,8 @@ and keep_binding = Type_cocci.keep_binding and multi = bool (*true if a nest is one or more, false if it is zero or more*) and end_info = - meta_name list (*free vars*) * meta_name list (*inherited vars*) * - meta_name list (*witness vars*) * mcodekind + meta_name list (*free vars*) * (meta_name * seed) list (*fresh*) * + meta_name list (*inherited vars*) * mcodekind (* --------------------------------------------------------------------- *) (* Metavariables *) @@ -81,11 +98,12 @@ and arity = UNIQUE | OPT | MULTI | NONE and metavar = MetaIdDecl of arity * meta_name (* name *) - | MetaFreshIdDecl of arity * meta_name (* name *) + | MetaFreshIdDecl of meta_name (* name *) * seed (* seed *) | MetaTypeDecl of arity * meta_name (* name *) + | MetaInitDecl of arity * meta_name (* name *) | MetaListlenDecl of meta_name (* name *) | MetaParamDecl of arity * meta_name (* name *) - | MetaParamListDecl of arity * meta_name (*name*) * meta_name option (*len*) + | MetaParamListDecl of arity * meta_name (*name*) * list_len (*len*) | MetaConstDecl of arity * meta_name (* name *) * Type_cocci.typeC list option | MetaErrDecl of arity * meta_name (* name *) @@ -95,7 +113,9 @@ and metavar = arity * meta_name (* name *) * Type_cocci.typeC list option | MetaLocalIdExpDecl of arity * meta_name (* name *) * Type_cocci.typeC list option - | MetaExpListDecl of arity * meta_name (*name*) * meta_name option (*len*) + | MetaExpListDecl of arity * meta_name (*name*) * list_len (*len*) + | MetaDeclDecl of arity * meta_name (* name *) + | MetaFieldDecl of arity * meta_name (* name *) | MetaStmDecl of arity * meta_name (* name *) | MetaStmListDecl of arity * meta_name (* name *) | MetaFuncDecl of arity * meta_name (* name *) @@ -104,6 +124,11 @@ and metavar = | MetaDeclarerDecl of arity * meta_name (* name *) | MetaIteratorDecl of arity * meta_name (* name *) +and list_len = AnyLen | MetaLen of meta_name | CstLen of int + +and seed = NoVal | StringSeed of string | ListSeed of seed_elem list +and seed_elem = SeedString of string | SeedId of meta_name + (* --------------------------------------------------------------------- *) (* --------------------------------------------------------------------- *) (* Dots *) @@ -119,11 +144,10 @@ and 'a dots = 'a base_dots wrap (* Identifier *) and base_ident = - Id of string mcode - - | MetaId of meta_name mcode * ident list * keep_binding * inherited - | MetaFunc of meta_name mcode * ident list * keep_binding * inherited - | MetaLocalFunc of meta_name mcode * ident list * keep_binding * inherited + Id of string mcode + | MetaId of meta_name mcode * idconstraint * keep_binding * inherited + | MetaFunc of meta_name mcode * idconstraint * keep_binding * inherited + | MetaLocalFunc of meta_name mcode * idconstraint * keep_binding * inherited | OptIdent of ident | UniqueIdent of ident @@ -162,17 +186,20 @@ and base_expression = | Paren of string mcode (* ( *) * expression * string mcode (* ) *) - | MetaErr of meta_name mcode * expression list * keep_binding * + | MetaErr of meta_name mcode * constraints * keep_binding * inherited - | MetaExpr of meta_name mcode * expression list * keep_binding * + | MetaExpr of meta_name mcode * constraints * keep_binding * Type_cocci.typeC list option * form * inherited - | MetaExprList of meta_name mcode * listlen option * keep_binding * + | MetaExprList of meta_name mcode * listlen * keep_binding * inherited (* only in arg lists *) | EComma of string mcode (* only in arg lists *) | DisjExpr of expression list - | NestExpr of expression dots * expression option * multi + | NestExpr of string mcode (* <.../<+... *) * + expression dots * + string mcode (* ...>/...+> *) * + expression option * multi (* can appear in arg lists, and also inside Nest, as in: if(< ... X ... Y ...>) @@ -184,12 +211,31 @@ and base_expression = | OptExp of expression | UniqueExp of expression +and constraints = + NoConstraint + | NotIdCstrt of reconstraint + | NotExpCstrt of expression list + | SubExpCstrt of meta_name list + +(* Constraints on Meta-* Identifiers, Functions *) +and idconstraint = + IdNoConstraint + | IdNegIdSet of string list * meta_name list + | IdRegExpConstraint of reconstraint + +and reconstraint = + | IdRegExp of string * Str.regexp + | IdNotRegExp of string * Str.regexp + (* ANY = int E; ID = idexpression int X; CONST = constant int X; *) and form = ANY | ID | LocalID | CONST (* form for MetaExp *) and expression = base_expression wrap -and listlen = meta_name mcode * keep_binding * inherited +and listlen = + MetaListLen of meta_name mcode * keep_binding * inherited + | CstListLen of int + | AnyListLen and unaryOp = GetRef | DeRef | UnPlus | UnMinus | Tilde | Not and assignOp = SimpleAssign | OpAssign of arithOp @@ -235,7 +281,7 @@ and base_typeC = | StructUnionName of structUnion mcode * ident option (* name *) | StructUnionDef of fullType (* either StructUnionName or metavar *) * string mcode (* { *) * declaration dots * string mcode (* } *) - | TypeName of string mcode + | TypeName of string mcode (* pad: should be 'of ident' ? *) | MetaType of meta_name mcode * keep_binding * inherited @@ -270,6 +316,7 @@ and base_declaration = | Ddots of string mcode (* ... *) * declaration option (* whencode *) | MetaDecl of meta_name mcode * keep_binding * inherited + | MetaField of meta_name mcode * keep_binding * inherited | OptDecl of declaration | UniqueDecl of declaration @@ -280,25 +327,28 @@ and declaration = base_declaration wrap (* Initializers *) and base_initialiser = - InitExpr of expression - | InitList of string mcode (*{*) * initialiser list * string mcode (*}*) * + MetaInit of meta_name mcode * keep_binding * inherited + | InitExpr of expression + | InitList of bool (* true if all are - *) * + string mcode (*{*) * initialiser list * string mcode (*}*) * initialiser list (* whencode: elements that shouldn't appear in init *) - | InitGccDotName of - string mcode (*.*) * ident (* name *) * string mcode (*=*) * + | InitGccExt of + designator list (* name *) * string mcode (*=*) * initialiser (* gccext: *) | InitGccName of ident (* name *) * string mcode (*:*) * initialiser - | InitGccIndex of - string mcode (*[*) * expression * string mcode (*]*) * - string mcode (*=*) * initialiser - | InitGccRange of - string mcode (*[*) * expression * string mcode (*...*) * - expression * string mcode (*]*) * string mcode (*=*) * initialiser | IComma of string mcode (* , *) | OptIni of initialiser | UniqueIni of initialiser +and designator = + DesignatorField of string mcode (* . *) * ident + | DesignatorIndex of string mcode (* [ *) * expression * string mcode (* ] *) + | DesignatorRange of + string mcode (* [ *) * expression * string mcode (* ... *) * + expression * string mcode (* ] *) + and initialiser = base_initialiser wrap (* --------------------------------------------------------------------- *) @@ -309,8 +359,7 @@ and base_parameterTypeDef = | Param of fullType * ident option | MetaParam of meta_name mcode * keep_binding * inherited - | MetaParamList of meta_name mcode * listlen option * keep_binding * - inherited + | MetaParamList of meta_name mcode * listlen * keep_binding * inherited | PComma of string mcode @@ -429,7 +478,7 @@ and metaStmtInfo = and rule_elem = base_rule_elem wrap and base_statement = - Seq of rule_elem (* { *) * statement dots * + Seq of rule_elem (* { *) * statement dots * rule_elem (* } *) | IfThen of rule_elem (* header *) * statement * end_info (* endif *) | IfThenElse of rule_elem (* header *) * statement * @@ -439,14 +488,15 @@ and base_statement = | For of rule_elem (* header *) * statement * end_info (*endfor*) | Iterator of rule_elem (* header *) * statement * end_info (*enditer*) | Switch of rule_elem (* header *) * rule_elem (* { *) * - case_line list * rule_elem (* } *) + statement (*decl*) dots * case_line list * rule_elem(*}*) | Atomic of rule_elem | Disj of statement dots list - | Nest of statement dots * + | Nest of string mcode (* <.../<+... *) * statement dots * + string mcode (* ...>/...+> *) * (statement dots,statement) whencode list * multi * dots_whencode list * dots_whencode list | FunDecl of rule_elem (* header *) * rule_elem (* { *) * - statement dots * statement dots * rule_elem (* } *) + statement dots * rule_elem (* } *) | Define of rule_elem (* header *) * statement dots | Dots of string mcode (* ... *) * (statement dots,statement) whencode list * @@ -512,7 +562,12 @@ and rulename = string list * string list * exists * bool | GeneratedRulename of string option * dependency * string list * string list * exists * bool - | ScriptRulename of string * dependency + | ScriptRulename of string option (* name *) * string (* language *) * + dependency + | InitialScriptRulename of string option (* name *) * string (* language *) * + dependency + | FinalScriptRulename of string option (* name *) * string (* language *) * + dependency and ruletype = Normal | Generated @@ -520,7 +575,17 @@ and rule = CocciRule of string (* name *) * (dependency * string list (* dropped isos *) * exists) * top_level list * bool list * ruletype - | ScriptRule of string * dependency * (string * meta_name) list * string + | ScriptRule of string (* name *) * + (* metaname for python (untyped), metavar for ocaml (typed) *) + string * dependency * + (script_meta_name * meta_name * metavar) list (*inherited vars*) * + meta_name list (*script vars*) * string + | InitialScriptRule of string (* name *) * + string (*language*) * dependency * string (*code*) + | FinalScriptRule of string (* name *) * + string (*language*) * dependency * string (*code*) + +and script_meta_name = string option (*string*) * string option (*ast*) and dependency = Dep of string (* rule applies for the current binding *) @@ -529,7 +594,7 @@ and dependency = | NeverDep of string (* rule never applies for any binding *) | AndDep of dependency * dependency | OrDep of dependency * dependency - | NoDep + | NoDep | FailDep and rule_with_metavars = metavar list * rule @@ -556,6 +621,7 @@ and anything = | CaseLineTag of case_line | ConstVolTag of const_vol | Token of string * info option + | Pragma of added_string list | Code of top_level | ExprDotsTag of expression dots | ParamDotsTag of parameterTypeDef dots @@ -568,7 +634,8 @@ and anything = (* --------------------------------------------------------------------- *) -and exists = Exists | Forall | ReverseForall | Undetermined +and exists = Exists | Forall | Undetermined +(* | ReverseForall - idea: look back on all flow paths; not implemented *) (* --------------------------------------------------------------------- *) @@ -576,6 +643,13 @@ let mkToken x = Token (x,None) (* --------------------------------------------------------------------- *) +let lub_count i1 i2 = + match (i1,i2) with + (MANY,MANY) -> MANY + | _ -> ONE + +(* --------------------------------------------------------------------- *) + let rewrap model x = {model with node = x} let rewrap_mcode (_,a,b,c) x = (x,a,b,c) let unwrap x = x.node @@ -583,6 +657,7 @@ let unwrap_mcode (x,_,_,_) = x let get_mcodekind (_,_,x,_) = x let get_line x = x.node_line let get_mcode_line (_,l,_,_) = l.line +let get_mcode_col (_,l,_,_) = l.column let get_fvs x = x.free_vars let set_fvs fvs x = {x with free_vars = fvs} let get_mfvs x = x.minus_free_vars @@ -617,8 +692,9 @@ let get_wcfvs (whencode : ('a wrap, 'b wrap) whencode list) = let get_meta_name = function MetaIdDecl(ar,nm) -> nm - | MetaFreshIdDecl(ar,nm) -> nm + | MetaFreshIdDecl(nm,seed) -> nm | MetaTypeDecl(ar,nm) -> nm + | MetaInitDecl(ar,nm) -> nm | MetaListlenDecl(nm) -> nm | MetaParamDecl(ar,nm) -> nm | MetaParamListDecl(ar,nm,nm1) -> nm @@ -628,6 +704,8 @@ let get_meta_name = function | MetaIdExpDecl(ar,nm,ty) -> nm | MetaLocalIdExpDecl(ar,nm,ty) -> nm | MetaExpListDecl(ar,nm,nm1) -> nm + | MetaDeclDecl(ar,nm) -> nm + | MetaFieldDecl(ar,nm) -> nm | MetaStmDecl(ar,nm) -> nm | MetaStmListDecl(ar,nm) -> nm | MetaFuncDecl(ar,nm) -> nm @@ -638,7 +716,43 @@ let get_meta_name = function (* --------------------------------------------------------------------- *) -let no_info = { line = 0; column = 0; strbef = []; straft = [] } +and tag2c = function + FullTypeTag _ -> "FullTypeTag" + | BaseTypeTag _ -> "BaseTypeTag" + | StructUnionTag _ -> "StructUnionTag" + | SignTag _ -> "SignTag" + | IdentTag _ -> "IdentTag" + | ExpressionTag _ -> "ExpressionTag" + | ConstantTag _ -> "ConstantTag" + | UnaryOpTag _ -> "UnaryOpTag" + | AssignOpTag _ -> "AssignOpTag" + | FixOpTag _ -> "FixOpTag" + | BinaryOpTag _ -> "BinaryOpTag" + | ArithOpTag _ -> "ArithOpTag" + | LogicalOpTag _ -> "LogicalOpTag" + | DeclarationTag _ -> "DeclarationTag" + | InitTag _ -> "InitTag" + | StorageTag _ -> "StorageTag" + | IncFileTag _ -> "IncFileTag" + | Rule_elemTag _ -> "Rule_elemTag" + | StatementTag _ -> "StatementTag" + | CaseLineTag _ -> "CaseLineTag" + | ConstVolTag _ -> "ConstVolTag" + | Token _ -> "Token" + | Pragma _ -> "Pragma" + | Code _ -> "Code" + | ExprDotsTag _ -> "ExprDotsTag" + | ParamDotsTag _ -> "ParamDotsTag" + | StmtDotsTag _ -> "StmtDotsTag" + | DeclDotsTag _ -> "DeclDotsTag" + | TypeCTag _ -> "TypeCTag" + | ParamTag _ -> "ParamTag" + | SgrepStartTag _ -> "SgrepStartTag" + | SgrepEndTag _ -> "SgrepEndTag" + +(* --------------------------------------------------------------------- *) + +let no_info = { line = 0; column = -1; strbef = []; straft = [] } let make_term x = {node = x; @@ -654,13 +768,15 @@ let make_term x = iso_info = [] } let make_meta_rule_elem s d (fvs,fresh,inh) = + let rule = "" in {(make_term - (MetaRuleElem((("",s),no_info,d,NoMetaPos),Type_cocci.Unitary,false))) + (MetaRuleElem(((rule,s),no_info,d,NoMetaPos),Type_cocci.Unitary,false))) with free_vars = fvs; fresh_vars = fresh; inherited = inh} let make_meta_decl s d (fvs,fresh,inh) = + let rule = "" in {(make_term - (MetaDecl((("",s),no_info,d,NoMetaPos),Type_cocci.Unitary,false))) with + (MetaDecl(((rule,s),no_info,d,NoMetaPos),Type_cocci.Unitary,false))) with free_vars = fvs; fresh_vars = fresh; inherited = inh} let make_mcode x = (x,no_info,CONTEXT(NoPos,NOTHING),NoMetaPos)