X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/5636bb2c2537506718da74f85a2b81a5ff3df16f..3a31414346dd7d7e8baa4cb8b804a2d5e1797962:/parsing_cocci/ast0_cocci.ml diff --git a/parsing_cocci/ast0_cocci.ml b/parsing_cocci/ast0_cocci.ml index 921e991..f38cb00 100644 --- a/parsing_cocci/ast0_cocci.ml +++ b/parsing_cocci/ast0_cocci.ml @@ -1,27 +1,7 @@ (* - * Copyright 2005-2010, 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. - *) - - -(* - * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen + * 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. * @@ -43,6 +23,7 @@ module Ast = Ast_cocci +module TC = Type_cocci (* --------------------------------------------------------------------- *) (* Modified code *) @@ -88,7 +69,7 @@ and 'a wrap = info : info; index : int ref; mcodekind : mcodekind ref; - exp_ty : Type_cocci.typeC option ref; (* only for expressions *) + exp_ty : TC.typeC option ref; (* only for expressions *) bef_aft : dots_bef_aft; (* only for statements *) true_if_arg : bool; (* true if "arg_exp", only for exprs *) true_if_test : bool; (* true if "test position", only for exprs *) @@ -162,7 +143,7 @@ and base_expression = | TypeExp of typeC (* type name used as an expression, only in args *) | MetaErr of Ast.meta_name mcode * constraints * pure | MetaExpr of Ast.meta_name mcode * constraints * - Type_cocci.typeC list option * Ast.form * pure + TC.typeC list option * Ast.form * pure | MetaExprList of Ast.meta_name mcode (* only in arg lists *) * listlen * pure | EComma of string mcode (* only in arg lists *) @@ -184,7 +165,10 @@ and constraints = | NotExpCstrt of expression list | SubExpCstrt of Ast.meta_name list -and listlen = Ast.meta_name mcode option +and listlen = + MetaListLen of Ast.meta_name mcode + | CstListLen of int + | AnyListLen (* --------------------------------------------------------------------- *) (* Types *) @@ -202,7 +186,9 @@ and base_typeC = string mcode (* ) *) | Array of typeC * string mcode (* [ *) * expression option * string mcode (* ] *) - | EnumName of string mcode (*enum*) * ident (* name *) + | EnumName of string mcode (*enum*) * ident option (* name *) + | EnumDef of typeC (* either StructUnionName or metavar *) * + string mcode (* { *) * expression dots * string mcode (* } *) | StructUnionName of Ast.structUnion mcode * ident option (* name *) | StructUnionDef of typeC (* either StructUnionName or metavar *) * string mcode (* { *) * declaration dots * string mcode (* } *) @@ -221,7 +207,12 @@ and typeC = base_typeC wrap split out into multiple declarations of a single variable each. *) and base_declaration = - Init of Ast.storage mcode option * typeC * ident * string mcode (*=*) * + MetaDecl of Ast.meta_name mcode * pure (* variables *) + (* the following are kept separate from MetaDecls because ultimately + they don't match the same thin at all. Consider whether there + should be a separate type for fields, as in the C AST *) + | MetaField of Ast.meta_name mcode * pure (* structure fields *) + | 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 (* ; *) @@ -243,7 +234,9 @@ and declaration = base_declaration wrap and base_initialiser = MetaInit of Ast.meta_name mcode * pure | InitExpr of expression - | InitList of string mcode (*{*) * initialiser_list * string mcode (*}*) + | InitList of string mcode (*{*) * initialiser_list * string mcode (*}*) * + (* true if ordered, as for array, false if unordered, as for struct *) + bool | InitGccExt of designator list (* name *) * string mcode (*=*) * initialiser (* gccext: *) @@ -365,6 +358,7 @@ and base_statement = string mcode (* { *) * statement dots * string mcode (* } *) | Include of string mcode (* #include *) * Ast.inc_file mcode (* file *) + | Undef of string mcode (* #define *) * ident (* name *) | Define of string mcode (* #define *) * ident (* name *) * define_parameters (*params*) * statement dots | OptStm of statement @@ -420,10 +414,13 @@ and parsed_rule = (rule * Ast.metavar list * (string list * string list * Ast.dependency * string * Ast.exists)) * (rule * Ast.metavar list) * Ast.ruletype - | ScriptRule of - string * Ast.dependency * (string * Ast.meta_name) list * string - | InitialScriptRule of string * Ast.dependency * string - | FinalScriptRule of string * Ast.dependency * string + | ScriptRule of string (* name *) * + string * Ast.dependency * + (Ast.script_meta_name * Ast.meta_name * Ast.metavar) list * + Ast.meta_name list (*script vars*) * + string + | InitialScriptRule of string (* name *) *string * Ast.dependency * string + | FinalScriptRule of string (* name *) *string * Ast.dependency * string (* --------------------------------------------------------------------- *) @@ -484,6 +481,7 @@ 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 wrap x = { node = x; @@ -561,79 +559,87 @@ let undots d = let rec ast0_type_to_type ty = match unwrap ty with - ConstVol(cv,ty) -> Type_cocci.ConstVol(const_vol cv,ast0_type_to_type ty) + ConstVol(cv,ty) -> TC.ConstVol(const_vol cv,ast0_type_to_type ty) | BaseType(bty,strings) -> - Type_cocci.BaseType(baseType bty) + TC.BaseType(baseType bty) | Signed(sgn,None) -> - Type_cocci.SignedT(sign sgn,None) + TC.SignedT(sign sgn,None) | Signed(sgn,Some ty) -> let bty = ast0_type_to_type ty in - Type_cocci.SignedT(sign sgn,Some bty) - | Pointer(ty,_) -> Type_cocci.Pointer(ast0_type_to_type ty) + TC.SignedT(sign sgn,Some bty) + | Pointer(ty,_) -> TC.Pointer(ast0_type_to_type ty) | FunctionPointer(ty,_,_,_,_,params,_) -> - Type_cocci.FunctionPointer(ast0_type_to_type ty) + TC.FunctionPointer(ast0_type_to_type ty) | FunctionType _ -> failwith "not supported" - | Array(ety,_,_,_) -> Type_cocci.Array(ast0_type_to_type ety) - | EnumName(su,tag) -> + | Array(ety,_,_,_) -> TC.Array(ast0_type_to_type ety) + | EnumName(su,Some tag) -> (match unwrap tag with Id(tag) -> - Type_cocci.EnumName(false,unwrap_mcode tag) + TC.EnumName(TC.Name(unwrap_mcode tag)) | MetaId(tag,_,_) -> (Printf.printf "warning: enum with a metavariable name detected.\n"; Printf.printf "For type checking assuming the name of the metavariable is the name of the type\n"; - let (rule,tag) = unwrap_mcode tag in - Type_cocci.EnumName(true,rule^tag)) + TC.EnumName(TC.MV(unwrap_mcode tag,TC.Unitary,false))) | _ -> failwith "unexpected enum type name") + | EnumName(su,None) -> failwith "nameless enum - what to do???" + | EnumDef(ty,_,_,_) -> ast0_type_to_type ty | StructUnionName(su,Some tag) -> (match unwrap tag with Id(tag) -> - Type_cocci.StructUnionName(structUnion su,false,unwrap_mcode tag) - | MetaId(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 "For type checking assuming the name of the metavariable is the name of the type\n"; - let (rule,tag) = unwrap_mcode tag in - Type_cocci.StructUnionName(structUnion su,true,rule^tag)) + TC.StructUnionName(structUnion su, + TC.MV(unwrap_mcode tag,TC.Unitary,false))) + | 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???" | StructUnionDef(ty,_,_,_) -> ast0_type_to_type ty - | TypeName(name) -> Type_cocci.TypeName(unwrap_mcode name) + | TypeName(name) -> TC.TypeName(unwrap_mcode name) | MetaType(name,_) -> - Type_cocci.MetaType(unwrap_mcode name,Type_cocci.Unitary,false) + TC.MetaType(unwrap_mcode name,TC.Unitary,false) | DisjType(_,types,_,_) -> Common.pr2_once "disjtype not supported in smpl type inference, assuming unknown"; - Type_cocci.Unknown + TC.Unknown | OptType(ty) | UniqueType(ty) -> ast0_type_to_type ty and baseType = function - Ast.VoidType -> Type_cocci.VoidType - | Ast.CharType -> Type_cocci.CharType - | Ast.ShortType -> Type_cocci.ShortType - | Ast.IntType -> Type_cocci.IntType - | Ast.DoubleType -> Type_cocci.DoubleType - | Ast.FloatType -> Type_cocci.FloatType - | Ast.LongType -> Type_cocci.LongType - | Ast.LongLongType -> Type_cocci.LongLongType + Ast.VoidType -> TC.VoidType + | Ast.CharType -> TC.CharType + | Ast.ShortType -> TC.ShortType + | Ast.IntType -> TC.IntType + | Ast.DoubleType -> TC.DoubleType + | Ast.FloatType -> TC.FloatType + | Ast.LongType -> TC.LongType + | Ast.LongLongType -> TC.LongLongType + | Ast.SizeType -> TC.SizeType + | Ast.SSizeType -> TC.SSizeType + | Ast.PtrDiffType -> TC.PtrDiffType and structUnion t = match unwrap_mcode t with - Ast.Struct -> Type_cocci.Struct - | Ast.Union -> Type_cocci.Union + Ast.Struct -> TC.Struct + | Ast.Union -> TC.Union and sign t = match unwrap_mcode t with - Ast.Signed -> Type_cocci.Signed - | Ast.Unsigned -> Type_cocci.Unsigned + Ast.Signed -> TC.Signed + | Ast.Unsigned -> TC.Unsigned and const_vol t = match unwrap_mcode t with - Ast.Const -> Type_cocci.Const - | Ast.Volatile -> Type_cocci.Volatile + Ast.Const -> TC.Const + | Ast.Volatile -> TC.Volatile (* --------------------------------------------------------------------- *) (* this function is a rather minimal attempt. the problem is that information @@ -641,77 +647,76 @@ 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_minus_mcode x = + (x,NONE,default_info(),minus_befaft(),ref NoMetaPos,-1) exception TyConv let rec reverse_type ty = match ty with - Type_cocci.ConstVol(cv,ty) -> + TC.ConstVol(cv,ty) -> ConstVol(reverse_const_vol cv,context_wrap(reverse_type ty)) - | Type_cocci.BaseType(bty) -> + | TC.BaseType(bty) -> BaseType(reverse_baseType bty,[(* not used *)]) - | Type_cocci.SignedT(sgn,None) -> Signed(reverse_sign sgn,None) - | Type_cocci.SignedT(sgn,Some bty) -> + | TC.SignedT(sgn,None) -> Signed(reverse_sign sgn,None) + | TC.SignedT(sgn,Some bty) -> Signed(reverse_sign sgn,Some (context_wrap(reverse_type ty))) - | Type_cocci.Pointer(ty) -> + | TC.Pointer(ty) -> Pointer(context_wrap(reverse_type ty),make_mcode "*") - | Type_cocci.EnumName(mv,tag) -> - if mv - then - (* not right... *) - let rule = "" in - EnumName - (make_mcode "enum", - context_wrap(MetaId(make_mcode (rule,tag),Ast.IdNoConstraint, - Impure))) - else - EnumName(make_mcode "enum",context_wrap(Id(make_mcode tag))) - | Type_cocci.StructUnionName(su,mv,tag) -> - if mv - then - (* not right... *) - let rule = "" in - StructUnionName - (reverse_structUnion su, - Some(context_wrap(MetaId(make_mcode (rule,tag),Ast.IdNoConstraint, - Impure)))) - else - StructUnionName - (reverse_structUnion su, - Some (context_wrap(Id(make_mcode tag)))) - | Type_cocci.TypeName(name) -> TypeName(make_mcode name) - | Type_cocci.MetaType(name,_,_) -> + | TC.EnumName(TC.MV(name,_,_)) -> + EnumName + (make_mcode "enum", + Some (context_wrap(MetaId(make_mcode name,Ast.IdNoConstraint, + Impure)))) + | TC.EnumName(TC.Name tag) -> + EnumName(make_mcode "enum",Some(context_wrap(Id(make_mcode tag)))) + | TC.StructUnionName(su,TC.MV(name,_,_)) -> + (* not right?... *) + StructUnionName + (reverse_structUnion su, + Some(context_wrap(MetaId(make_mcode name,Ast.IdNoConstraint, + Impure(*not really right*))))) + | TC.StructUnionName(su,TC.Name tag) -> + StructUnionName + (reverse_structUnion su, + Some (context_wrap(Id(make_mcode tag)))) + | TC.TypeName(name) -> TypeName(make_mcode name) + | TC.MetaType(name,_,_) -> MetaType(make_mcode name,Impure(*not really right*)) | _ -> raise TyConv and reverse_baseType = function - Type_cocci.VoidType -> Ast.VoidType - | Type_cocci.CharType -> Ast.CharType - | Type_cocci.BoolType -> Ast.IntType - | Type_cocci.ShortType -> Ast.ShortType - | Type_cocci.IntType -> Ast.IntType - | Type_cocci.DoubleType -> Ast.DoubleType - | Type_cocci.FloatType -> Ast.FloatType - | Type_cocci.LongType -> Ast.LongType - | Type_cocci.LongLongType -> Ast.LongLongType + TC.VoidType -> Ast.VoidType + | TC.CharType -> Ast.CharType + | TC.BoolType -> Ast.IntType + | TC.ShortType -> Ast.ShortType + | TC.IntType -> Ast.IntType + | TC.DoubleType -> Ast.DoubleType + | TC.FloatType -> Ast.FloatType + | TC.LongType -> Ast.LongType + | TC.LongLongType -> Ast.LongLongType + | TC.SizeType -> Ast.SizeType + | TC.SSizeType -> Ast.SSizeType + | TC.PtrDiffType -> Ast.PtrDiffType + and reverse_structUnion t = make_mcode (match t with - Type_cocci.Struct -> Ast.Struct - | Type_cocci.Union -> Ast.Union) + TC.Struct -> Ast.Struct + | TC.Union -> Ast.Union) and reverse_sign t = make_mcode (match t with - Type_cocci.Signed -> Ast.Signed - | Type_cocci.Unsigned -> Ast.Unsigned) + TC.Signed -> Ast.Signed + | TC.Unsigned -> Ast.Unsigned) and reverse_const_vol t = make_mcode (match t with - Type_cocci.Const -> Ast.Const - | Type_cocci.Volatile -> Ast.Volatile) + TC.Const -> Ast.Const + | TC.Volatile -> Ast.Volatile) (* --------------------------------------------------------------------- *)