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