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