+(*
+ * Copyright 2012, INRIA
+ * Julia Lawall, Gilles Muller
+ * Copyright 2010-2011, 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.
+ *)
+
+
+# 0 "./ast0_cocci.ml"
module Ast = Ast_cocci
module TC = Type_cocci
(* MIXED is like CONTEXT, since sometimes MIXED things have to revert to
CONTEXT - see insert_plus.ml *)
-type count = ONE (* + *) | MANY (* ++ *)
type mcodekind =
- MINUS of (Ast.anything list list * token_info) ref
+ MINUS of (Ast.anything Ast.replacement * token_info) ref
| PLUS of Ast.count
| CONTEXT of (Ast.anything Ast.befaft * token_info * token_info) ref
| MIXED of (Ast.anything Ast.befaft * token_info * token_info) ref
mcode_start : mcodekind list; mcode_end : mcodekind list;
(* the following are only for + code *)
strings_before : (Ast.added_string * position_info) list;
- strings_after : (Ast.added_string * position_info) list }
+ strings_after : (Ast.added_string * position_info) list;
+ isSymbolIdent : bool; (* is the token a symbol identifier or not *) }
(* adjacency index is incremented when we skip over dots or nest delimiters
it is used in deciding how much to remove, when two adjacent code tokens are
removed. *)
+type adjacency = int
+
+type fake_mcode = info * mcodekind * adjacency
+
type 'a mcode =
- 'a * arity * info * mcodekind * meta_pos ref (* pos, - only *) *
- int (* adjacency_index *)
+ 'a * arity * info * mcodekind * anything list ref (* pos, - only *) *
+ adjacency (* adjacency_index *)
(* int ref is an index *)
and 'a wrap =
{ node : 'a;
and base_ident =
Id of string mcode
- | MetaId of Ast.meta_name mcode * Ast.idconstraint * pure
+ | MetaId of Ast.meta_name mcode * Ast.idconstraint * Ast.seed * pure
| MetaFunc of Ast.meta_name mcode * Ast.idconstraint * pure
| MetaLocalFunc of Ast.meta_name mcode * Ast.idconstraint * pure
+ | AsIdent of ident * ident (* as ident, always metavar *)
| DisjId of string mcode * ident list *
string mcode list (* the |s *) * string mcode
| OptIdent of ident
expression dots * string mcode (* ) *)
| Assignment of expression * Ast.assignOp mcode * expression *
bool (* true if it can match an initialization *)
+ | Sequence of expression * string mcode (* , *) * expression
| CondExpr of expression * string mcode (* ? *) * expression option *
string mcode (* : *) * expression
| Postfix of expression * Ast.fixOp mcode
| SizeOfType of string mcode (* sizeof *) * string mcode (* ( *) *
typeC * string mcode (* ) *)
| TypeExp of typeC (* type name used as an expression, only in args *)
+ | Constructor of string mcode (* ( *) * typeC * string mcode (* ) *) *
+ initialiser
| MetaErr of Ast.meta_name mcode * constraints * pure
| MetaExpr of Ast.meta_name mcode * constraints *
TC.typeC list option * Ast.form * pure
| MetaExprList of Ast.meta_name mcode (* only in arg lists *) *
listlen * pure
+ | AsExpr of expression * expression (* as expr, always metavar *)
| EComma of string mcode (* only in arg lists *)
| DisjExpr of string mcode * expression list *
string mcode list (* the |s *) * string mcode
string mcode (* { *) * declaration dots * string mcode (* } *)
| TypeName of string mcode
| MetaType of Ast.meta_name mcode * pure
+ | AsType of typeC * typeC (* as type, always metavar *)
| DisjType of string mcode * typeC list * (* only after iso *)
string mcode list (* the |s *) * string mcode
| OptType of typeC
should be a separate type for fields, as in the C AST *)
| MetaField of Ast.meta_name mcode * pure (* structure fields *)
| MetaFieldList of Ast.meta_name mcode * listlen * pure (* structure fields *)
+ | AsDecl of declaration * declaration
| Init of Ast.storage mcode option * typeC * ident * string mcode (*=*) *
initialiser * string mcode (*;*)
| UnInit of Ast.storage mcode option * typeC * ident * string mcode (* ; *)
| TyDecl of typeC * string mcode (* ; *)
| MacroDecl of ident (* name *) * string mcode (* ( *) *
expression dots * string mcode (* ) *) * string mcode (* ; *)
+ | MacroDeclInit of ident (* name *) * string mcode (* ( *) *
+ expression dots * string mcode (* ) *) * string mcode (*=*) *
+ initialiser * string mcode (* ; *)
| Typedef of string mcode (* typedef *) * typeC * typeC * string mcode (*;*)
| DisjDecl of string mcode * declaration list *
string mcode list (* the |s *) * string mcode
and base_initialiser =
MetaInit of Ast.meta_name mcode * pure
+ | MetaInitList of Ast.meta_name mcode * listlen * pure
+ | AsInit of initialiser * initialiser (* as init, always metavar *)
| InitExpr of expression
| InitList of string mcode (*{*) * initialiser_list * string mcode (*}*) *
(* true if ordered, as for array, false if unordered, as for struct *)
| Param of typeC * ident option
| MetaParam of Ast.meta_name mcode * pure
| MetaParamList of Ast.meta_name mcode * listlen * pure
+ | AsParam of parameterTypeDef * expression (* expr, always metavar *)
| PComma of string mcode
| Pdots of string mcode (* ... *)
| Pcircles of string mcode (* ooo *)
(* Statement*)
and base_statement =
+ (*Decl and FunDecl don't need adjacency. Delete all comments in any case*)
Decl of (info * mcodekind) (* before the decl *) * declaration
| Seq of string mcode (* { *) * statement dots *
string mcode (* } *)
- | ExprStatement of expression * string mcode (*;*)
+ | ExprStatement of expression option * string mcode (*;*)
| IfThen of string mcode (* if *) * string mcode (* ( *) *
expression * string mcode (* ) *) *
- statement * (info * mcodekind) (* after info *)
+ statement * fake_mcode (* after info *)
| IfThenElse of string mcode (* if *) * string mcode (* ( *) *
expression * string mcode (* ) *) *
statement * string mcode (* else *) * statement *
- (info * mcodekind)
+ fake_mcode (* after info *)
| While of string mcode (* while *) * string mcode (* ( *) *
expression * string mcode (* ) *) *
- statement * (info * mcodekind) (* after info *)
+ statement * fake_mcode (* after info *)
| Do of string mcode (* do *) * statement *
string mcode (* while *) * string mcode (* ( *) *
expression * string mcode (* ) *) *
string mcode (* ; *)
- | For of string mcode (* for *) * string mcode (* ( *) *
- expression option * string mcode (*;*) *
+ | For of string mcode (* for *) * string mcode (* ( *) * forinfo *
expression option * string mcode (*;*) *
expression option * string mcode (* ) *) * statement *
- (info * mcodekind) (* after info *)
+ fake_mcode (* after info *)
| Iterator of ident (* name *) * string mcode (* ( *) *
expression dots * string mcode (* ) *) *
- statement * (info * mcodekind) (* after info *)
+ statement * fake_mcode (* after info *)
| Switch of string mcode (* switch *) * string mcode (* ( *) *
expression * string mcode (* ) *) * string mcode (* { *) *
statement (*decl*) dots *
string mcode (* ; *)
| MetaStmt of Ast.meta_name mcode * pure
| MetaStmtList of Ast.meta_name mcode(*only in statement lists*) * pure
+ | AsStmt of statement * statement (* as statement, always metavar *)
| Exp of expression (* only in dotted statement lists *)
| TopExp of expression (* for macros body *)
| Ty of typeC (* only at top level *)
| OptStm of statement
| UniqueStm of statement
+and base_forinfo =
+ ForExp of expression option * string mcode (*;*)
+ | ForDecl of (info * mcodekind) (* before the decl *) * declaration
+
+and forinfo = base_forinfo wrap
+
and fninfo =
FStorage of Ast.storage mcode
| FType of typeC
and meta_pos =
MetaPos of Ast.meta_name mcode * Ast.meta_name list * Ast.meta_collect
- | NoMetaPos
(* --------------------------------------------------------------------- *)
(* Top-level code *)
and base_top_level =
- DECL of statement
+ NONDECL of statement
+ | TOPCODE of statement dots
| CODE of statement dots
| FILEINFO of string mcode (* old file *) * string mcode (* new file *)
| ERRORWORDS of expression list
(* --------------------------------------------------------------------- *)
+and dependency =
+ Dep of string (* rule applies for the current binding *)
+ | AntiDep of dependency (* rule doesn't apply for the current binding *)
+ | EverDep of string (* rule applies for some binding *)
+ | NeverDep of string (* rule never applies for any binding *)
+ | AndDep of dependency * dependency
+ | OrDep of dependency * dependency
+ | NoDep | FailDep
+
+(* --------------------------------------------------------------------- *)
+
and anything =
DotsExprTag of expression dots
| DotsInitTag of initialiser dots
| InitTag of initialiser
| DeclTag of declaration
| StmtTag of statement
+ | ForInfoTag of forinfo
| CaseLineTag of case_line
| TopTag of top_level
| IsoWhenTag of Ast.when_modifier
| IsoWhenTTag of expression
| IsoWhenFTag of expression
| MetaPosTag of meta_pos
+ | HiddenVarTag of anything list (* in iso_compile/pattern only *)
let dotsExpr x = DotsExprTag x
let dotsParam x = DotsParamTag x
let ini x = InitTag x
let decl x = DeclTag x
let stmt x = StmtTag x
+let forinfo x = ForInfoTag x
let case_line x = CaseLineTag x
let top x = TopTag x
{ pos_info = pos_info;
attachable_start = true; attachable_end = true;
mcode_start = []; mcode_end = [];
- strings_before = []; strings_after = [] }
+ strings_before = []; strings_after = []; isSymbolIdent = false; }
let default_befaft _ =
MIXED(ref (Ast.NOTHING,default_token_info,default_token_info))
let context_befaft _ =
CONTEXT(ref (Ast.NOTHING,default_token_info,default_token_info))
-let minus_befaft _ = MINUS(ref ([],default_token_info))
+ let minus_befaft _ = MINUS(ref (Ast.NOREPLACEMENT,default_token_info))
let wrap x =
{ node = x;
(* --------------------------------------------------------------------- *)
+let rec meta_pos_name = function
+ HiddenVarTag(vars) ->
+ (* totally fake, just drop the rest, only for isos *)
+ meta_pos_name (List.hd vars)
+ | MetaPosTag(MetaPos(name,constraints,_)) -> name
+ | IdentTag(i) ->
+ (match unwrap i with
+ MetaId(name,constraints,seed,pure) -> name
+ | _ -> failwith "bad metavariable")
+ | ExprTag(e) ->
+ (match unwrap e with
+ MetaExpr(name,constraints,ty,form,pure) -> name
+ | MetaExprList(name,len,pure) -> name
+ | _ -> failwith "bad metavariable")
+ | TypeCTag(t) ->
+ (match unwrap t with
+ MetaType(name,pure) -> name
+ | _ -> failwith "bad metavariable")
+ | DeclTag(d) ->
+ (match unwrap d with
+ MetaDecl(name,pure) -> name
+ | _ -> failwith "bad metavariable")
+ | InitTag(i) ->
+ (match unwrap i with
+ MetaInit(name,pure) -> name
+ | _ -> failwith "bad metavariable")
+ | StmtTag(s) ->
+ (match unwrap s with
+ MetaStmt(name,pure) -> name
+ | _ -> failwith "bad metavariable")
+ | _ -> failwith "bad metavariable"
+
+(* --------------------------------------------------------------------- *)
+
(* unique indices, for mcode and tree nodes *)
let index_counter = ref 0
let fresh_index _ = let cur = !index_counter in index_counter := cur + 1; cur
| Pointer(ty,_) -> TC.Pointer(ast0_type_to_type ty)
| FunctionPointer(ty,_,_,_,_,params,_) ->
TC.FunctionPointer(ast0_type_to_type ty)
- | FunctionType _ -> failwith "not supported"
+ | FunctionType _ -> TC.Unknown (*failwith "not supported"*)
| Array(ety,_,_,_) -> TC.Array(ast0_type_to_type ety)
| EnumName(su,Some tag) ->
(match unwrap tag with
Id(tag) ->
TC.EnumName(TC.Name(unwrap_mcode tag))
- | MetaId(tag,_,_) ->
- (Printf.printf
- "warning: enum with a metavariable name detected.\n";
- Printf.printf
+ | MetaId(tag,_,_,_) ->
+ (Common.pr2_once
+ "warning: enum with a metavariable name detected.";
+ Common.pr2_once
"For type checking assuming the name of the metavariable is the name of the type\n";
TC.EnumName(TC.MV(unwrap_mcode tag,TC.Unitary,false)))
| _ -> failwith "unexpected enum type name")
- | EnumName(su,None) -> failwith "nameless enum - what to do???"
+ | EnumName(su,None) -> TC.EnumName TC.NoName
| EnumDef(ty,_,_,_) -> ast0_type_to_type ty
| StructUnionName(su,Some tag) ->
(match unwrap tag with
Id(tag) ->
TC.StructUnionName(structUnion su,TC.Name(unwrap_mcode tag))
- | MetaId(tag,Ast.IdNoConstraint,_) ->
- (Common.pr2
- "warning: struct/union with a metavariable name detected.\n";
- Common.pr2
+ | MetaId(tag,Ast.IdNoConstraint,_,_) ->
+ (Common.pr2_once
+ "warning: struct/union with a metavariable name detected.";
+ Common.pr2_once
"For type checking assuming the name of the metavariable is the name of the type\n";
TC.StructUnionName(structUnion su,
TC.MV(unwrap_mcode tag,TC.Unitary,false)))
- | MetaId(tag,_,_) ->
+ | MetaId(tag,_,_,_) ->
(* would have to duplicate the type in type_cocci.ml?
perhaps polymorphism would help? *)
failwith "constraints not supported on struct type name"
| _ -> failwith "unexpected struct/union type name")
- | StructUnionName(su,None) -> failwith "nameless structure - what to do???"
+ | StructUnionName(su,None) -> TC.StructUnionName(structUnion su,TC.NoName)
| StructUnionDef(ty,_,_,_) -> ast0_type_to_type ty
| TypeName(name) -> TC.TypeName(unwrap_mcode name)
| MetaType(name,_) ->
TC.MetaType(unwrap_mcode name,TC.Unitary,false)
+ | AsType(ty,asty) -> failwith "not created yet"
| DisjType(_,types,_,_) ->
Common.pr2_once
"disjtype not supported in smpl type inference, assuming unknown";
Ast.VoidType -> TC.VoidType
| Ast.CharType -> TC.CharType
| Ast.ShortType -> TC.ShortType
+ | Ast.ShortIntType -> TC.ShortIntType
| Ast.IntType -> TC.IntType
| Ast.DoubleType -> TC.DoubleType
+ | Ast.LongDoubleType -> TC.LongDoubleType
| Ast.FloatType -> TC.FloatType
| Ast.LongType -> TC.LongType
+ | Ast.LongIntType -> TC.LongIntType
| Ast.LongLongType -> TC.LongLongType
+ | Ast.LongLongIntType -> TC.LongLongIntType
| Ast.SizeType -> TC.SizeType
| Ast.SSizeType -> TC.SSizeType
| Ast.PtrDiffType -> TC.PtrDiffType
(* this function is a rather minimal attempt. the problem is that information
has been lost. but since it is only used for metavariable types in the isos,
perhaps it doesn't matter *)
-and make_mcode x = (x,NONE,default_info(),context_befaft(),ref NoMetaPos,-1)
-let make_mcode_info x info = (x,NONE,info,context_befaft(),ref NoMetaPos,-1)
+and make_mcode x = (x,NONE,default_info(),context_befaft(),ref [],-1)
+let make_mcode_info x info = (x,NONE,info,context_befaft(),ref [],-1)
and make_minus_mcode x =
- (x,NONE,default_info(),minus_befaft(),ref NoMetaPos,-1)
+ (x,NONE,default_info(),minus_befaft(),ref [],-1)
exception TyConv
| TC.EnumName(TC.MV(name,_,_)) ->
EnumName
(make_mcode "enum",
- Some (context_wrap(MetaId(make_mcode name,Ast.IdNoConstraint,
+ Some (context_wrap(MetaId(make_mcode name,Ast.IdNoConstraint,Ast.NoVal,
Impure))))
| TC.EnumName(TC.Name tag) ->
EnumName(make_mcode "enum",Some(context_wrap(Id(make_mcode tag))))
(* not right?... *)
StructUnionName
(reverse_structUnion su,
- Some(context_wrap(MetaId(make_mcode name,Ast.IdNoConstraint,
+ Some(context_wrap(MetaId(make_mcode name,Ast.IdNoConstraint,Ast.NoVal,
Impure(*not really right*)))))
| TC.StructUnionName(su,TC.Name tag) ->
StructUnionName
| TC.CharType -> Ast.CharType
| TC.BoolType -> Ast.IntType
| TC.ShortType -> Ast.ShortType
+ | TC.ShortIntType -> Ast.ShortIntType
| TC.IntType -> Ast.IntType
| TC.DoubleType -> Ast.DoubleType
+ | TC.LongDoubleType -> Ast.LongDoubleType
| TC.FloatType -> Ast.FloatType
| TC.LongType -> Ast.LongType
+ | TC.LongIntType -> Ast.LongIntType
| TC.LongLongType -> Ast.LongLongType
+ | TC.LongLongIntType -> Ast.LongLongIntType
| TC.SizeType -> Ast.SizeType
| TC.SSizeType -> Ast.SSizeType
| TC.PtrDiffType -> Ast.PtrDiffType
HCoop / bpt / coccinelle.git / blobdiff