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.
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.
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.
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/>.
22 * The authors reserve the right to distribute this or future versions of
23 * Coccinelle under other licenses.
27 #
0 "./visitor_ast.ml"
28 module Ast0
= Ast0_cocci
29 module Ast
= Ast_cocci
31 (* --------------------------------------------------------------------- *)
32 (* Generic traversal: combiner *)
35 treatment of: mcode, identifiers, expressions, fullTypes, types,
36 declarations, statements, toplevels
37 default value for options *)
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
}
58 type ('mc
,'a
) cmcode
= 'a combiner
-> 'mc
Ast_cocci.mcode
-> 'a
59 type ('cd
,'a
) ccode
= 'a combiner
-> ('cd
-> 'a
) -> 'cd
-> 'a
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
67 expdotsfn paramdotsfn stmtdotsfn decldotsfn initdotsfn
68 identfn exprfn ftfn tyfn initfn paramfn declfn rulefn stmtfn casefn
71 let rec loop = function
74 | x
::xs
-> bind x
(loop xs
) in
76 let get_option f
= function
78 | None
-> option_default
in
80 let dotsfn param default all_functions arg
=
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
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
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
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
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
;
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
;
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
) ->
146 [expression exp1
; string_mcode lb
; expression exp2
;
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
) ->
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
) ->
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
) ->
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
) ->
180 exprfn all_functions
k e
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
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 *)
195 ([fullType ty
; string_mcode lp1
; string_mcode star
] @ extra
@
197 string_mcode lp2
; parameter_dots params
; string_mcode rp2
])
199 and function_type
(ty
,lp1
,params
,rp1
) extra
=
200 (* have to put the treatment of the identifier into the right position *)
202 ([get_option fullType ty
] @ extra
@
203 [string_mcode lp1
; parameter_dots params
; string_mcode rp1
])
205 and array_type
(ty
,lb
,size
,rb
) extra
=
207 ([fullType ty
] @ extra
@
208 [string_mcode lb
; get_option expression size
; string_mcode rb
])
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
) ->
226 [fullType ty
; string_mcode lb
; expression_dots ids
;
228 | Ast.StructUnionName
(kind
,name
) ->
229 bind
(struct_mcode kind
) (get_option ident name
)
230 | Ast.StructUnionDef
(ty
,lb
,decls
,rb
) ->
232 [fullType ty
; string_mcode lb
; declaration_dots decls
;
234 | Ast.TypeName
(name
) -> string_mcode name
235 | Ast.MetaType
(name
,_
,_
) -> meta_mcode name
in
236 tyfn all_functions
k ty
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
)
252 match Ast.unwrap d
with
253 Ast.MetaDecl
(name
,_
,_
) | Ast.MetaField
(name
,_
,_
)
254 | Ast.MetaFieldList
(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
)
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
) ->
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
) ->
272 [ident name
; string_mcode lp
; expression_dots args
;
273 string_mcode rp
; string_mcode eq
; initialiser ini
;
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
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
) ->
296 [string_mcode lb
; initialiser_dots initlist
; string_mcode rb
]
297 | Ast.StrInitList
(allminus
,lb
,initlist
,rb
,whencode
) ->
300 multibind (List.map initialiser initlist
);
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
) ->
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
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
) ->
322 [string_mcode lb
; expression min
; string_mcode dots
;
323 expression max
; string_mcode rb
]
325 and parameterTypeDef 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
343 match Ast.unwrap re
with
344 Ast.FunHeader
(_
,_
,fi
,name
,lp
,params
,rp
) ->
346 ((List.map fninfo fi
) @
347 [ident name
;string_mcode lp
;parameter_dots params
;
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
;
357 | Ast.Else
(els
) -> string_mcode els
358 | Ast.WhileHeader
(whl
,lp
,exp
,rp
) ->
359 multibind [string_mcode whl
; string_mcode lp
; expression exp
;
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
;
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
402 (* not parameterisable, for now *)
405 Ast.ForExp
(e1
,sem1
) ->
406 bind
(get_option expression e1
) (string_mcode sem1
)
407 | Ast.ForDecl
(_
,_
,decl
) -> declaration decl
in
410 (* not parameterizable for now... *)
411 and define_parameters p
=
413 match Ast.unwrap p
with
414 Ast.NoParams
-> option_default
415 | Ast.DParams
(lp
,params
,rp
) ->
417 [string_mcode lp
; define_param_dots params
; string_mcode rp
] in
420 and define_param_dots 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
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
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
443 | Ast.DroppingBetweenDots
(stm
,ind
) -> let _ = statement stm
in ()
444 | Ast.AddingBetweenDots
(stm
,ind
) -> let _ = statement stm
in ()
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
;
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
);
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
)
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
) ->
491 stmtfn all_functions
k s
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
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
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
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
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
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
582 (* ---------------------------------------------------------------------- *)
584 type 'a inout
= 'a
-> 'a
(* for specifying the type of 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
}
608 type 'mc rmcode
= 'mc
Ast.mcode inout
609 type 'cd rcode
= rebuilder
-> ('cd inout
) -> 'cd inout
613 meta_mcode string_mcode const_mcode assign_mcode fix_mcode unary_mcode
614 binary_mcode cv_mcode sign_mcode struct_mcode storage_mcode
616 expdotsfn paramdotsfn stmtdotsfn decldotsfn initdotsfn
617 identfn exprfn ftfn tyfn initfn paramfn declfn rulefn stmtfn casefn
619 let get_option f
= function
623 let dotsfn param default all_functions arg
=
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
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
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
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
,
664 | Ast.Assignment
(left
,op
,right
,simple
) ->
665 Ast.Assignment
(expression left
, assign_mcode op
, expression right
,
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
,
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
,
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
,
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
,
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
,
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
,
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
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
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
,
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
,
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
,
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
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
,
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
) ->
796 (ident name
, string_mcode lp
, expression_dots args
,
797 string_mcode rp
,string_mcode eq
,initialiser ini
,
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
,
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
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
,
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
) ->
832 (List.map designator designators
, string_mcode eq
,
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
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
)
850 and parameterTypeDef 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
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
,
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
,
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
,
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
940 (* not parameterizable for now... *)
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
949 (* not parameterizable for now... *)
950 and define_parameters 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
,
960 and define_param_dots 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
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
981 and process_bef_aft s
=
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
))
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
,
1021 List.map
(whencode statement_dots statement
) whn
,
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
,
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 *)
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
)
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
)
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
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
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
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