| 1 | (* |
| 2 | * Copyright 2005-2008, Ecole des Mines de Nantes, University of Copenhagen |
| 3 | * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller |
| 4 | * This file is part of Coccinelle. |
| 5 | * |
| 6 | * Coccinelle is free software: you can redistribute it and/or modify |
| 7 | * it under the terms of the GNU General Public License as published by |
| 8 | * the Free Software Foundation, according to version 2 of the License. |
| 9 | * |
| 10 | * Coccinelle is distributed in the hope that it will be useful, |
| 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 13 | * GNU General Public License for more details. |
| 14 | * |
| 15 | * You should have received a copy of the GNU General Public License |
| 16 | * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>. |
| 17 | * |
| 18 | * The authors reserve the right to distribute this or future versions of |
| 19 | * Coccinelle under other licenses. |
| 20 | *) |
| 21 | |
| 22 | |
| 23 | module Ast = Ast_cocci |
| 24 | |
| 25 | (* --------------------------------------------------------------------- *) |
| 26 | (* Modified code *) |
| 27 | |
| 28 | type arity = OPT | UNIQUE | NONE |
| 29 | |
| 30 | type token_info = |
| 31 | { tline_start : int; tline_end : int; |
| 32 | left_offset : int; right_offset : int } |
| 33 | let default_token_info = |
| 34 | { tline_start = -1; tline_end = -1; left_offset = -1; right_offset = -1 } |
| 35 | |
| 36 | (* MIXED is like CONTEXT, since sometimes MIXED things have to revert to |
| 37 | CONTEXT - see insert_plus.ml *) |
| 38 | type mcodekind = |
| 39 | MINUS of (Ast.anything list list * token_info) ref |
| 40 | | PLUS |
| 41 | | CONTEXT of (Ast.anything Ast.befaft * token_info * token_info) ref |
| 42 | | MIXED of (Ast.anything Ast.befaft * token_info * token_info) ref |
| 43 | |
| 44 | type info = { line_start : int; line_end : int; |
| 45 | logical_start : int; logical_end : int; |
| 46 | attachable_start : bool; attachable_end : bool; |
| 47 | mcode_start : mcodekind list; mcode_end : mcodekind list; |
| 48 | column : int; offset : int; |
| 49 | (* the following are only for + code *) |
| 50 | strings_before : string list; strings_after : string list } |
| 51 | |
| 52 | type 'a mcode = 'a * arity * info * mcodekind * meta_pos ref (* pos, - only *) |
| 53 | (* int ref is an index *) |
| 54 | and 'a wrap = |
| 55 | { node : 'a; |
| 56 | info : info; |
| 57 | index : int ref; |
| 58 | mcodekind : mcodekind ref; |
| 59 | exp_ty : Type_cocci.typeC option ref; (* only for expressions *) |
| 60 | bef_aft : dots_bef_aft; (* only for statements *) |
| 61 | true_if_arg : bool; (* true if "arg_exp", only for exprs *) |
| 62 | true_if_test : bool; (* true if "test position", only for exprs *) |
| 63 | true_if_test_exp : bool;(* true if "test_exp from iso", only for exprs *) |
| 64 | (*nonempty if this represents the use of an iso*) |
| 65 | iso_info : (string*anything) list } |
| 66 | |
| 67 | and dots_bef_aft = |
| 68 | NoDots | AddingBetweenDots of statement | DroppingBetweenDots of statement |
| 69 | |
| 70 | (* for iso metavariables, true if they can only match nonmodified terms with |
| 71 | all metavariables unitary |
| 72 | for SP metavariables, true if the metavariable is unitary (valid up to |
| 73 | isomorphism phase only) |
| 74 | In SP, the only options are impure and context |
| 75 | *) |
| 76 | and pure = Impure | Pure | Context | PureContext (* pure and only context *) |
| 77 | |
| 78 | (* --------------------------------------------------------------------- *) |
| 79 | (* --------------------------------------------------------------------- *) |
| 80 | (* Dots *) |
| 81 | |
| 82 | and 'a base_dots = |
| 83 | DOTS of 'a list |
| 84 | | CIRCLES of 'a list |
| 85 | | STARS of 'a list |
| 86 | |
| 87 | and 'a dots = 'a base_dots wrap |
| 88 | |
| 89 | (* --------------------------------------------------------------------- *) |
| 90 | (* Identifier *) |
| 91 | |
| 92 | and base_ident = |
| 93 | Id of string mcode |
| 94 | | MetaId of Ast.meta_name mcode * ident list * pure |
| 95 | | MetaFunc of Ast.meta_name mcode * ident list * pure |
| 96 | | MetaLocalFunc of Ast.meta_name mcode * ident list * pure |
| 97 | | OptIdent of ident |
| 98 | | UniqueIdent of ident |
| 99 | |
| 100 | and ident = base_ident wrap |
| 101 | |
| 102 | (* --------------------------------------------------------------------- *) |
| 103 | (* Expression *) |
| 104 | |
| 105 | and base_expression = |
| 106 | Ident of ident |
| 107 | | Constant of Ast.constant mcode |
| 108 | | FunCall of expression * string mcode (* ( *) * |
| 109 | expression dots * string mcode (* ) *) |
| 110 | | Assignment of expression * Ast.assignOp mcode * expression * |
| 111 | bool (* true if it can match an initialization *) |
| 112 | | CondExpr of expression * string mcode (* ? *) * expression option * |
| 113 | string mcode (* : *) * expression |
| 114 | | Postfix of expression * Ast.fixOp mcode |
| 115 | | Infix of expression * Ast.fixOp mcode |
| 116 | | Unary of expression * Ast.unaryOp mcode |
| 117 | | Binary of expression * Ast.binaryOp mcode * expression |
| 118 | | Nested of expression * Ast.binaryOp mcode * expression |
| 119 | | Paren of string mcode (* ( *) * expression * |
| 120 | string mcode (* ) *) |
| 121 | | ArrayAccess of expression * string mcode (* [ *) * expression * |
| 122 | string mcode (* ] *) |
| 123 | | RecordAccess of expression * string mcode (* . *) * ident |
| 124 | | RecordPtAccess of expression * string mcode (* -> *) * ident |
| 125 | | Cast of string mcode (* ( *) * typeC * string mcode (* ) *) * |
| 126 | expression |
| 127 | | SizeOfExpr of string mcode (* sizeof *) * expression |
| 128 | | SizeOfType of string mcode (* sizeof *) * string mcode (* ( *) * |
| 129 | typeC * string mcode (* ) *) |
| 130 | | TypeExp of typeC (* type name used as an expression, only in args *) |
| 131 | | MetaErr of Ast.meta_name mcode * expression list * pure |
| 132 | | MetaExpr of Ast.meta_name mcode * expression list * |
| 133 | Type_cocci.typeC list option * Ast.form * pure |
| 134 | | MetaExprList of Ast.meta_name mcode (* only in arg lists *) * |
| 135 | listlen * pure |
| 136 | | EComma of string mcode (* only in arg lists *) |
| 137 | | DisjExpr of string mcode * expression list * |
| 138 | string mcode list (* the |s *) * string mcode |
| 139 | | NestExpr of string mcode * expression dots * string mcode * |
| 140 | expression option * Ast.multi |
| 141 | | Edots of string mcode (* ... *) * expression option |
| 142 | | Ecircles of string mcode (* ooo *) * expression option |
| 143 | | Estars of string mcode (* *** *) * expression option |
| 144 | | OptExp of expression |
| 145 | | UniqueExp of expression |
| 146 | |
| 147 | and expression = base_expression wrap |
| 148 | |
| 149 | and listlen = Ast.meta_name mcode option |
| 150 | |
| 151 | (* --------------------------------------------------------------------- *) |
| 152 | (* Types *) |
| 153 | |
| 154 | and base_typeC = |
| 155 | ConstVol of Ast.const_vol mcode * typeC |
| 156 | | BaseType of Ast.baseType mcode * Ast.sign mcode option |
| 157 | | ImplicitInt of Ast.sign mcode |
| 158 | | Pointer of typeC * string mcode (* * *) |
| 159 | | FunctionPointer of typeC * |
| 160 | string mcode(* ( *)*string mcode(* * *)*string mcode(* ) *)* |
| 161 | string mcode (* ( *)*parameter_list*string mcode(* ) *) |
| 162 | | FunctionType of typeC option * |
| 163 | string mcode (* ( *) * parameter_list * |
| 164 | string mcode (* ) *) |
| 165 | | Array of typeC * string mcode (* [ *) * |
| 166 | expression option * string mcode (* ] *) |
| 167 | | StructUnionName of Ast.structUnion mcode * ident option (* name *) |
| 168 | | StructUnionDef of typeC (* either StructUnionName or metavar *) * |
| 169 | string mcode (* { *) * declaration dots * string mcode (* } *) |
| 170 | | TypeName of string mcode |
| 171 | | MetaType of Ast.meta_name mcode * pure |
| 172 | | DisjType of string mcode * typeC list * (* only after iso *) |
| 173 | string mcode list (* the |s *) * string mcode |
| 174 | | OptType of typeC |
| 175 | | UniqueType of typeC |
| 176 | |
| 177 | and typeC = base_typeC wrap |
| 178 | |
| 179 | (* --------------------------------------------------------------------- *) |
| 180 | (* Variable declaration *) |
| 181 | (* Even if the Cocci program specifies a list of declarations, they are |
| 182 | split out into multiple declarations of a single variable each. *) |
| 183 | |
| 184 | and base_declaration = |
| 185 | Init of Ast.storage mcode option * typeC * ident * string mcode (*=*) * |
| 186 | initialiser * string mcode (*;*) |
| 187 | | UnInit of Ast.storage mcode option * typeC * ident * string mcode (* ; *) |
| 188 | | TyDecl of typeC * string mcode (* ; *) |
| 189 | | MacroDecl of ident (* name *) * string mcode (* ( *) * |
| 190 | expression dots * string mcode (* ) *) * string mcode (* ; *) |
| 191 | | Typedef of string mcode (* typedef *) * typeC * typeC * string mcode (*;*) |
| 192 | | DisjDecl of string mcode * declaration list * |
| 193 | string mcode list (* the |s *) * string mcode |
| 194 | (* Ddots is for a structure declaration *) |
| 195 | | Ddots of string mcode (* ... *) * declaration option (* whencode *) |
| 196 | | OptDecl of declaration |
| 197 | | UniqueDecl of declaration |
| 198 | |
| 199 | and declaration = base_declaration wrap |
| 200 | |
| 201 | (* --------------------------------------------------------------------- *) |
| 202 | (* Initializers *) |
| 203 | |
| 204 | and base_initialiser = |
| 205 | InitExpr of expression |
| 206 | | InitList of string mcode (*{*) * initialiser_list * string mcode (*}*) |
| 207 | | InitGccDotName of |
| 208 | string mcode (*.*) * ident (* name *) * string mcode (*=*) * |
| 209 | initialiser (* gccext: *) |
| 210 | | InitGccName of ident (* name *) * string mcode (*:*) * |
| 211 | initialiser |
| 212 | | InitGccIndex of |
| 213 | string mcode (*[*) * expression * string mcode (*]*) * |
| 214 | string mcode (*=*) * initialiser |
| 215 | | InitGccRange of |
| 216 | string mcode (*[*) * expression * string mcode (*...*) * |
| 217 | expression * string mcode (*]*) * string mcode (*=*) * initialiser |
| 218 | | IComma of string mcode (* , *) |
| 219 | | Idots of string mcode (* ... *) * initialiser option (* whencode *) |
| 220 | | OptIni of initialiser |
| 221 | | UniqueIni of initialiser |
| 222 | |
| 223 | and initialiser = base_initialiser wrap |
| 224 | |
| 225 | and initialiser_list = initialiser dots |
| 226 | |
| 227 | (* --------------------------------------------------------------------- *) |
| 228 | (* Parameter *) |
| 229 | |
| 230 | and base_parameterTypeDef = |
| 231 | VoidParam of typeC |
| 232 | | Param of typeC * ident option |
| 233 | | MetaParam of Ast.meta_name mcode * pure |
| 234 | | MetaParamList of Ast.meta_name mcode * listlen * pure |
| 235 | | PComma of string mcode |
| 236 | | Pdots of string mcode (* ... *) |
| 237 | | Pcircles of string mcode (* ooo *) |
| 238 | | OptParam of parameterTypeDef |
| 239 | | UniqueParam of parameterTypeDef |
| 240 | |
| 241 | and parameterTypeDef = base_parameterTypeDef wrap |
| 242 | |
| 243 | and parameter_list = parameterTypeDef dots |
| 244 | |
| 245 | (* --------------------------------------------------------------------- *) |
| 246 | (* #define Parameters *) |
| 247 | |
| 248 | and base_define_param = |
| 249 | DParam of ident |
| 250 | | DPComma of string mcode |
| 251 | | DPdots of string mcode (* ... *) |
| 252 | | DPcircles of string mcode (* ooo *) |
| 253 | | OptDParam of define_param |
| 254 | | UniqueDParam of define_param |
| 255 | |
| 256 | and define_param = base_define_param wrap |
| 257 | |
| 258 | and base_define_parameters = |
| 259 | NoParams |
| 260 | | DParams of string mcode(*( *) * define_param dots * string mcode(* )*) |
| 261 | |
| 262 | and define_parameters = base_define_parameters wrap |
| 263 | |
| 264 | (* --------------------------------------------------------------------- *) |
| 265 | (* Statement*) |
| 266 | |
| 267 | and base_statement = |
| 268 | Decl of (info * mcodekind) (* before the decl *) * declaration |
| 269 | | Seq of string mcode (* { *) * statement dots * |
| 270 | string mcode (* } *) |
| 271 | | ExprStatement of expression * string mcode (*;*) |
| 272 | | IfThen of string mcode (* if *) * string mcode (* ( *) * |
| 273 | expression * string mcode (* ) *) * |
| 274 | statement * (info * mcodekind) (* after info *) |
| 275 | | IfThenElse of string mcode (* if *) * string mcode (* ( *) * |
| 276 | expression * string mcode (* ) *) * |
| 277 | statement * string mcode (* else *) * statement * |
| 278 | (info * mcodekind) |
| 279 | | While of string mcode (* while *) * string mcode (* ( *) * |
| 280 | expression * string mcode (* ) *) * |
| 281 | statement * (info * mcodekind) (* after info *) |
| 282 | | Do of string mcode (* do *) * statement * |
| 283 | string mcode (* while *) * string mcode (* ( *) * |
| 284 | expression * string mcode (* ) *) * |
| 285 | string mcode (* ; *) |
| 286 | | For of string mcode (* for *) * string mcode (* ( *) * |
| 287 | expression option * string mcode (*;*) * |
| 288 | expression option * string mcode (*;*) * |
| 289 | expression option * string mcode (* ) *) * statement * |
| 290 | (info * mcodekind) (* after info *) |
| 291 | | Iterator of ident (* name *) * string mcode (* ( *) * |
| 292 | expression dots * string mcode (* ) *) * |
| 293 | statement * (info * mcodekind) (* after info *) |
| 294 | | Switch of string mcode (* switch *) * string mcode (* ( *) * |
| 295 | expression * string mcode (* ) *) * string mcode (* { *) * |
| 296 | case_line dots * string mcode (* } *) |
| 297 | | Break of string mcode (* break *) * string mcode (* ; *) |
| 298 | | Continue of string mcode (* continue *) * string mcode (* ; *) |
| 299 | | Label of ident * string mcode (* : *) |
| 300 | | Goto of string mcode (* goto *) * ident * string mcode (* ; *) |
| 301 | | Return of string mcode (* return *) * string mcode (* ; *) |
| 302 | | ReturnExpr of string mcode (* return *) * expression * |
| 303 | string mcode (* ; *) |
| 304 | | MetaStmt of Ast.meta_name mcode * pure |
| 305 | | MetaStmtList of Ast.meta_name mcode(*only in statement lists*) * pure |
| 306 | | Exp of expression (* only in dotted statement lists *) |
| 307 | | TopExp of expression (* for macros body *) |
| 308 | | Ty of typeC (* only at top level *) |
| 309 | | TopInit of initialiser (* only at top level *) |
| 310 | | Disj of string mcode * statement dots list * |
| 311 | string mcode list (* the |s *) * string mcode |
| 312 | | Nest of string mcode * statement dots * string mcode * |
| 313 | (statement dots,statement) whencode list * Ast.multi |
| 314 | | Dots of string mcode (* ... *) * |
| 315 | (statement dots,statement) whencode list |
| 316 | | Circles of string mcode (* ooo *) * |
| 317 | (statement dots,statement) whencode list |
| 318 | | Stars of string mcode (* *** *) * |
| 319 | (statement dots,statement) whencode list |
| 320 | | FunDecl of (info * mcodekind) (* before the function decl *) * |
| 321 | fninfo list * ident (* name *) * |
| 322 | string mcode (* ( *) * parameter_list * string mcode (* ) *) * |
| 323 | string mcode (* { *) * statement dots * |
| 324 | string mcode (* } *) |
| 325 | | Include of string mcode (* #include *) * Ast.inc_file mcode (* file *) |
| 326 | | Define of string mcode (* #define *) * ident (* name *) * |
| 327 | define_parameters (*params*) * statement dots |
| 328 | | OptStm of statement |
| 329 | | UniqueStm of statement |
| 330 | |
| 331 | and fninfo = |
| 332 | FStorage of Ast.storage mcode |
| 333 | | FType of typeC |
| 334 | | FInline of string mcode |
| 335 | | FAttr of string mcode |
| 336 | |
| 337 | and ('a,'b) whencode = |
| 338 | WhenNot of 'a |
| 339 | | WhenAlways of 'b |
| 340 | | WhenModifier of Ast.when_modifier |
| 341 | | WhenNotTrue of expression |
| 342 | | WhenNotFalse of expression |
| 343 | |
| 344 | and statement = base_statement wrap |
| 345 | |
| 346 | and base_case_line = |
| 347 | Default of string mcode (* default *) * string mcode (*:*) * statement dots |
| 348 | | Case of string mcode (* case *) * expression * string mcode (*:*) * |
| 349 | statement dots |
| 350 | | OptCase of case_line |
| 351 | |
| 352 | and case_line = base_case_line wrap |
| 353 | |
| 354 | (* --------------------------------------------------------------------- *) |
| 355 | (* Positions *) |
| 356 | |
| 357 | and meta_pos = |
| 358 | MetaPos of Ast.meta_name mcode * Ast.meta_name list * Ast.meta_collect |
| 359 | | NoMetaPos |
| 360 | |
| 361 | (* --------------------------------------------------------------------- *) |
| 362 | (* Top-level code *) |
| 363 | |
| 364 | and base_top_level = |
| 365 | DECL of statement |
| 366 | | CODE of statement dots |
| 367 | | FILEINFO of string mcode (* old file *) * string mcode (* new file *) |
| 368 | | ERRORWORDS of expression list |
| 369 | | OTHER of statement (* temporary, disappears after top_level.ml *) |
| 370 | |
| 371 | and top_level = base_top_level wrap |
| 372 | and rule = top_level list |
| 373 | |
| 374 | and parsed_rule = |
| 375 | CocciRule of |
| 376 | (rule * Ast.metavar list * |
| 377 | (string list * string list * Ast.dependency * string * Ast.exists)) * |
| 378 | (rule * Ast.metavar list) |
| 379 | | ScriptRule of |
| 380 | string * Ast.dependency * (string * Ast.meta_name) list * string |
| 381 | |
| 382 | (* --------------------------------------------------------------------- *) |
| 383 | |
| 384 | and anything = |
| 385 | DotsExprTag of expression dots |
| 386 | | DotsInitTag of initialiser dots |
| 387 | | DotsParamTag of parameterTypeDef dots |
| 388 | | DotsStmtTag of statement dots |
| 389 | | DotsDeclTag of declaration dots |
| 390 | | DotsCaseTag of case_line dots |
| 391 | | IdentTag of ident |
| 392 | | ExprTag of expression |
| 393 | | ArgExprTag of expression (* for isos *) |
| 394 | | TestExprTag of expression (* for isos *) |
| 395 | | TypeCTag of typeC |
| 396 | | ParamTag of parameterTypeDef |
| 397 | | InitTag of initialiser |
| 398 | | DeclTag of declaration |
| 399 | | StmtTag of statement |
| 400 | | CaseLineTag of case_line |
| 401 | | TopTag of top_level |
| 402 | | IsoWhenTag of Ast.when_modifier |
| 403 | | IsoWhenTTag of expression |
| 404 | | IsoWhenFTag of expression |
| 405 | | MetaPosTag of meta_pos |
| 406 | |
| 407 | let dotsExpr x = DotsExprTag x |
| 408 | let dotsParam x = DotsParamTag x |
| 409 | let dotsInit x = DotsInitTag x |
| 410 | let dotsStmt x = DotsStmtTag x |
| 411 | let dotsDecl x = DotsDeclTag x |
| 412 | let dotsCase x = DotsCaseTag x |
| 413 | let ident x = IdentTag x |
| 414 | let expr x = ExprTag x |
| 415 | let typeC x = TypeCTag x |
| 416 | let param x = ParamTag x |
| 417 | let ini x = InitTag x |
| 418 | let decl x = DeclTag x |
| 419 | let stmt x = StmtTag x |
| 420 | let case_line x = CaseLineTag x |
| 421 | let top x = TopTag x |
| 422 | |
| 423 | (* --------------------------------------------------------------------- *) |
| 424 | (* Avoid cluttering the parser. Calculated in compute_lines.ml. *) |
| 425 | |
| 426 | let default_info _ = (* why is this a function? *) |
| 427 | { line_start = -1; line_end = -1; |
| 428 | logical_start = -1; logical_end = -1; |
| 429 | attachable_start = true; attachable_end = true; |
| 430 | mcode_start = []; mcode_end = []; |
| 431 | column = -1; offset = -1; strings_before = []; strings_after = [] } |
| 432 | |
| 433 | let default_befaft _ = |
| 434 | MIXED(ref (Ast.NOTHING,default_token_info,default_token_info)) |
| 435 | let context_befaft _ = |
| 436 | CONTEXT(ref (Ast.NOTHING,default_token_info,default_token_info)) |
| 437 | |
| 438 | let wrap x = |
| 439 | { node = x; |
| 440 | info = default_info(); |
| 441 | index = ref (-1); |
| 442 | mcodekind = ref (default_befaft()); |
| 443 | exp_ty = ref None; |
| 444 | bef_aft = NoDots; |
| 445 | true_if_arg = false; |
| 446 | true_if_test = false; |
| 447 | true_if_test_exp = false; |
| 448 | iso_info = [] } |
| 449 | let context_wrap x = |
| 450 | { node = x; |
| 451 | info = default_info(); |
| 452 | index = ref (-1); |
| 453 | mcodekind = ref (context_befaft()); |
| 454 | exp_ty = ref None; |
| 455 | bef_aft = NoDots; |
| 456 | true_if_arg = false; |
| 457 | true_if_test = false; |
| 458 | true_if_test_exp = false; |
| 459 | iso_info = [] } |
| 460 | let unwrap x = x.node |
| 461 | let unwrap_mcode (x,_,_,_,_) = x |
| 462 | let rewrap model x = { model with node = x } |
| 463 | let rewrap_mcode (_,arity,info,mcodekind,pos) x = (x,arity,info,mcodekind,pos) |
| 464 | let copywrap model x = |
| 465 | { model with node = x; index = ref !(model.index); |
| 466 | mcodekind = ref !(model.mcodekind); exp_ty = ref !(model.exp_ty)} |
| 467 | let get_pos (_,_,_,_,x) = !x |
| 468 | let get_pos_ref (_,_,_,_,x) = x |
| 469 | let set_pos pos (m,arity,info,mcodekind,_) = (m,arity,info,mcodekind,ref pos) |
| 470 | let get_info x = x.info |
| 471 | let set_info x info = {x with info = info} |
| 472 | let get_line x = x.info.line_start |
| 473 | let get_line_end x = x.info.line_end |
| 474 | let get_index x = !(x.index) |
| 475 | let set_index x i = x.index := i |
| 476 | let get_mcodekind x = !(x.mcodekind) |
| 477 | let get_mcode_mcodekind (_,_,_,mcodekind,_) = mcodekind |
| 478 | let get_mcodekind_ref x = x.mcodekind |
| 479 | let set_mcodekind x mk = x.mcodekind := mk |
| 480 | let set_type x t = x.exp_ty := t |
| 481 | let get_type x = !(x.exp_ty) |
| 482 | let get_dots_bef_aft x = x.bef_aft |
| 483 | let set_dots_bef_aft x dots_bef_aft = {x with bef_aft = dots_bef_aft} |
| 484 | let get_arg_exp x = x.true_if_arg |
| 485 | let set_arg_exp x = {x with true_if_arg = true} |
| 486 | let get_test_pos x = x.true_if_test |
| 487 | let set_test_pos x = {x with true_if_test = true} |
| 488 | let get_test_exp x = x.true_if_test_exp |
| 489 | let set_test_exp x = {x with true_if_test_exp = true} |
| 490 | let get_iso x = x.iso_info |
| 491 | let set_iso x i = if !Flag.track_iso_usage then {x with iso_info = i} else x |
| 492 | let set_mcode_data data (_,ar,info,mc,pos) = (data,ar,info,mc,pos) |
| 493 | |
| 494 | (* --------------------------------------------------------------------- *) |
| 495 | |
| 496 | (* unique indices, for mcode and tree nodes *) |
| 497 | let index_counter = ref 0 |
| 498 | let fresh_index _ = let cur = !index_counter in index_counter := cur + 1; cur |
| 499 | |
| 500 | (* --------------------------------------------------------------------- *) |
| 501 | |
| 502 | let undots d = |
| 503 | match unwrap d with |
| 504 | | DOTS e -> e |
| 505 | | CIRCLES e -> e |
| 506 | | STARS e -> e |
| 507 | |
| 508 | (* --------------------------------------------------------------------- *) |
| 509 | |
| 510 | let rec ast0_type_to_type ty = |
| 511 | match unwrap ty with |
| 512 | ConstVol(cv,ty) -> Type_cocci.ConstVol(const_vol cv,ast0_type_to_type ty) |
| 513 | | BaseType(bty,None) -> |
| 514 | Type_cocci.BaseType(baseType bty,None) |
| 515 | | BaseType(bty,Some sgn) -> |
| 516 | Type_cocci.BaseType(baseType bty,Some (sign sgn)) |
| 517 | | ImplicitInt(sgn) -> |
| 518 | let bty = Type_cocci.IntType in |
| 519 | Type_cocci.BaseType(bty,Some (sign sgn)) |
| 520 | | Pointer(ty,_) -> Type_cocci.Pointer(ast0_type_to_type ty) |
| 521 | | FunctionPointer(ty,_,_,_,_,params,_) -> |
| 522 | Type_cocci.FunctionPointer(ast0_type_to_type ty) |
| 523 | | FunctionType _ -> failwith "not supported" |
| 524 | | Array(ety,_,_,_) -> Type_cocci.Array(ast0_type_to_type ety) |
| 525 | | StructUnionName(su,Some tag) -> |
| 526 | (match unwrap tag with |
| 527 | Id(tag) -> |
| 528 | Type_cocci.StructUnionName(structUnion su,false,unwrap_mcode tag) |
| 529 | | MetaId(tag,_,_) -> |
| 530 | (Printf.printf |
| 531 | "warning: struct/union with a metavariable name detected.\n"; |
| 532 | Printf.printf |
| 533 | "For type checking assuming the name of the metavariable is the name of the type\n"; |
| 534 | let (rule,tag) = unwrap_mcode tag in |
| 535 | Type_cocci.StructUnionName(structUnion su,true,rule^tag)) |
| 536 | | _ -> failwith "unexpected struct/union type name") |
| 537 | | StructUnionName(su,None) -> failwith "nameless structure - what to do???" |
| 538 | | StructUnionDef(ty,_,_,_) -> ast0_type_to_type ty |
| 539 | | TypeName(name) -> Type_cocci.TypeName(unwrap_mcode name) |
| 540 | | MetaType(name,_) -> |
| 541 | Type_cocci.MetaType(unwrap_mcode name,Type_cocci.Unitary,false) |
| 542 | | DisjType(_,types,_,_) -> failwith "unexpected DisjType" |
| 543 | | OptType(ty) | UniqueType(ty) -> |
| 544 | ast0_type_to_type ty |
| 545 | |
| 546 | and baseType t = |
| 547 | match unwrap_mcode t with |
| 548 | Ast.VoidType -> Type_cocci.VoidType |
| 549 | | Ast.CharType -> Type_cocci.CharType |
| 550 | | Ast.ShortType -> Type_cocci.ShortType |
| 551 | | Ast.IntType -> Type_cocci.IntType |
| 552 | | Ast.DoubleType -> Type_cocci.DoubleType |
| 553 | | Ast.FloatType -> Type_cocci.FloatType |
| 554 | | Ast.LongType -> Type_cocci.LongType |
| 555 | |
| 556 | and structUnion t = |
| 557 | match unwrap_mcode t with |
| 558 | Ast.Struct -> Type_cocci.Struct |
| 559 | | Ast.Union -> Type_cocci.Union |
| 560 | |
| 561 | and sign t = |
| 562 | match unwrap_mcode t with |
| 563 | Ast.Signed -> Type_cocci.Signed |
| 564 | | Ast.Unsigned -> Type_cocci.Unsigned |
| 565 | |
| 566 | and const_vol t = |
| 567 | match unwrap_mcode t with |
| 568 | Ast.Const -> Type_cocci.Const |
| 569 | | Ast.Volatile -> Type_cocci.Volatile |
| 570 | |
| 571 | (* --------------------------------------------------------------------- *) |
| 572 | (* this function is a rather minimal attempt. the problem is that information |
| 573 | has been lost. but since it is only used for metavariable types in the isos, |
| 574 | perhaps it doesn't matter *) |
| 575 | let make_mcode x = (x,NONE,default_info(),context_befaft(),ref NoMetaPos) |
| 576 | let make_mcode_info x info = (x,NONE,info,context_befaft(),ref NoMetaPos) |
| 577 | |
| 578 | exception TyConv |
| 579 | |
| 580 | let rec reverse_type ty = |
| 581 | match ty with |
| 582 | Type_cocci.ConstVol(cv,ty) -> |
| 583 | ConstVol(reverse_const_vol cv,context_wrap(reverse_type ty)) |
| 584 | | Type_cocci.BaseType(bty,None) -> |
| 585 | BaseType(reverse_baseType bty,None) |
| 586 | | Type_cocci.BaseType(bty,Some sgn) -> |
| 587 | BaseType(reverse_baseType bty,Some (reverse_sign sgn)) |
| 588 | | Type_cocci.Pointer(ty) -> |
| 589 | Pointer(context_wrap(reverse_type ty),make_mcode "*") |
| 590 | | Type_cocci.StructUnionName(su,mv,tag) -> |
| 591 | if mv |
| 592 | then |
| 593 | (* not right... *) |
| 594 | StructUnionName |
| 595 | (reverse_structUnion su, |
| 596 | Some(context_wrap(MetaId(make_mcode ("",tag),[],Impure)))) |
| 597 | else |
| 598 | StructUnionName |
| 599 | (reverse_structUnion su, |
| 600 | Some (context_wrap(Id(make_mcode tag)))) |
| 601 | | Type_cocci.TypeName(name) -> TypeName(make_mcode name) |
| 602 | | Type_cocci.MetaType(name,_,_) -> |
| 603 | MetaType(make_mcode name,Impure(*not really right*)) |
| 604 | | _ -> raise TyConv |
| 605 | |
| 606 | and reverse_baseType t = |
| 607 | make_mcode |
| 608 | (match t with |
| 609 | Type_cocci.VoidType -> Ast.VoidType |
| 610 | | Type_cocci.CharType -> Ast.CharType |
| 611 | | Type_cocci.BoolType -> Ast.IntType |
| 612 | | Type_cocci.ShortType -> Ast.ShortType |
| 613 | | Type_cocci.IntType -> Ast.IntType |
| 614 | | Type_cocci.DoubleType -> Ast.DoubleType |
| 615 | | Type_cocci.FloatType -> Ast.FloatType |
| 616 | | Type_cocci.LongType -> Ast.LongType) |
| 617 | |
| 618 | and reverse_structUnion t = |
| 619 | make_mcode |
| 620 | (match t with |
| 621 | Type_cocci.Struct -> Ast.Struct |
| 622 | | Type_cocci.Union -> Ast.Union) |
| 623 | |
| 624 | and reverse_sign t = |
| 625 | make_mcode |
| 626 | (match t with |
| 627 | Type_cocci.Signed -> Ast.Signed |
| 628 | | Type_cocci.Unsigned -> Ast.Unsigned) |
| 629 | |
| 630 | and reverse_const_vol t = |
| 631 | make_mcode |
| 632 | (match t with |
| 633 | Type_cocci.Const -> Ast.Const |
| 634 | | Type_cocci.Volatile -> Ast.Volatile) |
| 635 | |
| 636 | (* --------------------------------------------------------------------- *) |
| 637 | |
| 638 | let lub_pure x y = |
| 639 | match (x,y) with |
| 640 | (Impure,_) | (_,Impure) -> Impure |
| 641 | | (Pure,Context) | (Context,Pure) -> Impure |
| 642 | | (Pure,_) | (_,Pure) -> Pure |
| 643 | | (_,Context) | (Context,_) -> Context |
| 644 | | _ -> PureContext |
| 645 | |
| 646 | (* --------------------------------------------------------------------- *) |
| 647 | |
| 648 | let rule_name = ref "" (* for the convenience of the parser *) |