Release coccinelle-0.2.2-rc1
[bpt/coccinelle.git] / parsing_cocci / ast_cocci.ml
CommitLineData
9f8e26f4 1(*
ae4735db 2 * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
9f8e26f4
C
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
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
951c7801
C
23(* Constraints on Meta-* Identifiers, Functions *)
24type idconstraint =
25 IdNoConstraint
26 | IdNegIdSet of string list
27 | IdRegExp of string * Str.regexp
28 | IdNotRegExp of string * Str.regexp
34e49164
C
29
30(* --------------------------------------------------------------------- *)
31(* Modified code *)
32
c3e37e97
C
33type added_string = Noindent of string | Indent of string
34
34e49164 35type info = { line : int; column : int;
c3e37e97
C
36 strbef : (added_string * int (* line *) * int (* col *)) list;
37 straft : (added_string * int (* line *) * int (* col *)) list }
34e49164
C
38type line = int
39type meta_name = string * string
40(* need to be careful about rewrapping, to avoid duplicating pos info
41currently, the pos info is always None until asttoctl2. *)
42type 'a wrap =
43 {node : 'a;
44 node_line : line;
45 free_vars : meta_name list; (*free vars*)
46 minus_free_vars : meta_name list; (*minus free vars*)
978fd7e5 47 fresh_vars : (meta_name * seed) list; (*fresh vars*)
34e49164
C
48 inherited : meta_name list; (*inherited vars*)
49 saved_witness : meta_name list; (*witness vars*)
50 bef_aft : dots_bef_aft;
51 (* the following is for or expressions *)
52 pos_info : meta_name mcode option; (* pos info, try not to duplicate *)
53 true_if_test_exp : bool;(* true if "test_exp from iso", only for exprs *)
54 (* isos relevant to the term; ultimately only used for rule_elems *)
55 iso_info : (string*anything) list }
56
57and 'a befaft =
951c7801
C
58 BEFORE of 'a list list * count
59 | AFTER of 'a list list * count
60 | BEFOREAFTER of 'a list list * 'a list list * count
34e49164
C
61 | NOTHING
62
63and 'a mcode = 'a * info * mcodekind * meta_pos (* pos variable *)
951c7801
C
64 (* pos is an offset indicating where in the C code the mcodekind
65 has an effect *)
66 (* int list is the match instances, which are only meaningful in annotated
67 C code *)
68 (* int is the adjacency index, which is incremented on context dots *)
69(* iteration is only allowed on contect code, the intuition vaguely being
70that there is no way to replace something more than once. Actually,
71allowing iterated additions on minus code would cause problems with some
72heuristics for adding braces, because one couldn't identify simple
73replacements with certainty. Anyway, iteration doesn't seem to be needed
74on - code for the moment. Although it may be confusing that there can be
75iterated addition of code before context code where the context code is
76immediately followed by removed code. *)
77and mcodekind =
708f4980 78 MINUS of pos * int list * int * anything list list
34e49164 79 | CONTEXT of pos * anything befaft
951c7801
C
80 | PLUS of count
81and count = ONE (* + *) | MANY (* ++ *)
82and fixpos =
34e49164 83 Real of int (* charpos *) | Virt of int * int (* charpos + offset *)
951c7801 84and pos = NoPos | DontCarePos | FixPos of (fixpos * fixpos)
34e49164
C
85
86and dots_bef_aft =
87 NoDots
88 | AddingBetweenDots of statement * int (*index of let var*)
89 | DroppingBetweenDots of statement * int (*index of let var*)
90
91and inherited = Type_cocci.inherited
92and keep_binding = Type_cocci.keep_binding
93and multi = bool (*true if a nest is one or more, false if it is zero or more*)
94
95and end_info =
978fd7e5 96 meta_name list (*free vars*) * (meta_name * seed) list (*fresh*) *
b1b2de81 97 meta_name list (*inherited vars*) * mcodekind
34e49164
C
98
99(* --------------------------------------------------------------------- *)
100(* Metavariables *)
101
102and arity = UNIQUE | OPT | MULTI | NONE
103
104and metavar =
105 MetaIdDecl of arity * meta_name (* name *)
978fd7e5 106 | MetaFreshIdDecl of meta_name (* name *) * seed (* seed *)
34e49164 107 | MetaTypeDecl of arity * meta_name (* name *)
113803cf 108 | MetaInitDecl of arity * meta_name (* name *)
34e49164
C
109 | MetaListlenDecl of meta_name (* name *)
110 | MetaParamDecl of arity * meta_name (* name *)
111 | MetaParamListDecl of arity * meta_name (*name*) * meta_name option (*len*)
112 | MetaConstDecl of
113 arity * meta_name (* name *) * Type_cocci.typeC list option
114 | MetaErrDecl of arity * meta_name (* name *)
115 | MetaExpDecl of
116 arity * meta_name (* name *) * Type_cocci.typeC list option
117 | MetaIdExpDecl of
118 arity * meta_name (* name *) * Type_cocci.typeC list option
119 | MetaLocalIdExpDecl of
120 arity * meta_name (* name *) * Type_cocci.typeC list option
121 | MetaExpListDecl of arity * meta_name (*name*) * meta_name option (*len*)
122 | MetaStmDecl of arity * meta_name (* name *)
123 | MetaStmListDecl of arity * meta_name (* name *)
124 | MetaFuncDecl of arity * meta_name (* name *)
125 | MetaLocalFuncDecl of arity * meta_name (* name *)
126 | MetaPosDecl of arity * meta_name (* name *)
127 | MetaDeclarerDecl of arity * meta_name (* name *)
128 | MetaIteratorDecl of arity * meta_name (* name *)
129
978fd7e5
C
130and seed = NoVal | StringSeed of string | ListSeed of seed_elem list
131and seed_elem = SeedString of string | SeedId of meta_name
132
34e49164
C
133(* --------------------------------------------------------------------- *)
134(* --------------------------------------------------------------------- *)
135(* Dots *)
136
137and 'a base_dots =
138 DOTS of 'a list
139 | CIRCLES of 'a list
140 | STARS of 'a list
141
142and 'a dots = 'a base_dots wrap
143
144(* --------------------------------------------------------------------- *)
145(* Identifier *)
146
147and base_ident =
951c7801
C
148 Id of string mcode
149 | MetaId of meta_name mcode * idconstraint * keep_binding * inherited
150 | MetaFunc of meta_name mcode * idconstraint * keep_binding * inherited
151 | MetaLocalFunc of meta_name mcode * idconstraint * keep_binding * inherited
34e49164
C
152
153 | OptIdent of ident
154 | UniqueIdent of ident
155
156and ident = base_ident wrap
157
158(* --------------------------------------------------------------------- *)
159(* Expression *)
160
faf9a90c 161and base_expression =
34e49164
C
162 Ident of ident
163 | Constant of constant mcode
164 | FunCall of expression * string mcode (* ( *) *
165 expression dots * string mcode (* ) *)
166 | Assignment of expression * assignOp mcode * expression *
167 bool (* true if it can match an initialization *)
168 | CondExpr of expression * string mcode (* ? *) * expression option *
169 string mcode (* : *) * expression
170 | Postfix of expression * fixOp mcode
171 | Infix of expression * fixOp mcode
172 | Unary of expression * unaryOp mcode
173 | Binary of expression * binaryOp mcode * expression
174 | Nested of expression * binaryOp mcode * expression
175 | ArrayAccess of expression * string mcode (* [ *) * expression *
176 string mcode (* ] *)
177 | RecordAccess of expression * string mcode (* . *) * ident
178 | RecordPtAccess of expression * string mcode (* -> *) * ident
179 | Cast of string mcode (* ( *) * fullType * string mcode (* ) *) *
180 expression
181 | SizeOfExpr of string mcode (* sizeof *) * expression
182 | SizeOfType of string mcode (* sizeof *) * string mcode (* ( *) *
183 fullType * string mcode (* ) *)
184 | TypeExp of fullType (*type name used as an expression, only in
185 arg or #define*)
186
187 | Paren of string mcode (* ( *) * expression *
188 string mcode (* ) *)
189
951c7801 190 | MetaErr of meta_name mcode * constraints * keep_binding *
34e49164 191 inherited
951c7801 192 | MetaExpr of meta_name mcode * constraints * keep_binding *
34e49164
C
193 Type_cocci.typeC list option * form * inherited
194 | MetaExprList of meta_name mcode * listlen option * keep_binding *
195 inherited (* only in arg lists *)
196
197 | EComma of string mcode (* only in arg lists *)
198
199 | DisjExpr of expression list
200 | NestExpr of expression dots * expression option * multi
201
202 (* can appear in arg lists, and also inside Nest, as in:
203 if(< ... X ... Y ...>)
204 In the following, the expression option is the WHEN *)
205 | Edots of string mcode (* ... *) * expression option
206 | Ecircles of string mcode (* ooo *) * expression option
207 | Estars of string mcode (* *** *) * expression option
208
209 | OptExp of expression
210 | UniqueExp of expression
211
951c7801
C
212and constraints =
213 NoConstraint
214 | NotIdCstrt of idconstraint
215 | NotExpCstrt of expression list
216
34e49164
C
217(* ANY = int E; ID = idexpression int X; CONST = constant int X; *)
218and form = ANY | ID | LocalID | CONST (* form for MetaExp *)
219
220and expression = base_expression wrap
221
222and listlen = meta_name mcode * keep_binding * inherited
223
224and unaryOp = GetRef | DeRef | UnPlus | UnMinus | Tilde | Not
225and assignOp = SimpleAssign | OpAssign of arithOp
226and fixOp = Dec | Inc
227
228and binaryOp = Arith of arithOp | Logical of logicalOp
229and arithOp =
230 Plus | Minus | Mul | Div | Mod | DecLeft | DecRight | And | Or | Xor
231and logicalOp = Inf | Sup | InfEq | SupEq | Eq | NotEq | AndLog | OrLog
232
233and constant =
234 String of string
235 | Char of string
236 | Int of string
237 | Float of string
238
239(* --------------------------------------------------------------------- *)
240(* Types *)
241
242and base_fullType =
243 Type of const_vol mcode option * typeC
244 | DisjType of fullType list (* only after iso *)
245 | OptType of fullType
246 | UniqueType of fullType
247
faf9a90c
C
248and base_typeC =
249 BaseType of baseType * string mcode list (* Yoann style *)
250 | SignedT of sign mcode * typeC option
34e49164
C
251 | Pointer of fullType * string mcode (* * *)
252 | FunctionPointer of fullType *
253 string mcode(* ( *)*string mcode(* * *)*string mcode(* ) *)*
254 string mcode (* ( *)*parameter_list*string mcode(* ) *)
255
256 (* used for the automatic managment of prototypes *)
257 | FunctionType of bool (* true if all minus for dropping return type *) *
258 fullType option *
259 string mcode (* ( *) * parameter_list *
260 string mcode (* ) *)
261
262 | Array of fullType * string mcode (* [ *) *
263 expression option * string mcode (* ] *)
faf9a90c 264 | EnumName of string mcode (*enum*) * ident (* name *)
34e49164
C
265 | StructUnionName of structUnion mcode * ident option (* name *)
266 | StructUnionDef of fullType (* either StructUnionName or metavar *) *
267 string mcode (* { *) * declaration dots * string mcode (* } *)
b1b2de81 268 | TypeName of string mcode (* pad: should be 'of ident' ? *)
34e49164
C
269
270 | MetaType of meta_name mcode * keep_binding * inherited
271
272and fullType = base_fullType wrap
273and typeC = base_typeC wrap
faf9a90c 274
34e49164 275and baseType = VoidType | CharType | ShortType | IntType | DoubleType
faf9a90c 276 | FloatType | LongType | LongLongType
34e49164
C
277
278and structUnion = Struct | Union
279
280and sign = Signed | Unsigned
281
282and const_vol = Const | Volatile
283
284(* --------------------------------------------------------------------- *)
285(* Variable declaration *)
286(* Even if the Cocci program specifies a list of declarations, they are
287 split out into multiple declarations of a single variable each. *)
288
289and base_declaration =
290 Init of storage mcode option * fullType * ident * string mcode (*=*) *
291 initialiser * string mcode (*;*)
292 | UnInit of storage mcode option * fullType * ident * string mcode (* ; *)
293 | TyDecl of fullType * string mcode (* ; *)
294 | MacroDecl of ident (* name *) * string mcode (* ( *) *
295 expression dots * string mcode (* ) *) * string mcode (* ; *)
faf9a90c 296 | Typedef of string mcode (*typedef*) * fullType *
34e49164
C
297 typeC (* either TypeName or metavar *) * string mcode (*;*)
298 | DisjDecl of declaration list
299 (* Ddots is for a structure declaration *)
300 | Ddots of string mcode (* ... *) * declaration option (* whencode *)
301
302 | MetaDecl of meta_name mcode * keep_binding * inherited
303
304 | OptDecl of declaration
305 | UniqueDecl of declaration
306
307and declaration = base_declaration wrap
308
309(* --------------------------------------------------------------------- *)
310(* Initializers *)
311
312and base_initialiser =
113803cf
C
313 MetaInit of meta_name mcode * keep_binding * inherited
314 | InitExpr of expression
34e49164
C
315 | InitList of string mcode (*{*) * initialiser list * string mcode (*}*) *
316 initialiser list (* whencode: elements that shouldn't appear in init *)
113803cf
C
317 | InitGccExt of
318 designator list (* name *) * string mcode (*=*) *
34e49164
C
319 initialiser (* gccext: *)
320 | InitGccName of ident (* name *) * string mcode (*:*) *
321 initialiser
34e49164
C
322 | IComma of string mcode (* , *)
323
324 | OptIni of initialiser
325 | UniqueIni of initialiser
326
113803cf
C
327and designator =
328 DesignatorField of string mcode (* . *) * ident
329 | DesignatorIndex of string mcode (* [ *) * expression * string mcode (* ] *)
330 | DesignatorRange of
331 string mcode (* [ *) * expression * string mcode (* ... *) *
332 expression * string mcode (* ] *)
333
34e49164
C
334and initialiser = base_initialiser wrap
335
336(* --------------------------------------------------------------------- *)
337(* Parameter *)
338
339and base_parameterTypeDef =
340 VoidParam of fullType
341 | Param of fullType * ident option
342
343 | MetaParam of meta_name mcode * keep_binding * inherited
344 | MetaParamList of meta_name mcode * listlen option * keep_binding *
345 inherited
346
347 | PComma of string mcode
348
349 | Pdots of string mcode (* ... *)
350 | Pcircles of string mcode (* ooo *)
351
352 | OptParam of parameterTypeDef
353 | UniqueParam of parameterTypeDef
354
355and parameterTypeDef = base_parameterTypeDef wrap
356
357and parameter_list = parameterTypeDef dots
358
359(* --------------------------------------------------------------------- *)
360(* #define Parameters *)
361
362and base_define_param =
363 DParam of ident
364 | DPComma of string mcode
365 | DPdots of string mcode (* ... *)
366 | DPcircles of string mcode (* ooo *)
367 | OptDParam of define_param
368 | UniqueDParam of define_param
369
370and define_param = base_define_param wrap
371
372and base_define_parameters =
373 NoParams (* not parameter list, not an empty one *)
374 | DParams of string mcode(*( *) * define_param dots * string mcode(* )*)
375
376and define_parameters = base_define_parameters wrap
377
378(* --------------------------------------------------------------------- *)
379(* positions *)
380
381(* PER = keep bindings separate, ALL = collect them *)
382and meta_collect = PER | ALL
383
384and meta_pos =
385 MetaPos of meta_name mcode * meta_name list *
386 meta_collect * keep_binding * inherited
387 | NoMetaPos
388
389(* --------------------------------------------------------------------- *)
390(* Function declaration *)
391
392and storage = Static | Auto | Register | Extern
393
394(* --------------------------------------------------------------------- *)
395(* Top-level code *)
396
397and base_rule_elem =
398 FunHeader of mcodekind (* before the function header *) *
399 bool (* true if all minus, for dropping static, etc *) *
400 fninfo list * ident (* name *) *
401 string mcode (* ( *) * parameter_list *
402 string mcode (* ) *)
403 | Decl of mcodekind (* before the decl *) *
404 bool (* true if all minus *) * declaration
405
406 | SeqStart of string mcode (* { *)
407 | SeqEnd of string mcode (* } *)
408
409 | ExprStatement of expression * string mcode (*;*)
410 | IfHeader of string mcode (* if *) * string mcode (* ( *) *
411 expression * string mcode (* ) *)
412 | Else of string mcode (* else *)
413 | WhileHeader of string mcode (* while *) * string mcode (* ( *) *
414 expression * string mcode (* ) *)
415 | DoHeader of string mcode (* do *)
416 | WhileTail of string mcode (* while *) * string mcode (* ( *) *
417 expression * string mcode (* ) *) *
418 string mcode (* ; *)
419 | ForHeader of string mcode (* for *) * string mcode (* ( *) *
420 expression option * string mcode (*;*) *
421 expression option * string mcode (*;*) *
422 expression option * string mcode (* ) *)
423 | IteratorHeader of ident (* name *) * string mcode (* ( *) *
424 expression dots * string mcode (* ) *)
425 | SwitchHeader of string mcode (* switch *) * string mcode (* ( *) *
426 expression * string mcode (* ) *)
427 | Break of string mcode (* break *) * string mcode (* ; *)
428 | Continue of string mcode (* continue *) * string mcode (* ; *)
429 | Label of ident * string mcode (* : *)
430 | Goto of string mcode (* goto *) * ident * string mcode (* ; *)
431 | Return of string mcode (* return *) * string mcode (* ; *)
432 | ReturnExpr of string mcode (* return *) * expression *
433 string mcode (* ; *)
434
435 | MetaRuleElem of meta_name mcode * keep_binding * inherited
436 | MetaStmt of meta_name mcode * keep_binding * metaStmtInfo *
437 inherited
438 | MetaStmtList of meta_name mcode * keep_binding * inherited
439
440 | Exp of expression (* matches a subterm *)
441 | TopExp of expression (* for macros body, exp at top level,
442 not subexp *)
443 | Ty of fullType (* only at SP top level, matches a subterm *)
1be43e12 444 | TopInit of initialiser (* only at top level *)
34e49164
C
445 | Include of string mcode (*#include*) * inc_file mcode (*file *)
446 | DefineHeader of string mcode (* #define *) * ident (* name *) *
447 define_parameters (*params*)
448 | Case of string mcode (* case *) * expression * string mcode (*:*)
449 | Default of string mcode (* default *) * string mcode (*:*)
450 | DisjRuleElem of rule_elem list
451
452and fninfo =
453 FStorage of storage mcode
454 | FType of fullType
455 | FInline of string mcode
456 | FAttr of string mcode
457
458and metaStmtInfo =
459 NotSequencible | SequencibleAfterDots of dots_whencode list | Sequencible
460
461and rule_elem = base_rule_elem wrap
462
463and base_statement =
708f4980 464 Seq of rule_elem (* { *) *
34e49164
C
465 statement dots * rule_elem (* } *)
466 | IfThen of rule_elem (* header *) * statement * end_info (* endif *)
467 | IfThenElse of rule_elem (* header *) * statement *
468 rule_elem (* else *) * statement * end_info (* endif *)
469 | While of rule_elem (* header *) * statement * end_info (*endwhile*)
470 | Do of rule_elem (* do *) * statement * rule_elem (* tail *)
471 | For of rule_elem (* header *) * statement * end_info (*endfor*)
472 | Iterator of rule_elem (* header *) * statement * end_info (*enditer*)
473 | Switch of rule_elem (* header *) * rule_elem (* { *) *
fc1ad971 474 statement (*decl*) dots * case_line list * rule_elem(*}*)
34e49164
C
475 | Atomic of rule_elem
476 | Disj of statement dots list
477 | Nest of statement dots *
478 (statement dots,statement) whencode list * multi *
479 dots_whencode list * dots_whencode list
480 | FunDecl of rule_elem (* header *) * rule_elem (* { *) *
708f4980 481 statement dots * rule_elem (* } *)
34e49164
C
482 | Define of rule_elem (* header *) * statement dots
483 | Dots of string mcode (* ... *) *
484 (statement dots,statement) whencode list *
485 dots_whencode list * dots_whencode list
486 | Circles of string mcode (* ooo *) *
487 (statement dots,statement) whencode list *
488 dots_whencode list * dots_whencode list
489 | Stars of string mcode (* *** *) *
490 (statement dots,statement) whencode list *
491 dots_whencode list * dots_whencode list
492 | OptStm of statement
493 | UniqueStm of statement
494
495and ('a,'b) whencode =
496 WhenNot of 'a
497 | WhenAlways of 'b
498 | WhenModifier of when_modifier
1be43e12
C
499 | WhenNotTrue of rule_elem (* useful for fvs *)
500 | WhenNotFalse of rule_elem
34e49164
C
501
502and when_modifier =
503 (* The following removes the shortest path constraint. It can be used
504 with other when modifiers *)
505 WhenAny
506 (* The following removes the special consideration of error paths. It
507 can be used with other when modifiers *)
508 | WhenStrict
509 | WhenForall
510 | WhenExists
511
512(* only used with asttoctl *)
513and dots_whencode =
514 WParen of rule_elem * meta_name (*pren_var*)
515 | Other of statement
516 | Other_dots of statement dots
517
518and statement = base_statement wrap
519
520and base_case_line =
521 CaseLine of rule_elem (* case/default header *) * statement dots
522 | OptCase of case_line
523
524and case_line = base_case_line wrap
525
526and inc_file =
527 Local of inc_elem list
528 | NonLocal of inc_elem list
529
530and inc_elem =
531 IncPath of string
532 | IncDots
533
534and base_top_level =
535 DECL of statement
536 | CODE of statement dots
537 | FILEINFO of string mcode (* old file *) * string mcode (* new file *)
538 | ERRORWORDS of expression list
539
540and top_level = base_top_level wrap
541
542and rulename =
543 CocciRulename of string option * dependency *
544 string list * string list * exists * bool
faf9a90c
C
545 | GeneratedRulename of string option * dependency *
546 string list * string list * exists * bool
34e49164 547 | ScriptRulename of string * dependency
c3e37e97
C
548 | InitialScriptRulename of string * dependency
549 | FinalScriptRulename of string * dependency
34e49164 550
faf9a90c
C
551and ruletype = Normal | Generated
552
34e49164 553and rule =
faf9a90c 554 CocciRule of string (* name *) *
34e49164 555 (dependency * string list (* dropped isos *) * exists) * top_level list
faf9a90c 556 * bool list * ruletype
34e49164 557 | ScriptRule of string * dependency * (string * meta_name) list * string
c3e37e97
C
558 | InitialScriptRule of string (*language*) * dependency * string (*code*)
559 | FinalScriptRule of string (*language*) * dependency * string (*code*)
34e49164
C
560
561and dependency =
562 Dep of string (* rule applies for the current binding *)
563 | AntiDep of string (* rule doesn't apply for the current binding *)
564 | EverDep of string (* rule applies for some binding *)
565 | NeverDep of string (* rule never applies for any binding *)
566 | AndDep of dependency * dependency
567 | OrDep of dependency * dependency
7f004419 568 | NoDep | FailDep
34e49164
C
569
570and rule_with_metavars = metavar list * rule
571
572and anything =
573 FullTypeTag of fullType
574 | BaseTypeTag of baseType
575 | StructUnionTag of structUnion
576 | SignTag of sign
577 | IdentTag of ident
578 | ExpressionTag of expression
579 | ConstantTag of constant
580 | UnaryOpTag of unaryOp
581 | AssignOpTag of assignOp
582 | FixOpTag of fixOp
583 | BinaryOpTag of binaryOp
584 | ArithOpTag of arithOp
585 | LogicalOpTag of logicalOp
586 | DeclarationTag of declaration
587 | InitTag of initialiser
588 | StorageTag of storage
589 | IncFileTag of inc_file
590 | Rule_elemTag of rule_elem
591 | StatementTag of statement
592 | CaseLineTag of case_line
593 | ConstVolTag of const_vol
594 | Token of string * info option
c3e37e97 595 | Pragma of added_string list
34e49164
C
596 | Code of top_level
597 | ExprDotsTag of expression dots
598 | ParamDotsTag of parameterTypeDef dots
599 | StmtDotsTag of statement dots
600 | DeclDotsTag of declaration dots
601 | TypeCTag of typeC
602 | ParamTag of parameterTypeDef
603 | SgrepStartTag of string
604 | SgrepEndTag of string
605
606(* --------------------------------------------------------------------- *)
607
978fd7e5
C
608and exists = Exists | Forall | Undetermined
609(* | ReverseForall - idea: look back on all flow paths; not implemented *)
34e49164
C
610
611(* --------------------------------------------------------------------- *)
612
613let mkToken x = Token (x,None)
614
615(* --------------------------------------------------------------------- *)
616
951c7801
C
617let lub_count i1 i2 =
618 match (i1,i2) with
619 (MANY,MANY) -> MANY
620 | _ -> ONE
621
622(* --------------------------------------------------------------------- *)
623
34e49164
C
624let rewrap model x = {model with node = x}
625let rewrap_mcode (_,a,b,c) x = (x,a,b,c)
626let unwrap x = x.node
627let unwrap_mcode (x,_,_,_) = x
628let get_mcodekind (_,_,x,_) = x
629let get_line x = x.node_line
630let get_mcode_line (_,l,_,_) = l.line
708f4980 631let get_mcode_col (_,l,_,_) = l.column
34e49164
C
632let get_fvs x = x.free_vars
633let set_fvs fvs x = {x with free_vars = fvs}
634let get_mfvs x = x.minus_free_vars
635let set_mfvs mfvs x = {x with minus_free_vars = mfvs}
636let get_fresh x = x.fresh_vars
637let get_inherited x = x.inherited
638let get_saved x = x.saved_witness
639let get_dots_bef_aft x = x.bef_aft
640let set_dots_bef_aft d x = {x with bef_aft = d}
641let get_pos x = x.pos_info
642let set_pos x pos = {x with pos_info = pos}
643let get_test_exp x = x.true_if_test_exp
644let set_test_exp x = {x with true_if_test_exp = true}
645let get_isos x = x.iso_info
646let set_isos x isos = {x with iso_info = isos}
647let get_pos_var (_,_,_,p) = p
648let set_pos_var vr (a,b,c,_) = (a,b,c,vr)
649let drop_pos (a,b,c,_) = (a,b,c,NoMetaPos)
650
651let get_wcfvs (whencode : ('a wrap, 'b wrap) whencode list) =
652 Common.union_all
653 (List.map
654 (function
655 WhenNot(a) -> get_fvs a
656 | WhenAlways(a) -> get_fvs a
1be43e12
C
657 | WhenModifier(_) -> []
658 | WhenNotTrue(e) -> get_fvs e
659 | WhenNotFalse(e) -> get_fvs e)
34e49164
C
660 whencode)
661
662(* --------------------------------------------------------------------- *)
663
664let get_meta_name = function
665 MetaIdDecl(ar,nm) -> nm
b1b2de81 666 | MetaFreshIdDecl(nm,seed) -> nm
34e49164 667 | MetaTypeDecl(ar,nm) -> nm
113803cf 668 | MetaInitDecl(ar,nm) -> nm
34e49164
C
669 | MetaListlenDecl(nm) -> nm
670 | MetaParamDecl(ar,nm) -> nm
671 | MetaParamListDecl(ar,nm,nm1) -> nm
672 | MetaConstDecl(ar,nm,ty) -> nm
673 | MetaErrDecl(ar,nm) -> nm
674 | MetaExpDecl(ar,nm,ty) -> nm
675 | MetaIdExpDecl(ar,nm,ty) -> nm
676 | MetaLocalIdExpDecl(ar,nm,ty) -> nm
677 | MetaExpListDecl(ar,nm,nm1) -> nm
678 | MetaStmDecl(ar,nm) -> nm
679 | MetaStmListDecl(ar,nm) -> nm
680 | MetaFuncDecl(ar,nm) -> nm
681 | MetaLocalFuncDecl(ar,nm) -> nm
682 | MetaPosDecl(ar,nm) -> nm
683 | MetaDeclarerDecl(ar,nm) -> nm
684 | MetaIteratorDecl(ar,nm) -> nm
685
686(* --------------------------------------------------------------------- *)
687
0708f913
C
688and tag2c = function
689 FullTypeTag _ -> "FullTypeTag"
690 | BaseTypeTag _ -> "BaseTypeTag"
691 | StructUnionTag _ -> "StructUnionTag"
692 | SignTag _ -> "SignTag"
693 | IdentTag _ -> "IdentTag"
694 | ExpressionTag _ -> "ExpressionTag"
695 | ConstantTag _ -> "ConstantTag"
696 | UnaryOpTag _ -> "UnaryOpTag"
697 | AssignOpTag _ -> "AssignOpTag"
698 | FixOpTag _ -> "FixOpTag"
699 | BinaryOpTag _ -> "BinaryOpTag"
700 | ArithOpTag _ -> "ArithOpTag"
701 | LogicalOpTag _ -> "LogicalOpTag"
702 | DeclarationTag _ -> "DeclarationTag"
703 | InitTag _ -> "InitTag"
704 | StorageTag _ -> "StorageTag"
705 | IncFileTag _ -> "IncFileTag"
706 | Rule_elemTag _ -> "Rule_elemTag"
707 | StatementTag _ -> "StatementTag"
708 | CaseLineTag _ -> "CaseLineTag"
709 | ConstVolTag _ -> "ConstVolTag"
710 | Token _ -> "Token"
711 | Pragma _ -> "Pragma"
712 | Code _ -> "Code"
713 | ExprDotsTag _ -> "ExprDotsTag"
714 | ParamDotsTag _ -> "ParamDotsTag"
715 | StmtDotsTag _ -> "StmtDotsTag"
716 | DeclDotsTag _ -> "DeclDotsTag"
717 | TypeCTag _ -> "TypeCTag"
718 | ParamTag _ -> "ParamTag"
719 | SgrepStartTag _ -> "SgrepStartTag"
720 | SgrepEndTag _ -> "SgrepEndTag"
721
722(* --------------------------------------------------------------------- *)
723
708f4980 724let no_info = { line = 0; column = -1; strbef = []; straft = [] }
34e49164
C
725
726let make_term x =
727 {node = x;
728 node_line = 0;
729 free_vars = [];
730 minus_free_vars = [];
731 fresh_vars = [];
732 inherited = [];
733 saved_witness = [];
734 bef_aft = NoDots;
735 pos_info = None;
736 true_if_test_exp = false;
737 iso_info = [] }
738
739let make_meta_rule_elem s d (fvs,fresh,inh) =
ae4735db 740 let rule = "" in
34e49164 741 {(make_term
ae4735db 742 (MetaRuleElem(((rule,s),no_info,d,NoMetaPos),Type_cocci.Unitary,false)))
34e49164
C
743 with free_vars = fvs; fresh_vars = fresh; inherited = inh}
744
745let make_meta_decl s d (fvs,fresh,inh) =
ae4735db 746 let rule = "" in
34e49164 747 {(make_term
ae4735db 748 (MetaDecl(((rule,s),no_info,d,NoMetaPos),Type_cocci.Unitary,false))) with
34e49164
C
749 free_vars = fvs; fresh_vars = fresh; inherited = inh}
750
751let make_mcode x = (x,no_info,CONTEXT(NoPos,NOTHING),NoMetaPos)
752
753(* --------------------------------------------------------------------- *)
754
755let equal_pos x y = x = y
756
757(* --------------------------------------------------------------------- *)
758
759let undots x =
760 match unwrap x with
761 DOTS e -> e
762 | CIRCLES e -> e
763 | STARS e -> e