Coccinelle release 0.2.5-rc9
[bpt/coccinelle.git] / parsing_cocci / visitor_ast.ml
1 module Ast0 = Ast0_cocci
2 module Ast = Ast_cocci
3
4 (* --------------------------------------------------------------------- *)
5 (* Generic traversal: combiner *)
6 (* parameters:
7 combining function
8 treatment of: mcode, identifiers, expressions, fullTypes, types,
9 declarations, statements, toplevels
10 default value for options *)
11
12 type 'a combiner =
13 {combiner_ident : Ast.ident -> 'a;
14 combiner_expression : Ast.expression -> 'a;
15 combiner_fullType : Ast.fullType -> 'a;
16 combiner_typeC : Ast.typeC -> 'a;
17 combiner_declaration : Ast.declaration -> 'a;
18 combiner_initialiser : Ast.initialiser -> 'a;
19 combiner_parameter : Ast.parameterTypeDef -> 'a;
20 combiner_parameter_list : Ast.parameter_list -> 'a;
21 combiner_rule_elem : Ast.rule_elem -> 'a;
22 combiner_statement : Ast.statement -> 'a;
23 combiner_case_line : Ast.case_line -> 'a;
24 combiner_top_level : Ast.top_level -> 'a;
25 combiner_anything : Ast.anything -> 'a;
26 combiner_expression_dots : Ast.expression Ast.dots -> 'a;
27 combiner_statement_dots : Ast.statement Ast.dots -> 'a;
28 combiner_declaration_dots : Ast.declaration Ast.dots -> 'a;
29 combiner_initialiser_dots : Ast.initialiser Ast.dots -> 'a}
30
31 type ('mc,'a) cmcode = 'a combiner -> 'mc Ast_cocci.mcode -> 'a
32 type ('cd,'a) ccode = 'a combiner -> ('cd -> 'a) -> 'cd -> 'a
33
34
35 let combiner bind option_default
36 meta_mcodefn string_mcodefn const_mcodefn assign_mcodefn fix_mcodefn
37 unary_mcodefn binary_mcodefn
38 cv_mcodefn sign_mcodefn struct_mcodefn storage_mcodefn
39 inc_file_mcodefn
40 expdotsfn paramdotsfn stmtdotsfn decldotsfn initdotsfn
41 identfn exprfn ftfn tyfn initfn paramfn declfn rulefn stmtfn casefn
42 topfn anyfn =
43 let multibind l =
44 let rec loop = function
45 [] -> option_default
46 | [x] -> x
47 | x::xs -> bind x (loop xs) in
48 loop l in
49 let get_option f = function
50 Some x -> f x
51 | None -> option_default in
52
53 let dotsfn param default all_functions arg =
54 let k d =
55 match Ast.unwrap d with
56 Ast.DOTS(l) | Ast.CIRCLES(l) | Ast.STARS(l) ->
57 multibind (List.map default l) in
58 param all_functions k arg in
59
60 let rec meta_mcode x = meta_mcodefn all_functions x
61 and string_mcode x = string_mcodefn all_functions x
62 and const_mcode x = const_mcodefn all_functions x
63 and assign_mcode x = assign_mcodefn all_functions x
64 and fix_mcode x = fix_mcodefn all_functions x
65 and unary_mcode x = unary_mcodefn all_functions x
66 and binary_mcode x = binary_mcodefn all_functions x
67 and cv_mcode x = cv_mcodefn all_functions x
68 and sign_mcode x = sign_mcodefn all_functions x
69 and struct_mcode x = struct_mcodefn all_functions x
70 and storage_mcode x = storage_mcodefn all_functions x
71 and inc_file_mcode x = inc_file_mcodefn all_functions x
72
73 and expression_dots d = dotsfn expdotsfn expression all_functions d
74 and parameter_dots d = dotsfn paramdotsfn parameterTypeDef all_functions d
75 and statement_dots d = dotsfn stmtdotsfn statement all_functions d
76 and declaration_dots d = dotsfn decldotsfn declaration all_functions d
77 and initialiser_dots d = dotsfn initdotsfn initialiser all_functions d
78
79 and ident i =
80 let k i =
81 match Ast.unwrap i with
82 Ast.Id(name) -> string_mcode name
83 | Ast.MetaId(name,_,_,_) -> meta_mcode name
84 | Ast.MetaFunc(name,_,_,_) -> meta_mcode name
85 | Ast.MetaLocalFunc(name,_,_,_) -> meta_mcode name
86 | Ast.DisjId(id_list) -> multibind (List.map ident id_list)
87 | Ast.OptIdent(id) -> ident id
88 | Ast.UniqueIdent(id) -> ident id in
89 identfn all_functions k i
90
91 and expression e =
92 let k e =
93 match Ast.unwrap e with
94 Ast.Ident(id) -> ident id
95 | Ast.Constant(const) -> const_mcode const
96 | Ast.FunCall(fn,lp,args,rp) ->
97 multibind [expression fn; string_mcode lp; expression_dots args;
98 string_mcode rp]
99 | Ast.Assignment(left,op,right,simple) ->
100 multibind [expression left; assign_mcode op; expression right]
101 | Ast.CondExpr(exp1,why,exp2,colon,exp3) ->
102 multibind [expression exp1; string_mcode why;
103 get_option expression exp2; string_mcode colon;
104 expression exp3]
105 | Ast.Postfix(exp,op) -> bind (expression exp) (fix_mcode op)
106 | Ast.Infix(exp,op) -> bind (fix_mcode op) (expression exp)
107 | Ast.Unary(exp,op) -> bind (unary_mcode op) (expression exp)
108 | Ast.Binary(left,op,right) ->
109 multibind [expression left; binary_mcode op; expression right]
110 | Ast.Nested(left,op,right) ->
111 multibind [expression left; binary_mcode op; expression right]
112 | Ast.Paren(lp,exp,rp) ->
113 multibind [string_mcode lp; expression exp; string_mcode rp]
114 | Ast.ArrayAccess(exp1,lb,exp2,rb) ->
115 multibind
116 [expression exp1; string_mcode lb; expression exp2;
117 string_mcode rb]
118 | Ast.RecordAccess(exp,pt,field) ->
119 multibind [expression exp; string_mcode pt; ident field]
120 | Ast.RecordPtAccess(exp,ar,field) ->
121 multibind [expression exp; string_mcode ar; ident field]
122 | Ast.Cast(lp,ty,rp,exp) ->
123 multibind
124 [string_mcode lp; fullType ty; string_mcode rp; expression exp]
125 | Ast.SizeOfExpr(szf,exp) ->
126 multibind [string_mcode szf; expression exp]
127 | Ast.SizeOfType(szf,lp,ty,rp) ->
128 multibind
129 [string_mcode szf; string_mcode lp; fullType ty; string_mcode rp]
130 | Ast.TypeExp(ty) -> fullType ty
131 | Ast.MetaErr(name,_,_,_)
132 | Ast.MetaExpr(name,_,_,_,_,_)
133 | Ast.MetaExprList(name,_,_,_) -> meta_mcode name
134 | Ast.EComma(cm) -> string_mcode cm
135 | Ast.DisjExpr(exp_list) -> multibind (List.map expression exp_list)
136 | Ast.NestExpr(starter,expr_dots,ender,whencode,multi) ->
137 bind (string_mcode starter)
138 (bind (expression_dots expr_dots)
139 (bind (string_mcode ender)
140 (get_option expression whencode)))
141 | Ast.Edots(dots,whencode) | Ast.Ecircles(dots,whencode)
142 | Ast.Estars(dots,whencode) ->
143 bind (string_mcode dots) (get_option expression whencode)
144 | Ast.OptExp(exp) | Ast.UniqueExp(exp) ->
145 expression exp in
146 exprfn all_functions k e
147
148 and fullType ft =
149 let k ft =
150 match Ast.unwrap ft with
151 Ast.Type(cv,ty) -> bind (get_option cv_mcode cv) (typeC ty)
152 | Ast.DisjType(types) -> multibind (List.map fullType types)
153 | Ast.OptType(ty) -> fullType ty
154 | Ast.UniqueType(ty) -> fullType ty in
155 ftfn all_functions k ft
156
157 and function_pointer (ty,lp1,star,rp1,lp2,params,rp2) extra =
158 (* have to put the treatment of the identifier into the right position *)
159 multibind
160 ([fullType ty; string_mcode lp1; string_mcode star] @ extra @
161 [string_mcode rp1;
162 string_mcode lp2; parameter_dots params; string_mcode rp2])
163
164 and function_type (ty,lp1,params,rp1) extra =
165 (* have to put the treatment of the identifier into the right position *)
166 multibind
167 ([get_option fullType ty] @ extra @
168 [string_mcode lp1; parameter_dots params; string_mcode rp1])
169
170 and array_type (ty,lb,size,rb) extra =
171 multibind
172 ([fullType ty] @ extra @
173 [string_mcode lb; get_option expression size; string_mcode rb])
174
175 and typeC ty =
176 let k ty =
177 match Ast.unwrap ty with
178 Ast.BaseType(ty,strings) -> multibind (List.map string_mcode strings)
179 | Ast.SignedT(sgn,ty) -> bind (sign_mcode sgn) (get_option typeC ty)
180 | Ast.Pointer(ty,star) ->
181 bind (fullType ty) (string_mcode star)
182 | Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
183 function_pointer (ty,lp1,star,rp1,lp2,params,rp2) []
184 | Ast.FunctionType (_,ty,lp1,params,rp1) ->
185 function_type (ty,lp1,params,rp1) []
186 | Ast.Array(ty,lb,size,rb) -> array_type (ty,lb,size,rb) []
187 | Ast.EnumName(kind,name) ->
188 bind (string_mcode kind) (get_option ident name)
189 | Ast.EnumDef(ty,lb,ids,rb) ->
190 multibind
191 [fullType ty; string_mcode lb; expression_dots ids;
192 string_mcode rb]
193 | Ast.StructUnionName(kind,name) ->
194 bind (struct_mcode kind) (get_option ident name)
195 | Ast.StructUnionDef(ty,lb,decls,rb) ->
196 multibind
197 [fullType ty; string_mcode lb; declaration_dots decls;
198 string_mcode rb]
199 | Ast.TypeName(name) -> string_mcode name
200 | Ast.MetaType(name,_,_) -> meta_mcode name in
201 tyfn all_functions k ty
202
203 and named_type ty id =
204 match Ast.unwrap ty with
205 Ast.Type(None,ty1) ->
206 (match Ast.unwrap ty1 with
207 Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
208 function_pointer (ty,lp1,star,rp1,lp2,params,rp2) [ident id]
209 | Ast.FunctionType(_,ty,lp1,params,rp1) ->
210 function_type (ty,lp1,params,rp1) [ident id]
211 | Ast.Array(ty,lb,size,rb) -> array_type (ty,lb,size,rb) [ident id]
212 | _ -> bind (fullType ty) (ident id))
213 | _ -> bind (fullType ty) (ident id)
214
215 and declaration d =
216 let k d =
217 match Ast.unwrap d with
218 Ast.MetaDecl(name,_,_) | Ast.MetaField(name,_,_)
219 | Ast.MetaFieldList(name,_,_,_) ->
220 meta_mcode name
221 | Ast.Init(stg,ty,id,eq,ini,sem) ->
222 bind (get_option storage_mcode stg)
223 (bind (named_type ty id)
224 (multibind
225 [string_mcode eq; initialiser ini; string_mcode sem]))
226 | Ast.UnInit(stg,ty,id,sem) ->
227 bind (get_option storage_mcode stg)
228 (bind (named_type ty id) (string_mcode sem))
229 | Ast.MacroDecl(name,lp,args,rp,sem) ->
230 multibind
231 [ident name; string_mcode lp; expression_dots args;
232 string_mcode rp; string_mcode sem]
233 | Ast.TyDecl(ty,sem) -> bind (fullType ty) (string_mcode sem)
234 | Ast.Typedef(stg,ty,id,sem) ->
235 bind (string_mcode stg)
236 (bind (fullType ty) (bind (typeC id) (string_mcode sem)))
237 | Ast.DisjDecl(decls) -> multibind (List.map declaration decls)
238 | Ast.Ddots(dots,whencode) ->
239 bind (string_mcode dots) (get_option declaration whencode)
240 | Ast.OptDecl(decl) -> declaration decl
241 | Ast.UniqueDecl(decl) -> declaration decl in
242 declfn all_functions k d
243
244 and initialiser i =
245 let k i =
246 match Ast.unwrap i with
247 Ast.MetaInit(name,_,_) -> meta_mcode name
248 | Ast.InitExpr(exp) -> expression exp
249 | Ast.ArInitList(lb,initlist,rb) ->
250 multibind
251 [string_mcode lb; initialiser_dots initlist; string_mcode rb]
252 | Ast.StrInitList(allminus,lb,initlist,rb,whencode) ->
253 multibind
254 [string_mcode lb;
255 multibind (List.map initialiser initlist);
256 string_mcode rb;
257 multibind (List.map initialiser whencode)]
258 | Ast.InitGccName(name,eq,ini) ->
259 multibind [ident name; string_mcode eq; initialiser ini]
260 | Ast.InitGccExt(designators,eq,ini) ->
261 multibind
262 ((List.map designator designators) @
263 [string_mcode eq; initialiser ini])
264 | Ast.IComma(cm) -> string_mcode cm
265 | Ast.Idots(dots,whencode) ->
266 bind (string_mcode dots) (get_option initialiser whencode)
267 | Ast.OptIni(i) -> initialiser i
268 | Ast.UniqueIni(i) -> initialiser i in
269 initfn all_functions k i
270
271 and designator = function
272 Ast.DesignatorField(dot,id) -> bind (string_mcode dot) (ident id)
273 | Ast.DesignatorIndex(lb,exp,rb) ->
274 bind (string_mcode lb) (bind (expression exp) (string_mcode rb))
275 | Ast.DesignatorRange(lb,min,dots,max,rb) ->
276 multibind
277 [string_mcode lb; expression min; string_mcode dots;
278 expression max; string_mcode rb]
279
280 and parameterTypeDef p =
281 let k p =
282 match Ast.unwrap p with
283 Ast.VoidParam(ty) -> fullType ty
284 | Ast.Param(ty,Some id) -> named_type ty id
285 | Ast.Param(ty,None) -> fullType ty
286 | Ast.MetaParam(name,_,_) -> meta_mcode name
287 | Ast.MetaParamList(name,_,_,_) -> meta_mcode name
288 | Ast.PComma(cm) -> string_mcode cm
289 | Ast.Pdots(dots) -> string_mcode dots
290 | Ast.Pcircles(dots) -> string_mcode dots
291 | Ast.OptParam(param) -> parameterTypeDef param
292 | Ast.UniqueParam(param) -> parameterTypeDef param in
293 paramfn all_functions k p
294
295 and rule_elem re =
296 let k re =
297 match Ast.unwrap re with
298 Ast.FunHeader(_,_,fi,name,lp,params,rp) ->
299 multibind
300 ((List.map fninfo fi) @
301 [ident name;string_mcode lp;parameter_dots params;
302 string_mcode rp])
303 | Ast.Decl(_,_,decl) -> declaration decl
304 | Ast.SeqStart(brace) -> string_mcode brace
305 | Ast.SeqEnd(brace) -> string_mcode brace
306 | Ast.ExprStatement(exp,sem) ->
307 bind (expression exp) (string_mcode sem)
308 | Ast.IfHeader(iff,lp,exp,rp) ->
309 multibind [string_mcode iff; string_mcode lp; expression exp;
310 string_mcode rp]
311 | Ast.Else(els) -> string_mcode els
312 | Ast.WhileHeader(whl,lp,exp,rp) ->
313 multibind [string_mcode whl; string_mcode lp; expression exp;
314 string_mcode rp]
315 | Ast.DoHeader(d) -> string_mcode d
316 | Ast.WhileTail(whl,lp,exp,rp,sem) ->
317 multibind [string_mcode whl; string_mcode lp; expression exp;
318 string_mcode rp; string_mcode sem]
319 | Ast.ForHeader(fr,lp,e1,sem1,e2,sem2,e3,rp) ->
320 multibind [string_mcode fr; string_mcode lp;
321 get_option expression e1; string_mcode sem1;
322 get_option expression e2; string_mcode sem2;
323 get_option expression e3; string_mcode rp]
324 | Ast.IteratorHeader(nm,lp,args,rp) ->
325 multibind [ident nm; string_mcode lp;
326 expression_dots args; string_mcode rp]
327 | Ast.SwitchHeader(switch,lp,exp,rp) ->
328 multibind [string_mcode switch; string_mcode lp; expression exp;
329 string_mcode rp]
330 | Ast.Break(br,sem) -> bind (string_mcode br) (string_mcode sem)
331 | Ast.Continue(cont,sem) -> bind (string_mcode cont) (string_mcode sem)
332 | Ast.Label(l,dd) -> bind (ident l) (string_mcode dd)
333 | Ast.Goto(goto,l,sem) ->
334 bind (string_mcode goto) (bind (ident l) (string_mcode sem))
335 | Ast.Return(ret,sem) -> bind (string_mcode ret) (string_mcode sem)
336 | Ast.ReturnExpr(ret,exp,sem) ->
337 multibind [string_mcode ret; expression exp; string_mcode sem]
338 | Ast.MetaStmt(name,_,_,_) -> meta_mcode name
339 | Ast.MetaStmtList(name,_,_) -> meta_mcode name
340 | Ast.MetaRuleElem(name,_,_) -> meta_mcode name
341 | Ast.Exp(exp) -> expression exp
342 | Ast.TopExp(exp) -> expression exp
343 | Ast.Ty(ty) -> fullType ty
344 | Ast.TopInit(init) -> initialiser init
345 | Ast.Include(inc,name) -> bind (string_mcode inc) (inc_file_mcode name)
346 | Ast.Undef(def,id) ->
347 multibind [string_mcode def; ident id]
348 | Ast.DefineHeader(def,id,params) ->
349 multibind [string_mcode def; ident id; define_parameters params]
350 | Ast.Default(def,colon) -> bind (string_mcode def) (string_mcode colon)
351 | Ast.Case(case,exp,colon) ->
352 multibind [string_mcode case; expression exp; string_mcode colon]
353 | Ast.DisjRuleElem(res) -> multibind (List.map rule_elem res) in
354 rulefn all_functions k re
355
356 (* not parameterizable for now... *)
357 and define_parameters p =
358 let k p =
359 match Ast.unwrap p with
360 Ast.NoParams -> option_default
361 | Ast.DParams(lp,params,rp) ->
362 multibind
363 [string_mcode lp; define_param_dots params; string_mcode rp] in
364 k p
365
366 and define_param_dots d =
367 let k d =
368 match Ast.unwrap d with
369 Ast.DOTS(l) | Ast.CIRCLES(l) | Ast.STARS(l) ->
370 multibind (List.map define_param l) in
371 k d
372
373 and define_param p =
374 let k p =
375 match Ast.unwrap p with
376 Ast.DParam(id) -> ident id
377 | Ast.DPComma(comma) -> string_mcode comma
378 | Ast.DPdots(d) -> string_mcode d
379 | Ast.DPcircles(c) -> string_mcode c
380 | Ast.OptDParam(dp) -> define_param dp
381 | Ast.UniqueDParam(dp) -> define_param dp in
382 k p
383
384 (* discard the result, because the statement is assumed to be already
385 represented elsewhere in the code *)
386 and process_bef_aft s =
387 match Ast.get_dots_bef_aft s with
388 Ast.NoDots -> ()
389 | Ast.DroppingBetweenDots(stm,ind) -> let _ = statement stm in ()
390 | Ast.AddingBetweenDots(stm,ind) -> let _ = statement stm in ()
391
392 and statement s =
393 process_bef_aft s;
394 let k s =
395 match Ast.unwrap s with
396 Ast.Seq(lbrace,body,rbrace) ->
397 multibind [rule_elem lbrace;
398 statement_dots body; rule_elem rbrace]
399 | Ast.IfThen(header,branch,_) ->
400 multibind [rule_elem header; statement branch]
401 | Ast.IfThenElse(header,branch1,els,branch2,_) ->
402 multibind [rule_elem header; statement branch1; rule_elem els;
403 statement branch2]
404 | Ast.While(header,body,_) ->
405 multibind [rule_elem header; statement body]
406 | Ast.Do(header,body,tail) ->
407 multibind [rule_elem header; statement body; rule_elem tail]
408 | Ast.For(header,body,_) -> multibind [rule_elem header; statement body]
409 | Ast.Iterator(header,body,_) ->
410 multibind [rule_elem header; statement body]
411 | Ast.Switch(header,lb,decls,cases,rb) ->
412 multibind [rule_elem header;rule_elem lb;
413 statement_dots decls;
414 multibind (List.map case_line cases);
415 rule_elem rb]
416 | Ast.Atomic(re) -> rule_elem re
417 | Ast.Disj(stmt_dots_list) ->
418 multibind (List.map statement_dots stmt_dots_list)
419 | Ast.Nest(starter,stmt_dots,ender,whn,_,_,_) ->
420 bind (string_mcode starter)
421 (bind (statement_dots stmt_dots)
422 (bind (string_mcode ender)
423 (multibind
424 (List.map (whencode statement_dots statement) whn))))
425 | Ast.FunDecl(header,lbrace,body,rbrace) ->
426 multibind [rule_elem header; rule_elem lbrace;
427 statement_dots body; rule_elem rbrace]
428 | Ast.Define(header,body) ->
429 bind (rule_elem header) (statement_dots body)
430 | Ast.Dots(d,whn,_,_) | Ast.Circles(d,whn,_,_) | Ast.Stars(d,whn,_,_) ->
431 bind (string_mcode d)
432 (multibind (List.map (whencode statement_dots statement) whn))
433 | Ast.OptStm(stmt) | Ast.UniqueStm(stmt) ->
434 statement stmt in
435 stmtfn all_functions k s
436
437 and fninfo = function
438 Ast.FStorage(stg) -> storage_mcode stg
439 | Ast.FType(ty) -> fullType ty
440 | Ast.FInline(inline) -> string_mcode inline
441 | Ast.FAttr(attr) -> string_mcode attr
442
443 and whencode notfn alwaysfn = function
444 Ast.WhenNot a -> notfn a
445 | Ast.WhenAlways a -> alwaysfn a
446 | Ast.WhenModifier(_) -> option_default
447 | Ast.WhenNotTrue(e) -> rule_elem e
448 | Ast.WhenNotFalse(e) -> rule_elem e
449
450 and case_line c =
451 let k c =
452 match Ast.unwrap c with
453 Ast.CaseLine(header,code) ->
454 bind (rule_elem header) (statement_dots code)
455 | Ast.OptCase(case) -> case_line case in
456 casefn all_functions k c
457
458 and top_level t =
459 let k t =
460 match Ast.unwrap t with
461 Ast.FILEINFO(old_file,new_file) ->
462 bind (string_mcode old_file) (string_mcode new_file)
463 | Ast.DECL(stmt) -> statement stmt
464 | Ast.CODE(stmt_dots) -> statement_dots stmt_dots
465 | Ast.ERRORWORDS(exps) -> multibind (List.map expression exps) in
466 topfn all_functions k t
467
468 and anything a =
469 let k = function
470 (*in many cases below, the thing is not even mcode, so we do nothing*)
471 Ast.FullTypeTag(ft) -> fullType ft
472 | Ast.BaseTypeTag(bt) -> option_default
473 | Ast.StructUnionTag(su) -> option_default
474 | Ast.SignTag(sgn) -> option_default
475 | Ast.IdentTag(id) -> ident id
476 | Ast.ExpressionTag(exp) -> expression exp
477 | Ast.ConstantTag(cst) -> option_default
478 | Ast.UnaryOpTag(unop) -> option_default
479 | Ast.AssignOpTag(asgnop) -> option_default
480 | Ast.FixOpTag(fixop) -> option_default
481 | Ast.BinaryOpTag(binop) -> option_default
482 | Ast.ArithOpTag(arithop) -> option_default
483 | Ast.LogicalOpTag(logop) -> option_default
484 | Ast.DeclarationTag(decl) -> declaration decl
485 | Ast.InitTag(ini) -> initialiser ini
486 | Ast.StorageTag(stg) -> option_default
487 | Ast.IncFileTag(stg) -> option_default
488 | Ast.Rule_elemTag(rule) -> rule_elem rule
489 | Ast.StatementTag(rule) -> statement rule
490 | Ast.CaseLineTag(case) -> case_line case
491 | Ast.ConstVolTag(cv) -> option_default
492 | Ast.Token(tok,info) -> option_default
493 | Ast.Pragma(str) -> option_default
494 | Ast.Code(cd) -> top_level cd
495 | Ast.ExprDotsTag(ed) -> expression_dots ed
496 | Ast.ParamDotsTag(pd) -> parameter_dots pd
497 | Ast.StmtDotsTag(sd) -> statement_dots sd
498 | Ast.DeclDotsTag(sd) -> declaration_dots sd
499 | Ast.TypeCTag(ty) -> typeC ty
500 | Ast.ParamTag(param) -> parameterTypeDef param
501 | Ast.SgrepStartTag(tok) -> option_default
502 | Ast.SgrepEndTag(tok) -> option_default in
503 anyfn all_functions k a
504
505 and all_functions =
506 {combiner_ident = ident;
507 combiner_expression = expression;
508 combiner_fullType = fullType;
509 combiner_typeC = typeC;
510 combiner_declaration = declaration;
511 combiner_initialiser = initialiser;
512 combiner_parameter = parameterTypeDef;
513 combiner_parameter_list = parameter_dots;
514 combiner_rule_elem = rule_elem;
515 combiner_statement = statement;
516 combiner_case_line = case_line;
517 combiner_top_level = top_level;
518 combiner_anything = anything;
519 combiner_expression_dots = expression_dots;
520 combiner_statement_dots = statement_dots;
521 combiner_declaration_dots = declaration_dots;
522 combiner_initialiser_dots = initialiser_dots} in
523 all_functions
524
525 (* ---------------------------------------------------------------------- *)
526
527 type 'a inout = 'a -> 'a (* for specifying the type of rebuilder *)
528
529 type rebuilder =
530 {rebuilder_ident : Ast.ident inout;
531 rebuilder_expression : Ast.expression inout;
532 rebuilder_fullType : Ast.fullType inout;
533 rebuilder_typeC : Ast.typeC inout;
534 rebuilder_declaration : Ast.declaration inout;
535 rebuilder_initialiser : Ast.initialiser inout;
536 rebuilder_parameter : Ast.parameterTypeDef inout;
537 rebuilder_parameter_list : Ast.parameter_list inout;
538 rebuilder_statement : Ast.statement inout;
539 rebuilder_case_line : Ast.case_line inout;
540 rebuilder_rule_elem : Ast.rule_elem inout;
541 rebuilder_top_level : Ast.top_level inout;
542 rebuilder_expression_dots : Ast.expression Ast.dots inout;
543 rebuilder_statement_dots : Ast.statement Ast.dots inout;
544 rebuilder_declaration_dots : Ast.declaration Ast.dots inout;
545 rebuilder_initialiser_dots : Ast.initialiser Ast.dots inout;
546 rebuilder_define_param_dots : Ast.define_param Ast.dots inout;
547 rebuilder_define_param : Ast.define_param inout;
548 rebuilder_define_parameters : Ast.define_parameters inout;
549 rebuilder_anything : Ast.anything inout}
550
551 type 'mc rmcode = 'mc Ast.mcode inout
552 type 'cd rcode = rebuilder -> ('cd inout) -> 'cd inout
553
554
555 let rebuilder
556 meta_mcode string_mcode const_mcode assign_mcode fix_mcode unary_mcode
557 binary_mcode cv_mcode sign_mcode struct_mcode storage_mcode
558 inc_file_mcode
559 expdotsfn paramdotsfn stmtdotsfn decldotsfn initdotsfn
560 identfn exprfn ftfn tyfn initfn paramfn declfn rulefn stmtfn casefn
561 topfn anyfn =
562 let get_option f = function
563 Some x -> Some (f x)
564 | None -> None in
565
566 let dotsfn param default all_functions arg =
567 let k d =
568 Ast.rewrap d
569 (match Ast.unwrap d with
570 Ast.DOTS(l) -> Ast.DOTS(List.map default l)
571 | Ast.CIRCLES(l) -> Ast.CIRCLES(List.map default l)
572 | Ast.STARS(l) -> Ast.STARS(List.map default l)) in
573 param all_functions k arg in
574
575 let rec expression_dots d = dotsfn expdotsfn expression all_functions d
576 and parameter_dots d = dotsfn paramdotsfn parameterTypeDef all_functions d
577 and statement_dots d = dotsfn stmtdotsfn statement all_functions d
578 and declaration_dots d = dotsfn decldotsfn declaration all_functions d
579 and initialiser_dots d = dotsfn initdotsfn initialiser all_functions d
580
581 and ident i =
582 let k i =
583 Ast.rewrap i
584 (match Ast.unwrap i with
585 Ast.Id(name) -> Ast.Id(string_mcode name)
586 | Ast.MetaId(name,constraints,keep,inherited) ->
587 Ast.MetaId(meta_mcode name,constraints,keep,inherited)
588 | Ast.MetaFunc(name,constraints,keep,inherited) ->
589 Ast.MetaFunc(meta_mcode name,constraints,keep,inherited)
590 | Ast.MetaLocalFunc(name,constraints,keep,inherited) ->
591 Ast.MetaLocalFunc(meta_mcode name,constraints,keep,inherited)
592 | Ast.DisjId(id_list) -> Ast.DisjId(List.map ident id_list)
593 | Ast.OptIdent(id) -> Ast.OptIdent(ident id)
594 | Ast.UniqueIdent(id) -> Ast.UniqueIdent(ident id)) in
595 identfn all_functions k i
596
597 and expression e =
598 let k e =
599 Ast.rewrap e
600 (match Ast.unwrap e with
601 Ast.Ident(id) -> Ast.Ident(ident id)
602 | Ast.Constant(const) -> Ast.Constant(const_mcode const)
603 | Ast.FunCall(fn,lp,args,rp) ->
604 Ast.FunCall(expression fn, string_mcode lp, expression_dots args,
605 string_mcode rp)
606 | Ast.Assignment(left,op,right,simple) ->
607 Ast.Assignment(expression left, assign_mcode op, expression right,
608 simple)
609 | Ast.CondExpr(exp1,why,exp2,colon,exp3) ->
610 Ast.CondExpr(expression exp1, string_mcode why,
611 get_option expression exp2, string_mcode colon,
612 expression exp3)
613 | Ast.Postfix(exp,op) -> Ast.Postfix(expression exp,fix_mcode op)
614 | Ast.Infix(exp,op) -> Ast.Infix(expression exp,fix_mcode op)
615 | Ast.Unary(exp,op) -> Ast.Unary(expression exp,unary_mcode op)
616 | Ast.Binary(left,op,right) ->
617 Ast.Binary(expression left, binary_mcode op, expression right)
618 | Ast.Nested(left,op,right) ->
619 Ast.Nested(expression left, binary_mcode op, expression right)
620 | Ast.Paren(lp,exp,rp) ->
621 Ast.Paren(string_mcode lp, expression exp, string_mcode rp)
622 | Ast.ArrayAccess(exp1,lb,exp2,rb) ->
623 Ast.ArrayAccess(expression exp1, string_mcode lb, expression exp2,
624 string_mcode rb)
625 | Ast.RecordAccess(exp,pt,field) ->
626 Ast.RecordAccess(expression exp, string_mcode pt, ident field)
627 | Ast.RecordPtAccess(exp,ar,field) ->
628 Ast.RecordPtAccess(expression exp, string_mcode ar, ident field)
629 | Ast.Cast(lp,ty,rp,exp) ->
630 Ast.Cast(string_mcode lp, fullType ty, string_mcode rp,
631 expression exp)
632 | Ast.SizeOfExpr(szf,exp) ->
633 Ast.SizeOfExpr(string_mcode szf, expression exp)
634 | Ast.SizeOfType(szf,lp,ty,rp) ->
635 Ast.SizeOfType(string_mcode szf,string_mcode lp, fullType ty,
636 string_mcode rp)
637 | Ast.TypeExp(ty) -> Ast.TypeExp(fullType ty)
638 | Ast.MetaErr(name,constraints,keep,inherited) ->
639 Ast.MetaErr(meta_mcode name,constraints,keep,inherited)
640 | Ast.MetaExpr(name,constraints,keep,ty,form,inherited) ->
641 Ast.MetaExpr(meta_mcode name,constraints,keep,ty,form,inherited)
642 | Ast.MetaExprList(name,lenname_inh,keep,inherited) ->
643 Ast.MetaExprList(meta_mcode name,lenname_inh,keep,inherited)
644 | Ast.EComma(cm) -> Ast.EComma(string_mcode cm)
645 | Ast.DisjExpr(exp_list) -> Ast.DisjExpr(List.map expression exp_list)
646 | Ast.NestExpr(starter,expr_dots,ender,whencode,multi) ->
647 Ast.NestExpr(string_mcode starter,expression_dots expr_dots,
648 string_mcode ender,
649 get_option expression whencode,multi)
650 | Ast.Edots(dots,whencode) ->
651 Ast.Edots(string_mcode dots,get_option expression whencode)
652 | Ast.Ecircles(dots,whencode) ->
653 Ast.Ecircles(string_mcode dots,get_option expression whencode)
654 | Ast.Estars(dots,whencode) ->
655 Ast.Estars(string_mcode dots,get_option expression whencode)
656 | Ast.OptExp(exp) -> Ast.OptExp(expression exp)
657 | Ast.UniqueExp(exp) -> Ast.UniqueExp(expression exp)) in
658 exprfn all_functions k e
659
660 and fullType ft =
661 let k ft =
662 Ast.rewrap ft
663 (match Ast.unwrap ft with
664 Ast.Type(cv,ty) -> Ast.Type (get_option cv_mcode cv, typeC ty)
665 | Ast.DisjType(types) -> Ast.DisjType(List.map fullType types)
666 | Ast.OptType(ty) -> Ast.OptType(fullType ty)
667 | Ast.UniqueType(ty) -> Ast.UniqueType(fullType ty)) in
668 ftfn all_functions k ft
669
670 and typeC ty =
671 let k ty =
672 Ast.rewrap ty
673 (match Ast.unwrap ty with
674 Ast.BaseType(ty,strings) ->
675 Ast.BaseType (ty, List.map string_mcode strings)
676 | Ast.SignedT(sgn,ty) ->
677 Ast.SignedT(sign_mcode sgn,get_option typeC ty)
678 | Ast.Pointer(ty,star) ->
679 Ast.Pointer (fullType ty, string_mcode star)
680 | Ast.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
681 Ast.FunctionPointer(fullType ty,string_mcode lp1,string_mcode star,
682 string_mcode rp1,string_mcode lp2,
683 parameter_dots params,
684 string_mcode rp2)
685 | Ast.FunctionType(allminus,ty,lp,params,rp) ->
686 Ast.FunctionType(allminus,get_option fullType ty,string_mcode lp,
687 parameter_dots params,string_mcode rp)
688 | Ast.Array(ty,lb,size,rb) ->
689 Ast.Array(fullType ty, string_mcode lb,
690 get_option expression size, string_mcode rb)
691 | Ast.EnumName(kind,name) ->
692 Ast.EnumName(string_mcode kind, get_option ident name)
693 | Ast.EnumDef(ty,lb,ids,rb) ->
694 Ast.EnumDef (fullType ty, string_mcode lb, expression_dots ids,
695 string_mcode rb)
696 | Ast.StructUnionName(kind,name) ->
697 Ast.StructUnionName (struct_mcode kind, get_option ident name)
698 | Ast.StructUnionDef(ty,lb,decls,rb) ->
699 Ast.StructUnionDef (fullType ty,
700 string_mcode lb, declaration_dots decls,
701 string_mcode rb)
702 | Ast.TypeName(name) -> Ast.TypeName(string_mcode name)
703 | Ast.MetaType(name,keep,inherited) ->
704 Ast.MetaType(meta_mcode name,keep,inherited)) in
705 tyfn all_functions k ty
706
707 and declaration d =
708 let k d =
709 Ast.rewrap d
710 (match Ast.unwrap d with
711 Ast.MetaDecl(name,keep,inherited) ->
712 Ast.MetaDecl(meta_mcode name,keep,inherited)
713 | Ast.MetaField(name,keep,inherited) ->
714 Ast.MetaField(meta_mcode name,keep,inherited)
715 | Ast.MetaFieldList(name,lenname_inh,keep,inherited) ->
716 Ast.MetaFieldList(meta_mcode name,lenname_inh,keep,inherited)
717 | Ast.Init(stg,ty,id,eq,ini,sem) ->
718 Ast.Init(get_option storage_mcode stg, fullType ty, ident id,
719 string_mcode eq, initialiser ini, string_mcode sem)
720 | Ast.UnInit(stg,ty,id,sem) ->
721 Ast.UnInit(get_option storage_mcode stg, fullType ty, ident id,
722 string_mcode sem)
723 | Ast.MacroDecl(name,lp,args,rp,sem) ->
724 Ast.MacroDecl(ident name, string_mcode lp, expression_dots args,
725 string_mcode rp,string_mcode sem)
726 | Ast.TyDecl(ty,sem) -> Ast.TyDecl(fullType ty, string_mcode sem)
727 | Ast.Typedef(stg,ty,id,sem) ->
728 Ast.Typedef(string_mcode stg, fullType ty, typeC id,
729 string_mcode sem)
730 | Ast.DisjDecl(decls) -> Ast.DisjDecl(List.map declaration decls)
731 | Ast.Ddots(dots,whencode) ->
732 Ast.Ddots(string_mcode dots, get_option declaration whencode)
733 | Ast.OptDecl(decl) -> Ast.OptDecl(declaration decl)
734 | Ast.UniqueDecl(decl) -> Ast.UniqueDecl(declaration decl)) in
735 declfn all_functions k d
736
737 and initialiser i =
738 let k i =
739 Ast.rewrap i
740 (match Ast.unwrap i with
741 Ast.MetaInit(name,keep,inherited) ->
742 Ast.MetaInit(meta_mcode name,keep,inherited)
743 | Ast.InitExpr(exp) -> Ast.InitExpr(expression exp)
744 | Ast.ArInitList(lb,initlist,rb) ->
745 Ast.ArInitList(string_mcode lb, initialiser_dots initlist,
746 string_mcode rb)
747 | Ast.StrInitList(allminus,lb,initlist,rb,whencode) ->
748 Ast.StrInitList(allminus,
749 string_mcode lb, List.map initialiser initlist,
750 string_mcode rb, List.map initialiser whencode)
751 | Ast.InitGccName(name,eq,ini) ->
752 Ast.InitGccName(ident name, string_mcode eq, initialiser ini)
753 | Ast.InitGccExt(designators,eq,ini) ->
754 Ast.InitGccExt
755 (List.map designator designators, string_mcode eq,
756 initialiser ini)
757 | Ast.IComma(cm) -> Ast.IComma(string_mcode cm)
758 | Ast.Idots(dots,whencode) ->
759 Ast.Idots(string_mcode dots,get_option initialiser whencode)
760 | Ast.OptIni(i) -> Ast.OptIni(initialiser i)
761 | Ast.UniqueIni(i) -> Ast.UniqueIni(initialiser i)) in
762 initfn all_functions k i
763
764 and designator = function
765 Ast.DesignatorField(dot,id) ->
766 Ast.DesignatorField(string_mcode dot,ident id)
767 | Ast.DesignatorIndex(lb,exp,rb) ->
768 Ast.DesignatorIndex(string_mcode lb,expression exp,string_mcode rb)
769 | Ast.DesignatorRange(lb,min,dots,max,rb) ->
770 Ast.DesignatorRange(string_mcode lb,expression min,string_mcode dots,
771 expression max,string_mcode rb)
772
773 and parameterTypeDef p =
774 let k p =
775 Ast.rewrap p
776 (match Ast.unwrap p with
777 Ast.VoidParam(ty) -> Ast.VoidParam(fullType ty)
778 | Ast.Param(ty,id) -> Ast.Param(fullType ty, get_option ident id)
779 | Ast.MetaParam(name,keep,inherited) ->
780 Ast.MetaParam(meta_mcode name,keep,inherited)
781 | Ast.MetaParamList(name,lenname_inh,keep,inherited) ->
782 Ast.MetaParamList(meta_mcode name,lenname_inh,keep,inherited)
783 | Ast.PComma(cm) -> Ast.PComma(string_mcode cm)
784 | Ast.Pdots(dots) -> Ast.Pdots(string_mcode dots)
785 | Ast.Pcircles(dots) -> Ast.Pcircles(string_mcode dots)
786 | Ast.OptParam(param) -> Ast.OptParam(parameterTypeDef param)
787 | Ast.UniqueParam(param) -> Ast.UniqueParam(parameterTypeDef param)) in
788 paramfn all_functions k p
789
790 and rule_elem re =
791 let k re =
792 Ast.rewrap re
793 (match Ast.unwrap re with
794 Ast.FunHeader(bef,allminus,fi,name,lp,params,rp) ->
795 Ast.FunHeader(bef,allminus,List.map fninfo fi,ident name,
796 string_mcode lp, parameter_dots params,
797 string_mcode rp)
798 | Ast.Decl(bef,allminus,decl) ->
799 Ast.Decl(bef,allminus,declaration decl)
800 | Ast.SeqStart(brace) -> Ast.SeqStart(string_mcode brace)
801 | Ast.SeqEnd(brace) -> Ast.SeqEnd(string_mcode brace)
802 | Ast.ExprStatement(exp,sem) ->
803 Ast.ExprStatement (expression exp, string_mcode sem)
804 | Ast.IfHeader(iff,lp,exp,rp) ->
805 Ast.IfHeader(string_mcode iff, string_mcode lp, expression exp,
806 string_mcode rp)
807 | Ast.Else(els) -> Ast.Else(string_mcode els)
808 | Ast.WhileHeader(whl,lp,exp,rp) ->
809 Ast.WhileHeader(string_mcode whl, string_mcode lp, expression exp,
810 string_mcode rp)
811 | Ast.DoHeader(d) -> Ast.DoHeader(string_mcode d)
812 | Ast.WhileTail(whl,lp,exp,rp,sem) ->
813 Ast.WhileTail(string_mcode whl, string_mcode lp, expression exp,
814 string_mcode rp, string_mcode sem)
815 | Ast.ForHeader(fr,lp,e1,sem1,e2,sem2,e3,rp) ->
816 Ast.ForHeader(string_mcode fr, string_mcode lp,
817 get_option expression e1, string_mcode sem1,
818 get_option expression e2, string_mcode sem2,
819 get_option expression e3, string_mcode rp)
820 | Ast.IteratorHeader(whl,lp,args,rp) ->
821 Ast.IteratorHeader(ident whl, string_mcode lp,
822 expression_dots args, string_mcode rp)
823 | Ast.SwitchHeader(switch,lp,exp,rp) ->
824 Ast.SwitchHeader(string_mcode switch, string_mcode lp,
825 expression exp, string_mcode rp)
826 | Ast.Break(br,sem) ->
827 Ast.Break(string_mcode br, string_mcode sem)
828 | Ast.Continue(cont,sem) ->
829 Ast.Continue(string_mcode cont, string_mcode sem)
830 | Ast.Label(l,dd) -> Ast.Label(ident l, string_mcode dd)
831 | Ast.Goto(goto,l,sem) ->
832 Ast.Goto(string_mcode goto,ident l,string_mcode sem)
833 | Ast.Return(ret,sem) ->
834 Ast.Return(string_mcode ret, string_mcode sem)
835 | Ast.ReturnExpr(ret,exp,sem) ->
836 Ast.ReturnExpr(string_mcode ret, expression exp, string_mcode sem)
837 | Ast.MetaStmt(name,keep,seqible,inherited) ->
838 Ast.MetaStmt(meta_mcode name,keep,seqible,inherited)
839 | Ast.MetaStmtList(name,keep,inherited) ->
840 Ast.MetaStmtList(meta_mcode name,keep,inherited)
841 | Ast.MetaRuleElem(name,keep,inherited) ->
842 Ast.MetaRuleElem(meta_mcode name,keep,inherited)
843 | Ast.Exp(exp) -> Ast.Exp(expression exp)
844 | Ast.TopExp(exp) -> Ast.TopExp(expression exp)
845 | Ast.Ty(ty) -> Ast.Ty(fullType ty)
846 | Ast.TopInit(init) -> Ast.TopInit(initialiser init)
847 | Ast.Include(inc,name) ->
848 Ast.Include(string_mcode inc,inc_file_mcode name)
849 | Ast.Undef(def,id) ->
850 Ast.Undef(string_mcode def,ident id)
851 | Ast.DefineHeader(def,id,params) ->
852 Ast.DefineHeader(string_mcode def,ident id,
853 define_parameters params)
854 | Ast.Default(def,colon) ->
855 Ast.Default(string_mcode def,string_mcode colon)
856 | Ast.Case(case,exp,colon) ->
857 Ast.Case(string_mcode case,expression exp,string_mcode colon)
858 | Ast.DisjRuleElem(res) -> Ast.DisjRuleElem(List.map rule_elem res)) in
859 rulefn all_functions k re
860
861 (* not parameterizable for now... *)
862 and define_parameters p =
863 let k p =
864 Ast.rewrap p
865 (match Ast.unwrap p with
866 Ast.NoParams -> Ast.NoParams
867 | Ast.DParams(lp,params,rp) ->
868 Ast.DParams(string_mcode lp,define_param_dots params,
869 string_mcode rp)) in
870 k p
871
872 and define_param_dots d =
873 let k d =
874 Ast.rewrap d
875 (match Ast.unwrap d with
876 Ast.DOTS(l) -> Ast.DOTS(List.map define_param l)
877 | Ast.CIRCLES(l) -> Ast.CIRCLES(List.map define_param l)
878 | Ast.STARS(l) -> Ast.STARS(List.map define_param l)) in
879 k d
880
881 and define_param p =
882 let k p =
883 Ast.rewrap p
884 (match Ast.unwrap p with
885 Ast.DParam(id) -> Ast.DParam(ident id)
886 | Ast.DPComma(comma) -> Ast.DPComma(string_mcode comma)
887 | Ast.DPdots(d) -> Ast.DPdots(string_mcode d)
888 | Ast.DPcircles(c) -> Ast.DPcircles(string_mcode c)
889 | Ast.OptDParam(dp) -> Ast.OptDParam(define_param dp)
890 | Ast.UniqueDParam(dp) -> Ast.UniqueDParam(define_param dp)) in
891 k p
892
893 and process_bef_aft s =
894 Ast.set_dots_bef_aft
895 (match Ast.get_dots_bef_aft s with
896 Ast.NoDots -> Ast.NoDots
897 | Ast.DroppingBetweenDots(stm,ind) ->
898 Ast.DroppingBetweenDots(statement stm,ind)
899 | Ast.AddingBetweenDots(stm,ind) ->
900 Ast.AddingBetweenDots(statement stm,ind))
901 s
902
903 and statement s =
904 let k s =
905 Ast.rewrap s
906 (match Ast.unwrap s with
907 Ast.Seq(lbrace,body,rbrace) ->
908 Ast.Seq(rule_elem lbrace,
909 statement_dots body, rule_elem rbrace)
910 | Ast.IfThen(header,branch,aft) ->
911 Ast.IfThen(rule_elem header, statement branch,aft)
912 | Ast.IfThenElse(header,branch1,els,branch2,aft) ->
913 Ast.IfThenElse(rule_elem header, statement branch1, rule_elem els,
914 statement branch2, aft)
915 | Ast.While(header,body,aft) ->
916 Ast.While(rule_elem header, statement body, aft)
917 | Ast.Do(header,body,tail) ->
918 Ast.Do(rule_elem header, statement body, rule_elem tail)
919 | Ast.For(header,body,aft) ->
920 Ast.For(rule_elem header, statement body, aft)
921 | Ast.Iterator(header,body,aft) ->
922 Ast.Iterator(rule_elem header, statement body, aft)
923 | Ast.Switch(header,lb,decls,cases,rb) ->
924 Ast.Switch(rule_elem header,rule_elem lb,
925 statement_dots decls,
926 List.map case_line cases,rule_elem rb)
927 | Ast.Atomic(re) -> Ast.Atomic(rule_elem re)
928 | Ast.Disj(stmt_dots_list) ->
929 Ast.Disj (List.map statement_dots stmt_dots_list)
930 | Ast.Nest(starter,stmt_dots,ender,whn,multi,bef,aft) ->
931 Ast.Nest(string_mcode starter,statement_dots stmt_dots,
932 string_mcode ender,
933 List.map (whencode statement_dots statement) whn,
934 multi,bef,aft)
935 | Ast.FunDecl(header,lbrace,body,rbrace) ->
936 Ast.FunDecl(rule_elem header,rule_elem lbrace,
937 statement_dots body, rule_elem rbrace)
938 | Ast.Define(header,body) ->
939 Ast.Define(rule_elem header,statement_dots body)
940 | Ast.Dots(d,whn,bef,aft) ->
941 Ast.Dots(string_mcode d,
942 List.map (whencode statement_dots statement) whn,bef,aft)
943 | Ast.Circles(d,whn,bef,aft) ->
944 Ast.Circles(string_mcode d,
945 List.map (whencode statement_dots statement) whn,
946 bef,aft)
947 | Ast.Stars(d,whn,bef,aft) ->
948 Ast.Stars(string_mcode d,
949 List.map (whencode statement_dots statement) whn,bef,aft)
950 | Ast.OptStm(stmt) -> Ast.OptStm(statement stmt)
951 | Ast.UniqueStm(stmt) -> Ast.UniqueStm(statement stmt)) in
952 let s = stmtfn all_functions k s in
953 (* better to do this after, in case there is an equality test on the whole
954 statement, eg in free_vars. equality test would require that this
955 subterm not already be changed *)
956 process_bef_aft s
957
958 and fninfo = function
959 Ast.FStorage(stg) -> Ast.FStorage(storage_mcode stg)
960 | Ast.FType(ty) -> Ast.FType(fullType ty)
961 | Ast.FInline(inline) -> Ast.FInline(string_mcode inline)
962 | Ast.FAttr(attr) -> Ast.FAttr(string_mcode attr)
963
964 and whencode notfn alwaysfn = function
965 Ast.WhenNot a -> Ast.WhenNot (notfn a)
966 | Ast.WhenAlways a -> Ast.WhenAlways (alwaysfn a)
967 | Ast.WhenModifier(x) -> Ast.WhenModifier(x)
968 | Ast.WhenNotTrue(e) -> Ast.WhenNotTrue(rule_elem e)
969 | Ast.WhenNotFalse(e) -> Ast.WhenNotFalse(rule_elem e)
970
971 and case_line c =
972 let k c =
973 Ast.rewrap c
974 (match Ast.unwrap c with
975 Ast.CaseLine(header,code) ->
976 Ast.CaseLine(rule_elem header,statement_dots code)
977 | Ast.OptCase(case) -> Ast.OptCase(case_line case)) in
978 casefn all_functions k c
979
980 and top_level t =
981 let k t =
982 Ast.rewrap t
983 (match Ast.unwrap t with
984 Ast.FILEINFO(old_file,new_file) ->
985 Ast.FILEINFO (string_mcode old_file, string_mcode new_file)
986 | Ast.DECL(stmt) -> Ast.DECL(statement stmt)
987 | Ast.CODE(stmt_dots) -> Ast.CODE(statement_dots stmt_dots)
988 | Ast.ERRORWORDS(exps) -> Ast.ERRORWORDS (List.map expression exps)) in
989 topfn all_functions k t
990
991 and anything a =
992 let k = function
993 (*in many cases below, the thing is not even mcode, so we do nothing*)
994 Ast.FullTypeTag(ft) -> Ast.FullTypeTag(fullType ft)
995 | Ast.BaseTypeTag(bt) as x -> x
996 | Ast.StructUnionTag(su) as x -> x
997 | Ast.SignTag(sgn) as x -> x
998 | Ast.IdentTag(id) -> Ast.IdentTag(ident id)
999 | Ast.ExpressionTag(exp) -> Ast.ExpressionTag(expression exp)
1000 | Ast.ConstantTag(cst) as x -> x
1001 | Ast.UnaryOpTag(unop) as x -> x
1002 | Ast.AssignOpTag(asgnop) as x -> x
1003 | Ast.FixOpTag(fixop) as x -> x
1004 | Ast.BinaryOpTag(binop) as x -> x
1005 | Ast.ArithOpTag(arithop) as x -> x
1006 | Ast.LogicalOpTag(logop) as x -> x
1007 | Ast.InitTag(decl) -> Ast.InitTag(initialiser decl)
1008 | Ast.DeclarationTag(decl) -> Ast.DeclarationTag(declaration decl)
1009 | Ast.StorageTag(stg) as x -> x
1010 | Ast.IncFileTag(stg) as x -> x
1011 | Ast.Rule_elemTag(rule) -> Ast.Rule_elemTag(rule_elem rule)
1012 | Ast.StatementTag(rule) -> Ast.StatementTag(statement rule)
1013 | Ast.CaseLineTag(case) -> Ast.CaseLineTag(case_line case)
1014 | Ast.ConstVolTag(cv) as x -> x
1015 | Ast.Token(tok,info) as x -> x
1016 | Ast.Pragma(str) as x -> x
1017 | Ast.Code(cd) -> Ast.Code(top_level cd)
1018 | Ast.ExprDotsTag(ed) -> Ast.ExprDotsTag(expression_dots ed)
1019 | Ast.ParamDotsTag(pd) -> Ast.ParamDotsTag(parameter_dots pd)
1020 | Ast.StmtDotsTag(sd) -> Ast.StmtDotsTag(statement_dots sd)
1021 | Ast.DeclDotsTag(sd) -> Ast.DeclDotsTag(declaration_dots sd)
1022 | Ast.TypeCTag(ty) -> Ast.TypeCTag(typeC ty)
1023 | Ast.ParamTag(param) -> Ast.ParamTag(parameterTypeDef param)
1024 | Ast.SgrepStartTag(tok) as x -> x
1025 | Ast.SgrepEndTag(tok) as x -> x in
1026 anyfn all_functions k a
1027
1028 and all_functions =
1029 {rebuilder_ident = ident;
1030 rebuilder_expression = expression;
1031 rebuilder_fullType = fullType;
1032 rebuilder_typeC = typeC;
1033 rebuilder_declaration = declaration;
1034 rebuilder_initialiser = initialiser;
1035 rebuilder_parameter = parameterTypeDef;
1036 rebuilder_parameter_list = parameter_dots;
1037 rebuilder_rule_elem = rule_elem;
1038 rebuilder_statement = statement;
1039 rebuilder_case_line = case_line;
1040 rebuilder_top_level = top_level;
1041 rebuilder_expression_dots = expression_dots;
1042 rebuilder_statement_dots = statement_dots;
1043 rebuilder_declaration_dots = declaration_dots;
1044 rebuilder_initialiser_dots = initialiser_dots;
1045 rebuilder_define_param_dots = define_param_dots;
1046 rebuilder_define_param = define_param;
1047 rebuilder_define_parameters = define_parameters;
1048 rebuilder_anything = anything} in
1049 all_functions
1050