X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/34e491640531bd81a0e2238fd599e1aafe53613e..708f4980a90e2a254d7863f875888e9f5c6db0b3:/parsing_cocci/ast_cocci.ml diff --git a/parsing_cocci/ast_cocci.ml b/parsing_cocci/ast_cocci.ml index a98a8dc..0d9bd39 100644 --- a/parsing_cocci/ast_cocci.ml +++ b/parsing_cocci/ast_cocci.ml @@ -1,5 +1,5 @@ (* -* Copyright 2005-2008, Ecole des Mines de Nantes, University of Copenhagen +* 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. * @@ -24,7 +24,8 @@ (* Modified code *) type info = { line : int; column : int; - strbef : string list; straft : string list } + strbef : (string * int (* line *) * int (* col *)) list; + straft : (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 +35,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 * string (*seed*) option) list; (*fresh vars*) inherited : meta_name list; (*inherited vars*) saved_witness : meta_name list; (*witness vars*) bef_aft : dots_bef_aft; @@ -53,8 +54,11 @@ and 'a befaft = 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 *) +(* 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 *) and mcodekind = - MINUS of pos * anything list list + MINUS of pos * int list * int * anything list list | CONTEXT of pos * anything befaft | PLUS and fixpos = @@ -71,8 +75,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 * string option) list (*fresh*) * + meta_name list (*inherited vars*) * mcodekind (* --------------------------------------------------------------------- *) (* Metavariables *) @@ -81,8 +85,9 @@ 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 *) * string option (* 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*) @@ -133,7 +138,7 @@ and ident = base_ident wrap (* --------------------------------------------------------------------- *) (* Expression *) -and base_expression = +and base_expression = Ident of ident | Constant of constant mcode | FunCall of expression * string mcode (* ( *) * @@ -215,9 +220,9 @@ and base_fullType = | OptType of fullType | UniqueType of fullType -and base_typeC = - BaseType of baseType mcode * sign mcode option - | ImplicitInt of sign mcode +and base_typeC = + BaseType of baseType * string mcode list (* Yoann style *) + | SignedT of sign mcode * typeC option | Pointer of fullType * string mcode (* * *) | FunctionPointer of fullType * string mcode(* ( *)*string mcode(* * *)*string mcode(* ) *)* @@ -231,18 +236,19 @@ and base_typeC = | Array of fullType * string mcode (* [ *) * expression option * string mcode (* ] *) + | EnumName of string mcode (*enum*) * ident (* name *) | 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 and fullType = base_fullType wrap and typeC = base_typeC wrap - + and baseType = VoidType | CharType | ShortType | IntType | DoubleType -| FloatType | LongType + | FloatType | LongType | LongLongType and structUnion = Struct | Union @@ -262,7 +268,7 @@ and base_declaration = | TyDecl of fullType * string mcode (* ; *) | MacroDecl of ident (* name *) * string mcode (* ( *) * expression dots * string mcode (* ) *) * string mcode (* ; *) - | Typedef of string mcode (*typedef*) * fullType * + | Typedef of string mcode (*typedef*) * fullType * typeC (* either TypeName or metavar *) * string mcode (*;*) | DisjDecl of declaration list (* Ddots is for a structure declaration *) @@ -279,25 +285,27 @@ and declaration = base_declaration wrap (* Initializers *) and base_initialiser = - InitExpr of expression + MetaInit of meta_name mcode * keep_binding * inherited + | InitExpr of expression | InitList of 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 (* --------------------------------------------------------------------- *) @@ -408,6 +416,7 @@ and base_rule_elem = | TopExp of expression (* for macros body, exp at top level, not subexp *) | Ty of fullType (* only at SP top level, matches a subterm *) + | TopInit of initialiser (* only at top level *) | Include of string mcode (*#include*) * inc_file mcode (*file *) | DefineHeader of string mcode (* #define *) * ident (* name *) * define_parameters (*params*) @@ -427,7 +436,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 * @@ -444,7 +453,7 @@ and base_statement = (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 * @@ -462,6 +471,8 @@ and ('a,'b) whencode = WhenNot of 'a | WhenAlways of 'b | WhenModifier of when_modifier + | WhenNotTrue of rule_elem (* useful for fvs *) + | WhenNotFalse of rule_elem and when_modifier = (* The following removes the shortest path constraint. It can be used @@ -506,13 +517,21 @@ and top_level = base_top_level wrap and rulename = CocciRulename of string option * dependency * string list * string list * exists * bool + | GeneratedRulename of string option * dependency * + string list * string list * exists * bool | ScriptRulename of string * dependency + | InitialScriptRulename of string + | FinalScriptRulename of string + +and ruletype = Normal | Generated and rule = - CocciRule of string (* name *) * + CocciRule of string (* name *) * (dependency * string list (* dropped isos *) * exists) * top_level list - * bool list + * bool list * ruletype | ScriptRule of string * dependency * (string * meta_name) list * string + | InitialScriptRule of string (*language*) * string (*code*) + | FinalScriptRule of string (*language*) * string (*code*) and dependency = Dep of string (* rule applies for the current binding *) @@ -548,6 +567,7 @@ and anything = | CaseLineTag of case_line | ConstVolTag of const_vol | Token of string * info option + | Pragma of string list | Code of top_level | ExprDotsTag of expression dots | ParamDotsTag of parameterTypeDef dots @@ -575,6 +595,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 @@ -600,15 +621,18 @@ let get_wcfvs (whencode : ('a wrap, 'b wrap) whencode list) = (function WhenNot(a) -> get_fvs a | WhenAlways(a) -> get_fvs a - | WhenModifier(_) -> []) + | WhenModifier(_) -> [] + | WhenNotTrue(e) -> get_fvs e + | WhenNotFalse(e) -> get_fvs e) whencode) (* --------------------------------------------------------------------- *) 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,7 +652,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;