(*
-* 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.
*
(* 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
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;
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 =
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 *)
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*)
(* --------------------------------------------------------------------- *)
(* Expression *)
-and base_expression =
+and base_expression =
Ident of ident
| Constant of constant mcode
| FunCall of expression * string mcode (* ( *) *
| 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(* ) *)*
| 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
| 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 *)
(* 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
(* --------------------------------------------------------------------- *)
| 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*)
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 *
(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 *
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
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 *)
| 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
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
(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
(* --------------------------------------------------------------------- *)
-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;