X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/faf9a90c4f9e1e85931cb6b01de660587416eb97..9f8e26f459677a621822918b7539ae94214621ac:/parsing_cocci/ast_cocci.ml
diff --git a/parsing_cocci/ast_cocci.ml b/parsing_cocci/ast_cocci.ml
index 4521d24..6f862b2 100644
--- a/parsing_cocci/ast_cocci.ml
+++ b/parsing_cocci/ast_cocci.ml
@@ -1,30 +1,38 @@
(*
-* 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 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.
+ *)
+
+
+(* Constraints on Meta-* Identifiers, Functions *)
+type idconstraint =
+ IdNoConstraint
+ | IdNegIdSet of string list
+ | IdRegExp of string * Str.regexp
+ | IdNotRegExp of string * Str.regexp
(* --------------------------------------------------------------------- *)
(* 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 +42,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 +53,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 +91,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,8 +101,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 *) * 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*)
@@ -104,6 +125,9 @@ and metavar =
| MetaDeclarerDecl of arity * meta_name (* name *)
| MetaIteratorDecl of arity * meta_name (* name *)
+and seed = NoVal | StringSeed of string | ListSeed of seed_elem list
+and seed_elem = SeedString of string | SeedId of meta_name
+
(* --------------------------------------------------------------------- *)
(* --------------------------------------------------------------------- *)
(* Dots *)
@@ -119,11 +143,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,9 +185,9 @@ 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 *
inherited (* only in arg lists *)
@@ -184,6 +207,11 @@ and base_expression =
| OptExp of expression
| UniqueExp of expression
+and constraints =
+ NoConstraint
+ | NotIdCstrt of idconstraint
+ | NotExpCstrt of expression list
+
(* ANY = int E; ID = idexpression int X; CONST = constant int X; *)
and form = ANY | ID | LocalID | CONST (* form for MetaExp *)
@@ -235,7 +263,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
@@ -280,25 +308,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
(* --------------------------------------------------------------------- *)
@@ -429,7 +459,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 +469,14 @@ 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 *
(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 *
@@ -513,6 +543,8 @@ and rulename =
| 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
@@ -521,6 +553,8 @@ and rule =
(dependency * string list (* dropped isos *) * exists) * top_level 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 *)
@@ -529,7 +563,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 +590,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
@@ -568,7 +603,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 +612,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 +626,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 +661,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
@@ -638,7 +683,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;