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