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