+(*
+ * 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 <http://www.gnu.org/licenses/>.
+ *
+ * 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
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;
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
+ MINUS of pos * int list * int * anything list list
| CONTEXT of pos * anything befaft
- | PLUS
+ | 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 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 *)
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 *)
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 *)
| 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 *)
(* 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
(* --------------------------------------------------------------------- *)
(* Expression *)
-and base_expression =
+and base_expression =
Ident of ident
| Constant of constant mcode
| FunCall of expression * string mcode (* ( *) *
| 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 *
+ | 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 ...>)
| 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
+
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
| 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(* ) *)*
string mcode (* ) *)
| Array of fullType * string mcode (* [ *) *
expression option * string mcode (* ] *)
+ | EnumName of string mcode (*enum*) * ident option (* name *)
+ | EnumDef of fullType (* either EnumName or metavar *) *
+ string mcode (* { *) * expression dots * string mcode (* } *)
| StructUnionName of structUnion mcode * ident option (* name *)
| StructUnionDef of fullType (* either StructUnionName or metavar *) *
string mcode (* { *) * declaration dots * string mcode (* } *)
and fullType = base_fullType wrap
and typeC = base_typeC wrap
-
+
and baseType = VoidType | CharType | ShortType | IntType | DoubleType
-| FloatType | LongType
+ | FloatType | LongType | LongLongType | SizeType | SSizeType | PtrDiffType
and structUnion = Struct | Union
| 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
(* 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
+ | ArInitList of string mcode (*{*) * initialiser dots * string mcode (*}*)
+ | StrInitList 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 (* , *)
+ | Idots of string mcode (* ... *) * initialiser option (* whencode *)
| 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
(* --------------------------------------------------------------------- *)
| 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
fninfo list * ident (* name *) *
string mcode (* ( *) * parameter_list *
string mcode (* ) *)
- | Decl of mcodekind (* before the decl *) *
+ | Decl of mcodekind (* before the decl *) *
bool (* true if all minus *) * declaration
| SeqStart of string mcode (* { *)
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
| IfThenElse of rule_elem (* header *) * statement *
| For of rule_elem (* header *) * statement * end_info
| 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 *
CocciRulename of string option * dependency * string list * string list *
exists * bool
(* true if the whole thing is an expression *)
- | ScriptRulename of string * dependency
+ | GeneratedRulename of string option * dependency *
+ string list * string list * exists * bool
+ (* true if the whole thing is an expression *)
+ | 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
and rule =
CocciRule of string (* name *) *
(dependency * string list (* dropped isos *) * exists) *
- top_level list * bool list (* true if generates an exp *)
- | ScriptRule of string * dependency * (string * meta_name) list * string
+ top_level list * bool list (* true if generates an exp *) * ruletype
+ | ScriptRule of string (* name *) *
+ string * dependency *
+ (script_meta_name * meta_name * metavar) list *
+ meta_name list (*script vars*) * string
+ | InitialScriptRule of string (* name *) *
+ string * dependency * string
+ | FinalScriptRule of string (* name *) *
+ string * dependency * string
+
+and script_meta_name = string option (*string*) * string option (*ast*)
and dependency =
Dep of string (* rule applies for the current binding *)
| 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
| 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
(* --------------------------------------------------------------------- *)
-and exists = Exists | Forall | ReverseForall | Undetermined
+and exists = Exists | Forall | Undetermined
(* --------------------------------------------------------------------- *)
val undots : 'a dots -> 'a list
+val lub_count : count -> count -> count
+
(* --------------------------------------------------------------------- *)
val rewrap : 'a wrap -> 'b -> 'b wrap
val get_mcodekind : 'a mcode -> mcodekind
val get_line : 'a wrap -> line
val get_mcode_line : 'a mcode -> line
+val get_mcode_col : 'a mcode -> int
val get_fvs : 'a wrap -> meta_name list
val get_wcfvs : ('a wrap,'b wrap) whencode list -> meta_name list
val set_fvs : meta_name list -> 'a wrap -> 'a wrap
val get_mfvs : 'a wrap -> meta_name list
val set_mfvs : meta_name list -> 'a wrap -> 'a wrap
-val get_fresh : 'a wrap -> meta_name list
+val get_fresh : 'a wrap -> (meta_name * seed) list
val get_inherited : 'a wrap -> meta_name list
val get_saved : 'a wrap -> meta_name list
val get_dots_bef_aft : statement -> dots_bef_aft
val get_meta_name : metavar -> meta_name
+val tag2c : anything -> string
+
val no_info : info
val make_meta_rule_elem :
string -> mcodekind ->
- (meta_name list * meta_name list * meta_name list) ->
+ (meta_name list * (meta_name * seed) list * meta_name list) ->
rule_elem
val make_meta_decl :
string -> mcodekind ->
- (meta_name list * meta_name list * meta_name list) ->
+ (meta_name list * (meta_name * seed) list * meta_name list) ->
declaration
val make_term : 'a -> 'a wrap