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