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