1 module Ast0
= Ast0_cocci
4 (* --------------------------------------------------------------------- *)
5 (* Generic traversal: combiner *)
8 treatment of: mcode, identifiers, expressions, fullTypes, types,
9 declarations, statements, toplevels
10 default value for options *)
13 {combiner_ident
: Ast.ident
-> 'a
;
14 combiner_expression
: Ast.expression
-> 'a
;
15 combiner_fullType
: Ast.fullType
-> 'a
;
16 combiner_typeC
: Ast.typeC
-> 'a
;
17 combiner_declaration
: Ast.declaration
-> 'a
;
18 combiner_initialiser
: Ast.initialiser
-> 'a
;
19 combiner_parameter
: Ast.parameterTypeDef
-> 'a
;
20 combiner_parameter_list
: Ast.parameter_list
-> 'a
;
21 combiner_rule_elem
: Ast.rule_elem
-> 'a
;
22 combiner_statement
: Ast.statement
-> 'a
;
23 combiner_case_line
: Ast.case_line
-> 'a
;
24 combiner_top_level
: Ast.top_level
-> 'a
;
25 combiner_anything
: Ast.anything
-> 'a
;
26 combiner_expression_dots
: Ast.expression
Ast.dots
-> 'a
;
27 combiner_statement_dots
: Ast.statement
Ast.dots
-> 'a
;
28 combiner_declaration_dots
: Ast.declaration
Ast.dots
-> 'a
}
30 type ('mc
,'a
) cmcode
= 'a combiner
-> 'mc
Ast_cocci.mcode
-> 'a
31 type ('cd
,'a
) ccode
= 'a combiner
-> ('cd
-> 'a
) -> 'cd
-> 'a
34 let combiner bind option_default
35 meta_mcodefn string_mcodefn const_mcodefn assign_mcodefn fix_mcodefn
36 unary_mcodefn binary_mcodefn
37 cv_mcodefn sign_mcodefn struct_mcodefn storage_mcodefn
39 expdotsfn paramdotsfn stmtdotsfn decldotsfn
40 identfn exprfn ftfn tyfn initfn paramfn declfn rulefn stmtfn casefn
43 let rec loop = function
46 | x
::xs
-> bind x
(loop xs
) in
48 let get_option f
= function
50 | None
-> option_default
in
52 let rec meta_mcode x
= meta_mcodefn all_functions x
53 and string_mcode x
= string_mcodefn all_functions x
54 and const_mcode x
= const_mcodefn all_functions x
55 and assign_mcode x
= assign_mcodefn all_functions x
56 and fix_mcode x
= fix_mcodefn all_functions x
57 and unary_mcode x
= unary_mcodefn all_functions x
58 and binary_mcode x
= binary_mcodefn all_functions x
59 and cv_mcode x
= cv_mcodefn all_functions x
60 and sign_mcode x
= sign_mcodefn all_functions x
61 and struct_mcode x
= struct_mcodefn all_functions x
62 and storage_mcode x
= storage_mcodefn all_functions x
63 and inc_file_mcode x
= inc_file_mcodefn all_functions x
65 and expression_dots d
=
67 match Ast.unwrap d
with
68 Ast.DOTS
(l
) | Ast.CIRCLES
(l
) | Ast.STARS
(l
) ->
69 multibind (List.map expression l
) in
70 expdotsfn all_functions
k d
72 and parameter_dots d
=
74 match Ast.unwrap d
with
75 Ast.DOTS
(l
) | Ast.CIRCLES
(l
) | Ast.STARS
(l
) ->
76 multibind (List.map parameterTypeDef l
) in
77 paramdotsfn all_functions
k d
79 and statement_dots d
=
81 match Ast.unwrap d
with
82 Ast.DOTS
(l
) | Ast.CIRCLES
(l
) | Ast.STARS
(l
) ->
83 multibind (List.map statement l
) in
84 stmtdotsfn all_functions
k d
86 and declaration_dots d
=
88 match Ast.unwrap d
with
89 Ast.DOTS
(l
) | Ast.CIRCLES
(l
) | Ast.STARS
(l
) ->
90 multibind (List.map declaration l
) in
91 decldotsfn all_functions
k d
95 match Ast.unwrap i
with
96 Ast.Id
(name
) -> string_mcode name
97 | Ast.MetaId
(name
,_
,_
,_
) -> meta_mcode name
98 | Ast.MetaFunc
(name
,_
,_
,_
) -> meta_mcode name
99 | Ast.MetaLocalFunc
(name
,_
,_
,_
) -> meta_mcode name
100 | Ast.OptIdent
(id
) -> ident id
101 | Ast.UniqueIdent
(id
) -> ident id
in
102 identfn all_functions
k i
106 match Ast.unwrap e
with
107 Ast.Ident
(id
) -> ident id
108 | Ast.Constant
(const
) -> const_mcode const
109 | Ast.FunCall
(fn
,lp
,args
,rp
) ->
110 multibind [expression fn
; string_mcode lp
; expression_dots args
;
112 | Ast.Assignment
(left
,op
,right
,simple
) ->
113 multibind [expression left
; assign_mcode op
; expression right
]
114 | Ast.CondExpr
(exp1
,why
,exp2
,colon
,exp3
) ->
115 multibind [expression exp1
; string_mcode why
;
116 get_option expression exp2
; string_mcode colon
;
118 | Ast.Postfix
(exp
,op
) -> bind
(expression exp
) (fix_mcode op
)
119 | Ast.Infix
(exp
,op
) -> bind
(fix_mcode op
) (expression exp
)
120 | Ast.Unary
(exp
,op
) -> bind
(unary_mcode op
) (expression exp
)
121 | Ast.Binary
(left
,op
,right
) ->
122 multibind [expression left
; binary_mcode op
; expression right
]
123 | Ast.Nested
(left
,op
,right
) ->
124 multibind [expression left
; binary_mcode op
; expression right
]
125 | Ast.Paren
(lp
,exp
,rp
) ->
126 multibind [string_mcode lp
; expression exp
; string_mcode rp
]
127 | Ast.ArrayAccess
(exp1
,lb
,exp2
,rb
) ->
129 [expression exp1
; string_mcode lb
; expression exp2
;
131 | Ast.RecordAccess
(exp
,pt
,field
) ->
132 multibind [expression exp
; string_mcode pt
; ident field
]
133 | Ast.RecordPtAccess
(exp
,ar
,field
) ->
134 multibind [expression exp
; string_mcode ar
; ident field
]
135 | Ast.Cast
(lp
,ty
,rp
,exp
) ->
137 [string_mcode lp
; fullType ty
; string_mcode rp
; expression exp
]
138 | Ast.SizeOfExpr
(szf
,exp
) ->
139 multibind [string_mcode szf
; expression exp
]
140 | Ast.SizeOfType
(szf
,lp
,ty
,rp
) ->
142 [string_mcode szf
; string_mcode lp
; fullType ty
; string_mcode rp
]
143 | Ast.TypeExp
(ty
) -> fullType ty
144 | Ast.MetaErr
(name
,_
,_
,_
)
145 | Ast.MetaExpr
(name
,_
,_
,_
,_
,_
)
146 | Ast.MetaExprList
(name
,_
,_
,_
) -> meta_mcode name
147 | Ast.EComma
(cm
) -> string_mcode cm
148 | Ast.DisjExpr
(exp_list
) -> multibind (List.map expression exp_list
)
149 | Ast.NestExpr
(starter
,expr_dots
,ender
,whencode
,multi
) ->
150 bind
(string_mcode starter
)
151 (bind
(expression_dots expr_dots
)
152 (bind
(string_mcode ender
)
153 (get_option expression whencode
)))
154 | Ast.Edots
(dots
,whencode
) | Ast.Ecircles
(dots
,whencode
)
155 | Ast.Estars
(dots
,whencode
) ->
156 bind
(string_mcode dots
) (get_option expression whencode
)
157 | Ast.OptExp
(exp
) | Ast.UniqueExp
(exp
) ->
159 exprfn all_functions
k e
163 match Ast.unwrap ft
with
164 Ast.Type
(cv
,ty
) -> bind
(get_option cv_mcode cv
) (typeC ty
)
165 | Ast.DisjType
(types
) -> multibind (List.map fullType types
)
166 | Ast.OptType
(ty
) -> fullType ty
167 | Ast.UniqueType
(ty
) -> fullType ty
in
168 ftfn all_functions
k ft
170 and function_pointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) extra
=
171 (* have to put the treatment of the identifier into the right position *)
173 ([fullType ty
; string_mcode lp1
; string_mcode star
] @ extra
@
175 string_mcode lp2
; parameter_dots params
; string_mcode rp2
])
177 and function_type
(ty
,lp1
,params
,rp1
) extra
=
178 (* have to put the treatment of the identifier into the right position *)
180 ([get_option fullType ty
] @ extra
@
181 [string_mcode lp1
; parameter_dots params
; string_mcode rp1
])
183 and array_type
(ty
,lb
,size
,rb
) extra
=
185 ([fullType ty
] @ extra
@
186 [string_mcode lb
; get_option expression size
; string_mcode rb
])
190 match Ast.unwrap ty
with
191 Ast.BaseType
(ty
,strings
) -> multibind (List.map string_mcode strings
)
192 | Ast.SignedT
(sgn
,ty
) -> bind
(sign_mcode sgn
) (get_option typeC ty
)
193 | Ast.Pointer
(ty
,star
) ->
194 bind
(fullType ty
) (string_mcode star
)
195 | Ast.FunctionPointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
196 function_pointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) []
197 | Ast.FunctionType
(_
,ty
,lp1
,params
,rp1
) ->
198 function_type
(ty
,lp1
,params
,rp1
) []
199 | Ast.Array
(ty
,lb
,size
,rb
) -> array_type
(ty
,lb
,size
,rb
) []
200 | Ast.EnumName
(kind
,name
) -> bind
(string_mcode kind
) (ident name
)
201 | Ast.StructUnionName
(kind
,name
) ->
202 bind
(struct_mcode kind
) (get_option ident name
)
203 | Ast.StructUnionDef
(ty
,lb
,decls
,rb
) ->
205 [fullType ty
; string_mcode lb
; declaration_dots decls
;
207 | Ast.TypeName
(name
) -> string_mcode name
208 | Ast.MetaType
(name
,_
,_
) -> meta_mcode name
in
209 tyfn all_functions
k ty
211 and named_type ty id
=
212 match Ast.unwrap ty
with
213 Ast.Type
(None
,ty1
) ->
214 (match Ast.unwrap ty1
with
215 Ast.FunctionPointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
216 function_pointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) [ident id
]
217 | Ast.FunctionType
(_
,ty
,lp1
,params
,rp1
) ->
218 function_type
(ty
,lp1
,params
,rp1
) [ident id
]
219 | Ast.Array
(ty
,lb
,size
,rb
) -> array_type
(ty
,lb
,size
,rb
) [ident id
]
220 | _
-> bind
(fullType ty
) (ident id
))
221 | _
-> bind
(fullType ty
) (ident id
)
225 match Ast.unwrap d
with
226 Ast.MetaDecl
(name
,_
,_
) | Ast.MetaField
(name
,_
,_
) -> meta_mcode name
227 | Ast.Init
(stg
,ty
,id
,eq
,ini
,sem
) ->
228 bind
(get_option storage_mcode stg
)
229 (bind
(named_type ty id
)
231 [string_mcode eq
; initialiser ini
; string_mcode sem
]))
232 | Ast.UnInit
(stg
,ty
,id
,sem
) ->
233 bind
(get_option storage_mcode stg
)
234 (bind
(named_type ty id
) (string_mcode sem
))
235 | Ast.MacroDecl
(name
,lp
,args
,rp
,sem
) ->
237 [ident name
; string_mcode lp
; expression_dots args
;
238 string_mcode rp
; string_mcode sem
]
239 | Ast.TyDecl
(ty
,sem
) -> bind
(fullType ty
) (string_mcode sem
)
240 | Ast.Typedef
(stg
,ty
,id
,sem
) ->
241 bind
(string_mcode stg
)
242 (bind
(fullType ty
) (bind
(typeC id
) (string_mcode sem
)))
243 | Ast.DisjDecl
(decls
) -> multibind (List.map declaration decls
)
244 | Ast.Ddots
(dots
,whencode
) ->
245 bind
(string_mcode dots
) (get_option declaration whencode
)
246 | Ast.OptDecl
(decl
) -> declaration decl
247 | Ast.UniqueDecl
(decl
) -> declaration decl
in
248 declfn all_functions
k d
252 match Ast.unwrap i
with
253 Ast.MetaInit
(name
,_
,_
) -> meta_mcode name
254 | Ast.InitExpr
(exp
) -> expression exp
255 | Ast.InitList
(allminus
,lb
,initlist
,rb
,whencode
) ->
258 multibind (List.map initialiser initlist
);
260 multibind (List.map initialiser whencode
)]
261 | Ast.InitGccName
(name
,eq
,ini
) ->
262 multibind [ident name
; string_mcode eq
; initialiser ini
]
263 | Ast.InitGccExt
(designators
,eq
,ini
) ->
265 ((List.map designator designators
) @
266 [string_mcode eq
; initialiser ini
])
267 | Ast.IComma
(cm
) -> string_mcode cm
268 | Ast.OptIni
(i
) -> initialiser i
269 | Ast.UniqueIni
(i
) -> initialiser i
in
270 initfn all_functions
k i
272 and designator
= function
273 Ast.DesignatorField
(dot
,id
) -> bind
(string_mcode dot
) (ident id
)
274 | Ast.DesignatorIndex
(lb
,exp
,rb
) ->
275 bind
(string_mcode lb
) (bind
(expression exp
) (string_mcode rb
))
276 | Ast.DesignatorRange
(lb
,min
,dots
,max
,rb
) ->
278 [string_mcode lb
; expression min
; string_mcode dots
;
279 expression max
; string_mcode rb
]
281 and parameterTypeDef p
=
283 match Ast.unwrap p
with
284 Ast.VoidParam
(ty
) -> fullType ty
285 | Ast.Param
(ty
,Some id
) -> named_type ty id
286 | Ast.Param
(ty
,None
) -> fullType ty
287 | Ast.MetaParam
(name
,_
,_
) -> meta_mcode name
288 | Ast.MetaParamList
(name
,_
,_
,_
) -> meta_mcode name
289 | Ast.PComma
(cm
) -> string_mcode cm
290 | Ast.Pdots
(dots
) -> string_mcode dots
291 | Ast.Pcircles
(dots
) -> string_mcode dots
292 | Ast.OptParam
(param
) -> parameterTypeDef param
293 | Ast.UniqueParam
(param
) -> parameterTypeDef param
in
294 paramfn all_functions
k p
298 match Ast.unwrap re
with
299 Ast.FunHeader
(_
,_
,fi
,name
,lp
,params
,rp
) ->
301 ((List.map fninfo fi
) @
302 [ident name
;string_mcode lp
;parameter_dots params
;
304 | Ast.Decl
(_
,_
,decl
) -> declaration decl
305 | Ast.SeqStart
(brace
) -> string_mcode brace
306 | Ast.SeqEnd
(brace
) -> string_mcode brace
307 | Ast.ExprStatement
(exp
,sem
) ->
308 bind
(expression exp
) (string_mcode sem
)
309 | Ast.IfHeader
(iff
,lp
,exp
,rp
) ->
310 multibind [string_mcode iff
; string_mcode lp
; expression exp
;
312 | Ast.Else
(els
) -> string_mcode els
313 | Ast.WhileHeader
(whl
,lp
,exp
,rp
) ->
314 multibind [string_mcode whl
; string_mcode lp
; expression exp
;
316 | Ast.DoHeader
(d
) -> string_mcode d
317 | Ast.WhileTail
(whl
,lp
,exp
,rp
,sem
) ->
318 multibind [string_mcode whl
; string_mcode lp
; expression exp
;
319 string_mcode rp
; string_mcode sem
]
320 | Ast.ForHeader
(fr
,lp
,e1
,sem1
,e2
,sem2
,e3
,rp
) ->
321 multibind [string_mcode fr
; string_mcode lp
;
322 get_option expression e1
; string_mcode sem1
;
323 get_option expression e2
; string_mcode sem2
;
324 get_option expression e3
; string_mcode rp
]
325 | Ast.IteratorHeader
(nm
,lp
,args
,rp
) ->
326 multibind [ident nm
; string_mcode lp
;
327 expression_dots args
; string_mcode rp
]
328 | Ast.SwitchHeader
(switch
,lp
,exp
,rp
) ->
329 multibind [string_mcode switch
; string_mcode lp
; expression exp
;
331 | Ast.Break
(br
,sem
) -> bind
(string_mcode br
) (string_mcode sem
)
332 | Ast.Continue
(cont
,sem
) -> bind
(string_mcode cont
) (string_mcode sem
)
333 | Ast.Label
(l
,dd
) -> bind
(ident l
) (string_mcode dd
)
334 | Ast.Goto
(goto
,l
,sem
) ->
335 bind
(string_mcode goto
) (bind
(ident l
) (string_mcode sem
))
336 | Ast.Return
(ret
,sem
) -> bind
(string_mcode ret
) (string_mcode sem
)
337 | Ast.ReturnExpr
(ret
,exp
,sem
) ->
338 multibind [string_mcode ret
; expression exp
; string_mcode sem
]
339 | Ast.MetaStmt
(name
,_
,_
,_
) -> meta_mcode name
340 | Ast.MetaStmtList
(name
,_
,_
) -> meta_mcode name
341 | Ast.MetaRuleElem
(name
,_
,_
) -> meta_mcode name
342 | Ast.Exp
(exp
) -> expression exp
343 | Ast.TopExp
(exp
) -> expression exp
344 | Ast.Ty
(ty
) -> fullType ty
345 | Ast.TopInit
(init
) -> initialiser init
346 | Ast.Include
(inc
,name
) -> bind
(string_mcode inc
) (inc_file_mcode name
)
347 | Ast.DefineHeader
(def
,id
,params
) ->
348 multibind [string_mcode def
; ident id
; define_parameters params
]
349 | Ast.Default
(def
,colon
) -> bind
(string_mcode def
) (string_mcode colon
)
350 | Ast.Case
(case
,exp
,colon
) ->
351 multibind [string_mcode case
; expression exp
; string_mcode colon
]
352 | Ast.DisjRuleElem
(res
) -> multibind (List.map rule_elem res
) in
353 rulefn all_functions
k re
355 (* not parameterizable for now... *)
356 and define_parameters p
=
358 match Ast.unwrap p
with
359 Ast.NoParams
-> option_default
360 | Ast.DParams
(lp
,params
,rp
) ->
362 [string_mcode lp
; define_param_dots params
; string_mcode rp
] in
365 and define_param_dots d
=
367 match Ast.unwrap d
with
368 Ast.DOTS
(l
) | Ast.CIRCLES
(l
) | Ast.STARS
(l
) ->
369 multibind (List.map define_param l
) in
374 match Ast.unwrap p
with
375 Ast.DParam
(id
) -> ident id
376 | Ast.DPComma
(comma
) -> string_mcode comma
377 | Ast.DPdots
(d
) -> string_mcode d
378 | Ast.DPcircles
(c
) -> string_mcode c
379 | Ast.OptDParam
(dp
) -> define_param dp
380 | Ast.UniqueDParam
(dp
) -> define_param dp
in
383 (* discard the result, because the statement is assumed to be already
384 represented elsewhere in the code *)
385 and process_bef_aft s
=
386 match Ast.get_dots_bef_aft s
with
388 | Ast.DroppingBetweenDots
(stm
,ind
) -> let _ = statement stm
in ()
389 | Ast.AddingBetweenDots
(stm
,ind
) -> let _ = statement stm
in ()
394 match Ast.unwrap s
with
395 Ast.Seq
(lbrace
,body
,rbrace
) ->
396 multibind [rule_elem lbrace
;
397 statement_dots body
; rule_elem rbrace
]
398 | Ast.IfThen
(header
,branch
,_) ->
399 multibind [rule_elem header
; statement branch
]
400 | Ast.IfThenElse
(header
,branch1
,els
,branch2
,_) ->
401 multibind [rule_elem header
; statement branch1
; rule_elem els
;
403 | Ast.While
(header
,body
,_) ->
404 multibind [rule_elem header
; statement body
]
405 | Ast.Do
(header
,body
,tail
) ->
406 multibind [rule_elem header
; statement body
; rule_elem tail
]
407 | Ast.For
(header
,body
,_) -> multibind [rule_elem header
; statement body
]
408 | Ast.Iterator
(header
,body
,_) ->
409 multibind [rule_elem header
; statement body
]
410 | Ast.Switch
(header
,lb
,decls
,cases
,rb
) ->
411 multibind [rule_elem header
;rule_elem lb
;
412 statement_dots decls
;
413 multibind (List.map case_line cases
);
415 | Ast.Atomic
(re
) -> rule_elem re
416 | Ast.Disj
(stmt_dots_list
) ->
417 multibind (List.map statement_dots stmt_dots_list
)
418 | Ast.Nest
(starter
,stmt_dots
,ender
,whn
,_,_,_) ->
419 bind
(string_mcode starter
)
420 (bind
(statement_dots stmt_dots
)
421 (bind
(string_mcode ender
)
423 (List.map
(whencode statement_dots statement
) whn
))))
424 | Ast.FunDecl
(header
,lbrace
,body
,rbrace
) ->
425 multibind [rule_elem header
; rule_elem lbrace
;
426 statement_dots body
; rule_elem rbrace
]
427 | Ast.Define
(header
,body
) ->
428 bind
(rule_elem header
) (statement_dots body
)
429 | Ast.Dots
(d
,whn
,_,_) | Ast.Circles
(d
,whn
,_,_) | Ast.Stars
(d
,whn
,_,_) ->
430 bind
(string_mcode d
)
431 (multibind (List.map
(whencode statement_dots statement
) whn
))
432 | Ast.OptStm
(stmt
) | Ast.UniqueStm
(stmt
) ->
434 stmtfn all_functions
k s
436 and fninfo
= function
437 Ast.FStorage
(stg
) -> storage_mcode stg
438 | Ast.FType
(ty
) -> fullType ty
439 | Ast.FInline
(inline
) -> string_mcode inline
440 | Ast.FAttr
(attr
) -> string_mcode attr
442 and whencode notfn alwaysfn
= function
443 Ast.WhenNot a
-> notfn a
444 | Ast.WhenAlways a
-> alwaysfn a
445 | Ast.WhenModifier
(_) -> option_default
446 | Ast.WhenNotTrue
(e
) -> rule_elem e
447 | Ast.WhenNotFalse
(e
) -> rule_elem e
451 match Ast.unwrap c
with
452 Ast.CaseLine
(header
,code
) ->
453 bind
(rule_elem header
) (statement_dots code
)
454 | Ast.OptCase
(case
) -> case_line case
in
455 casefn all_functions
k c
459 match Ast.unwrap t
with
460 Ast.FILEINFO
(old_file
,new_file
) ->
461 bind
(string_mcode old_file
) (string_mcode new_file
)
462 | Ast.DECL
(stmt
) -> statement stmt
463 | Ast.CODE
(stmt_dots
) -> statement_dots stmt_dots
464 | Ast.ERRORWORDS
(exps
) -> multibind (List.map expression exps
) in
465 topfn all_functions
k t
469 (*in many cases below, the thing is not even mcode, so we do nothing*)
470 Ast.FullTypeTag
(ft
) -> fullType ft
471 | Ast.BaseTypeTag
(bt
) -> option_default
472 | Ast.StructUnionTag
(su
) -> option_default
473 | Ast.SignTag
(sgn
) -> option_default
474 | Ast.IdentTag
(id
) -> ident id
475 | Ast.ExpressionTag
(exp
) -> expression exp
476 | Ast.ConstantTag
(cst
) -> option_default
477 | Ast.UnaryOpTag
(unop
) -> option_default
478 | Ast.AssignOpTag
(asgnop
) -> option_default
479 | Ast.FixOpTag
(fixop
) -> option_default
480 | Ast.BinaryOpTag
(binop
) -> option_default
481 | Ast.ArithOpTag
(arithop
) -> option_default
482 | Ast.LogicalOpTag
(logop
) -> option_default
483 | Ast.DeclarationTag
(decl
) -> declaration decl
484 | Ast.InitTag
(ini
) -> initialiser ini
485 | Ast.StorageTag
(stg
) -> option_default
486 | Ast.IncFileTag
(stg
) -> option_default
487 | Ast.Rule_elemTag
(rule
) -> rule_elem rule
488 | Ast.StatementTag
(rule
) -> statement rule
489 | Ast.CaseLineTag
(case
) -> case_line case
490 | Ast.ConstVolTag
(cv
) -> option_default
491 | Ast.Token
(tok
,info
) -> option_default
492 | Ast.Pragma
(str
) -> option_default
493 | Ast.Code
(cd
) -> top_level cd
494 | Ast.ExprDotsTag
(ed
) -> expression_dots ed
495 | Ast.ParamDotsTag
(pd
) -> parameter_dots pd
496 | Ast.StmtDotsTag
(sd
) -> statement_dots sd
497 | Ast.DeclDotsTag
(sd
) -> declaration_dots sd
498 | Ast.TypeCTag
(ty
) -> typeC ty
499 | Ast.ParamTag
(param
) -> parameterTypeDef param
500 | Ast.SgrepStartTag
(tok
) -> option_default
501 | Ast.SgrepEndTag
(tok
) -> option_default
in
502 anyfn all_functions
k a
505 {combiner_ident
= ident
;
506 combiner_expression
= expression
;
507 combiner_fullType
= fullType
;
508 combiner_typeC
= typeC
;
509 combiner_declaration
= declaration
;
510 combiner_initialiser
= initialiser
;
511 combiner_parameter
= parameterTypeDef
;
512 combiner_parameter_list
= parameter_dots
;
513 combiner_rule_elem
= rule_elem
;
514 combiner_statement
= statement
;
515 combiner_case_line
= case_line
;
516 combiner_top_level
= top_level
;
517 combiner_anything
= anything
;
518 combiner_expression_dots
= expression_dots
;
519 combiner_statement_dots
= statement_dots
;
520 combiner_declaration_dots
= declaration_dots
} in
523 (* ---------------------------------------------------------------------- *)
525 type 'a inout
= 'a
-> 'a
(* for specifying the type of rebuilder *)
528 {rebuilder_ident
: Ast.ident inout
;
529 rebuilder_expression
: Ast.expression inout
;
530 rebuilder_fullType
: Ast.fullType inout
;
531 rebuilder_typeC
: Ast.typeC inout
;
532 rebuilder_declaration
: Ast.declaration inout
;
533 rebuilder_initialiser
: Ast.initialiser inout
;
534 rebuilder_parameter
: Ast.parameterTypeDef inout
;
535 rebuilder_parameter_list
: Ast.parameter_list inout
;
536 rebuilder_statement
: Ast.statement inout
;
537 rebuilder_case_line
: Ast.case_line inout
;
538 rebuilder_rule_elem
: Ast.rule_elem inout
;
539 rebuilder_top_level
: Ast.top_level inout
;
540 rebuilder_expression_dots
: Ast.expression
Ast.dots inout
;
541 rebuilder_statement_dots
: Ast.statement
Ast.dots inout
;
542 rebuilder_declaration_dots
: Ast.declaration
Ast.dots inout
;
543 rebuilder_define_param_dots
: Ast.define_param
Ast.dots inout
;
544 rebuilder_define_param
: Ast.define_param inout
;
545 rebuilder_define_parameters
: Ast.define_parameters inout
;
546 rebuilder_anything
: Ast.anything inout
}
548 type 'mc rmcode
= 'mc
Ast.mcode inout
549 type 'cd rcode
= rebuilder
-> ('cd inout
) -> 'cd inout
553 meta_mcode string_mcode const_mcode assign_mcode fix_mcode unary_mcode
554 binary_mcode cv_mcode sign_mcode struct_mcode storage_mcode
556 expdotsfn paramdotsfn stmtdotsfn decldotsfn
557 identfn exprfn ftfn tyfn initfn paramfn declfn rulefn stmtfn casefn
559 let get_option f
= function
562 let rec expression_dots d
=
565 (match Ast.unwrap d
with
566 Ast.DOTS
(l
) -> Ast.DOTS
(List.map expression l
)
567 | Ast.CIRCLES
(l
) -> Ast.CIRCLES
(List.map expression l
)
568 | Ast.STARS
(l
) -> Ast.STARS
(List.map expression l
)) in
569 expdotsfn all_functions
k d
571 and parameter_dots d
=
574 (match Ast.unwrap d
with
575 Ast.DOTS
(l
) -> Ast.DOTS
(List.map parameterTypeDef l
)
576 | Ast.CIRCLES
(l
) -> Ast.CIRCLES
(List.map parameterTypeDef l
)
577 | Ast.STARS
(l
) -> Ast.STARS
(List.map parameterTypeDef l
)) in
578 paramdotsfn all_functions
k d
580 and statement_dots d
=
583 (match Ast.unwrap d
with
584 Ast.DOTS
(l
) -> Ast.DOTS
(List.map statement l
)
585 | Ast.CIRCLES
(l
) -> Ast.CIRCLES
(List.map statement l
)
586 | Ast.STARS
(l
) -> Ast.STARS
(List.map statement l
)) in
587 stmtdotsfn all_functions
k d
589 and declaration_dots d
=
592 (match Ast.unwrap d
with
593 Ast.DOTS
(l
) -> Ast.DOTS
(List.map declaration l
)
594 | Ast.CIRCLES
(l
) -> Ast.CIRCLES
(List.map declaration l
)
595 | Ast.STARS
(l
) -> Ast.STARS
(List.map declaration l
)) in
596 decldotsfn all_functions
k d
601 (match Ast.unwrap i
with
602 Ast.Id
(name
) -> Ast.Id
(string_mcode name
)
603 | Ast.MetaId
(name
,constraints
,keep
,inherited
) ->
604 Ast.MetaId
(meta_mcode name
,constraints
,keep
,inherited
)
605 | Ast.MetaFunc
(name
,constraints
,keep
,inherited
) ->
606 Ast.MetaFunc
(meta_mcode name
,constraints
,keep
,inherited
)
607 | Ast.MetaLocalFunc
(name
,constraints
,keep
,inherited
) ->
608 Ast.MetaLocalFunc
(meta_mcode name
,constraints
,keep
,inherited
)
609 | Ast.OptIdent
(id
) -> Ast.OptIdent
(ident id
)
610 | Ast.UniqueIdent
(id
) -> Ast.UniqueIdent
(ident id
)) in
611 identfn all_functions
k i
616 (match Ast.unwrap e
with
617 Ast.Ident
(id
) -> Ast.Ident
(ident id
)
618 | Ast.Constant
(const
) -> Ast.Constant
(const_mcode const
)
619 | Ast.FunCall
(fn
,lp
,args
,rp
) ->
620 Ast.FunCall
(expression fn
, string_mcode lp
, expression_dots args
,
622 | Ast.Assignment
(left
,op
,right
,simple
) ->
623 Ast.Assignment
(expression left
, assign_mcode op
, expression right
,
625 | Ast.CondExpr
(exp1
,why
,exp2
,colon
,exp3
) ->
626 Ast.CondExpr
(expression exp1
, string_mcode why
,
627 get_option expression exp2
, string_mcode colon
,
629 | Ast.Postfix
(exp
,op
) -> Ast.Postfix
(expression exp
,fix_mcode op
)
630 | Ast.Infix
(exp
,op
) -> Ast.Infix
(expression exp
,fix_mcode op
)
631 | Ast.Unary
(exp
,op
) -> Ast.Unary
(expression exp
,unary_mcode op
)
632 | Ast.Binary
(left
,op
,right
) ->
633 Ast.Binary
(expression left
, binary_mcode op
, expression right
)
634 | Ast.Nested
(left
,op
,right
) ->
635 Ast.Nested
(expression left
, binary_mcode op
, expression right
)
636 | Ast.Paren
(lp
,exp
,rp
) ->
637 Ast.Paren
(string_mcode lp
, expression exp
, string_mcode rp
)
638 | Ast.ArrayAccess
(exp1
,lb
,exp2
,rb
) ->
639 Ast.ArrayAccess
(expression exp1
, string_mcode lb
, expression exp2
,
641 | Ast.RecordAccess
(exp
,pt
,field
) ->
642 Ast.RecordAccess
(expression exp
, string_mcode pt
, ident field
)
643 | Ast.RecordPtAccess
(exp
,ar
,field
) ->
644 Ast.RecordPtAccess
(expression exp
, string_mcode ar
, ident field
)
645 | Ast.Cast
(lp
,ty
,rp
,exp
) ->
646 Ast.Cast
(string_mcode lp
, fullType ty
, string_mcode rp
,
648 | Ast.SizeOfExpr
(szf
,exp
) ->
649 Ast.SizeOfExpr
(string_mcode szf
, expression exp
)
650 | Ast.SizeOfType
(szf
,lp
,ty
,rp
) ->
651 Ast.SizeOfType
(string_mcode szf
,string_mcode lp
, fullType ty
,
653 | Ast.TypeExp
(ty
) -> Ast.TypeExp
(fullType ty
)
654 | Ast.MetaErr
(name
,constraints
,keep
,inherited
) ->
655 Ast.MetaErr
(meta_mcode name
,constraints
,keep
,inherited
)
656 | Ast.MetaExpr
(name
,constraints
,keep
,ty
,form
,inherited
) ->
657 Ast.MetaExpr
(meta_mcode name
,constraints
,keep
,ty
,form
,inherited
)
658 | Ast.MetaExprList
(name
,lenname_inh
,keep
,inherited
) ->
659 Ast.MetaExprList
(meta_mcode name
,lenname_inh
,keep
,inherited
)
660 | Ast.EComma
(cm
) -> Ast.EComma
(string_mcode cm
)
661 | Ast.DisjExpr
(exp_list
) -> Ast.DisjExpr
(List.map expression exp_list
)
662 | Ast.NestExpr
(starter
,expr_dots
,ender
,whencode
,multi
) ->
663 Ast.NestExpr
(string_mcode starter
,expression_dots expr_dots
,
665 get_option expression whencode
,multi
)
666 | Ast.Edots
(dots
,whencode
) ->
667 Ast.Edots
(string_mcode dots
,get_option expression whencode
)
668 | Ast.Ecircles
(dots
,whencode
) ->
669 Ast.Ecircles
(string_mcode dots
,get_option expression whencode
)
670 | Ast.Estars
(dots
,whencode
) ->
671 Ast.Estars
(string_mcode dots
,get_option expression whencode
)
672 | Ast.OptExp
(exp
) -> Ast.OptExp
(expression exp
)
673 | Ast.UniqueExp
(exp
) -> Ast.UniqueExp
(expression exp
)) in
674 exprfn all_functions
k e
679 (match Ast.unwrap ft
with
680 Ast.Type
(cv
,ty
) -> Ast.Type
(get_option cv_mcode cv
, typeC ty
)
681 | Ast.DisjType
(types
) -> Ast.DisjType
(List.map fullType types
)
682 | Ast.OptType
(ty
) -> Ast.OptType
(fullType ty
)
683 | Ast.UniqueType
(ty
) -> Ast.UniqueType
(fullType ty
)) in
684 ftfn all_functions
k ft
689 (match Ast.unwrap ty
with
690 Ast.BaseType
(ty
,strings
) ->
691 Ast.BaseType
(ty
, List.map string_mcode strings
)
692 | Ast.SignedT
(sgn
,ty
) ->
693 Ast.SignedT
(sign_mcode sgn
,get_option typeC ty
)
694 | Ast.Pointer
(ty
,star
) ->
695 Ast.Pointer
(fullType ty
, string_mcode star
)
696 | Ast.FunctionPointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
697 Ast.FunctionPointer
(fullType ty
,string_mcode lp1
,string_mcode star
,
698 string_mcode rp1
,string_mcode lp2
,
699 parameter_dots params
,
701 | Ast.FunctionType
(allminus
,ty
,lp
,params
,rp
) ->
702 Ast.FunctionType
(allminus
,get_option fullType ty
,string_mcode lp
,
703 parameter_dots params
,string_mcode rp
)
704 | Ast.Array
(ty
,lb
,size
,rb
) ->
705 Ast.Array
(fullType ty
, string_mcode lb
,
706 get_option expression size
, string_mcode rb
)
707 | Ast.EnumName
(kind
,name
) ->
708 Ast.EnumName
(string_mcode kind
, ident name
)
709 | Ast.StructUnionName
(kind
,name
) ->
710 Ast.StructUnionName
(struct_mcode kind
, get_option ident name
)
711 | Ast.StructUnionDef
(ty
,lb
,decls
,rb
) ->
712 Ast.StructUnionDef
(fullType ty
,
713 string_mcode lb
, declaration_dots decls
,
715 | Ast.TypeName
(name
) -> Ast.TypeName
(string_mcode name
)
716 | Ast.MetaType
(name
,keep
,inherited
) ->
717 Ast.MetaType
(meta_mcode name
,keep
,inherited
)) in
718 tyfn all_functions
k ty
723 (match Ast.unwrap d
with
724 Ast.MetaDecl
(name
,keep
,inherited
) ->
725 Ast.MetaDecl
(meta_mcode name
,keep
,inherited
)
726 | Ast.MetaField
(name
,keep
,inherited
) ->
727 Ast.MetaField
(meta_mcode name
,keep
,inherited
)
728 | Ast.Init
(stg
,ty
,id
,eq
,ini
,sem
) ->
729 Ast.Init
(get_option storage_mcode stg
, fullType ty
, ident id
,
730 string_mcode eq
, initialiser ini
, string_mcode sem
)
731 | Ast.UnInit
(stg
,ty
,id
,sem
) ->
732 Ast.UnInit
(get_option storage_mcode stg
, fullType ty
, ident id
,
734 | Ast.MacroDecl
(name
,lp
,args
,rp
,sem
) ->
735 Ast.MacroDecl
(ident name
, string_mcode lp
, expression_dots args
,
736 string_mcode rp
,string_mcode sem
)
737 | Ast.TyDecl
(ty
,sem
) -> Ast.TyDecl
(fullType ty
, string_mcode sem
)
738 | Ast.Typedef
(stg
,ty
,id
,sem
) ->
739 Ast.Typedef
(string_mcode stg
, fullType ty
, typeC id
,
741 | Ast.DisjDecl
(decls
) -> Ast.DisjDecl
(List.map declaration decls
)
742 | Ast.Ddots
(dots
,whencode
) ->
743 Ast.Ddots
(string_mcode dots
, get_option declaration whencode
)
744 | Ast.OptDecl
(decl
) -> Ast.OptDecl
(declaration decl
)
745 | Ast.UniqueDecl
(decl
) -> Ast.UniqueDecl
(declaration decl
)) in
746 declfn all_functions
k d
751 (match Ast.unwrap i
with
752 Ast.MetaInit
(name
,keep
,inherited
) ->
753 Ast.MetaInit
(meta_mcode name
,keep
,inherited
)
754 | Ast.InitExpr
(exp
) -> Ast.InitExpr
(expression exp
)
755 | Ast.InitList
(allminus
,lb
,initlist
,rb
,whencode
) ->
756 Ast.InitList
(allminus
,
757 string_mcode lb
, List.map initialiser initlist
,
758 string_mcode rb
, List.map initialiser whencode
)
759 | Ast.InitGccName
(name
,eq
,ini
) ->
760 Ast.InitGccName
(ident name
, string_mcode eq
, initialiser ini
)
761 | Ast.InitGccExt
(designators
,eq
,ini
) ->
763 (List.map designator designators
, string_mcode eq
,
765 | Ast.IComma
(cm
) -> Ast.IComma
(string_mcode cm
)
766 | Ast.OptIni
(i
) -> Ast.OptIni
(initialiser i
)
767 | Ast.UniqueIni
(i
) -> Ast.UniqueIni
(initialiser i
)) in
768 initfn all_functions
k i
770 and designator
= function
771 Ast.DesignatorField
(dot
,id
) ->
772 Ast.DesignatorField
(string_mcode dot
,ident id
)
773 | Ast.DesignatorIndex
(lb
,exp
,rb
) ->
774 Ast.DesignatorIndex
(string_mcode lb
,expression exp
,string_mcode rb
)
775 | Ast.DesignatorRange
(lb
,min
,dots
,max
,rb
) ->
776 Ast.DesignatorRange
(string_mcode lb
,expression min
,string_mcode dots
,
777 expression max
,string_mcode rb
)
779 and parameterTypeDef p
=
782 (match Ast.unwrap p
with
783 Ast.VoidParam
(ty
) -> Ast.VoidParam
(fullType ty
)
784 | Ast.Param
(ty
,id
) -> Ast.Param
(fullType ty
, get_option ident id
)
785 | Ast.MetaParam
(name
,keep
,inherited
) ->
786 Ast.MetaParam
(meta_mcode name
,keep
,inherited
)
787 | Ast.MetaParamList
(name
,lenname_inh
,keep
,inherited
) ->
788 Ast.MetaParamList
(meta_mcode name
,lenname_inh
,keep
,inherited
)
789 | Ast.PComma
(cm
) -> Ast.PComma
(string_mcode cm
)
790 | Ast.Pdots
(dots
) -> Ast.Pdots
(string_mcode dots
)
791 | Ast.Pcircles
(dots
) -> Ast.Pcircles
(string_mcode dots
)
792 | Ast.OptParam
(param
) -> Ast.OptParam
(parameterTypeDef param
)
793 | Ast.UniqueParam
(param
) -> Ast.UniqueParam
(parameterTypeDef param
)) in
794 paramfn all_functions
k p
799 (match Ast.unwrap re
with
800 Ast.FunHeader
(bef
,allminus
,fi
,name
,lp
,params
,rp
) ->
801 Ast.FunHeader
(bef
,allminus
,List.map fninfo fi
,ident name
,
802 string_mcode lp
, parameter_dots params
,
804 | Ast.Decl
(bef
,allminus
,decl
) ->
805 Ast.Decl
(bef
,allminus
,declaration decl
)
806 | Ast.SeqStart
(brace
) -> Ast.SeqStart
(string_mcode brace
)
807 | Ast.SeqEnd
(brace
) -> Ast.SeqEnd
(string_mcode brace
)
808 | Ast.ExprStatement
(exp
,sem
) ->
809 Ast.ExprStatement
(expression exp
, string_mcode sem
)
810 | Ast.IfHeader
(iff
,lp
,exp
,rp
) ->
811 Ast.IfHeader
(string_mcode iff
, string_mcode lp
, expression exp
,
813 | Ast.Else
(els
) -> Ast.Else
(string_mcode els
)
814 | Ast.WhileHeader
(whl
,lp
,exp
,rp
) ->
815 Ast.WhileHeader
(string_mcode whl
, string_mcode lp
, expression exp
,
817 | Ast.DoHeader
(d
) -> Ast.DoHeader
(string_mcode d
)
818 | Ast.WhileTail
(whl
,lp
,exp
,rp
,sem
) ->
819 Ast.WhileTail
(string_mcode whl
, string_mcode lp
, expression exp
,
820 string_mcode rp
, string_mcode sem
)
821 | Ast.ForHeader
(fr
,lp
,e1
,sem1
,e2
,sem2
,e3
,rp
) ->
822 Ast.ForHeader
(string_mcode fr
, string_mcode lp
,
823 get_option expression e1
, string_mcode sem1
,
824 get_option expression e2
, string_mcode sem2
,
825 get_option expression e3
, string_mcode rp
)
826 | Ast.IteratorHeader
(whl
,lp
,args
,rp
) ->
827 Ast.IteratorHeader
(ident whl
, string_mcode lp
,
828 expression_dots args
, string_mcode rp
)
829 | Ast.SwitchHeader
(switch
,lp
,exp
,rp
) ->
830 Ast.SwitchHeader
(string_mcode switch
, string_mcode lp
,
831 expression exp
, string_mcode rp
)
832 | Ast.Break
(br
,sem
) ->
833 Ast.Break
(string_mcode br
, string_mcode sem
)
834 | Ast.Continue
(cont
,sem
) ->
835 Ast.Continue
(string_mcode cont
, string_mcode sem
)
836 | Ast.Label
(l
,dd
) -> Ast.Label
(ident l
, string_mcode dd
)
837 | Ast.Goto
(goto
,l
,sem
) ->
838 Ast.Goto
(string_mcode goto
,ident l
,string_mcode sem
)
839 | Ast.Return
(ret
,sem
) ->
840 Ast.Return
(string_mcode ret
, string_mcode sem
)
841 | Ast.ReturnExpr
(ret
,exp
,sem
) ->
842 Ast.ReturnExpr
(string_mcode ret
, expression exp
, string_mcode sem
)
843 | Ast.MetaStmt
(name
,keep
,seqible
,inherited
) ->
844 Ast.MetaStmt
(meta_mcode name
,keep
,seqible
,inherited
)
845 | Ast.MetaStmtList
(name
,keep
,inherited
) ->
846 Ast.MetaStmtList
(meta_mcode name
,keep
,inherited
)
847 | Ast.MetaRuleElem
(name
,keep
,inherited
) ->
848 Ast.MetaRuleElem
(meta_mcode name
,keep
,inherited
)
849 | Ast.Exp
(exp
) -> Ast.Exp
(expression exp
)
850 | Ast.TopExp
(exp
) -> Ast.TopExp
(expression exp
)
851 | Ast.Ty
(ty
) -> Ast.Ty
(fullType ty
)
852 | Ast.TopInit
(init
) -> Ast.TopInit
(initialiser init
)
853 | Ast.Include
(inc
,name
) ->
854 Ast.Include
(string_mcode inc
,inc_file_mcode name
)
855 | Ast.DefineHeader
(def
,id
,params
) ->
856 Ast.DefineHeader
(string_mcode def
,ident id
,
857 define_parameters params
)
858 | Ast.Default
(def
,colon
) ->
859 Ast.Default
(string_mcode def
,string_mcode colon
)
860 | Ast.Case
(case
,exp
,colon
) ->
861 Ast.Case
(string_mcode case
,expression exp
,string_mcode colon
)
862 | Ast.DisjRuleElem
(res
) -> Ast.DisjRuleElem
(List.map rule_elem res
)) in
863 rulefn all_functions
k re
865 (* not parameterizable for now... *)
866 and define_parameters p
=
869 (match Ast.unwrap p
with
870 Ast.NoParams
-> Ast.NoParams
871 | Ast.DParams
(lp
,params
,rp
) ->
872 Ast.DParams
(string_mcode lp
,define_param_dots params
,
876 and define_param_dots d
=
879 (match Ast.unwrap d
with
880 Ast.DOTS
(l
) -> Ast.DOTS
(List.map define_param l
)
881 | Ast.CIRCLES
(l
) -> Ast.CIRCLES
(List.map define_param l
)
882 | Ast.STARS
(l
) -> Ast.STARS
(List.map define_param l
)) in
888 (match Ast.unwrap p
with
889 Ast.DParam
(id
) -> Ast.DParam
(ident id
)
890 | Ast.DPComma
(comma
) -> Ast.DPComma
(string_mcode comma
)
891 | Ast.DPdots
(d
) -> Ast.DPdots
(string_mcode d
)
892 | Ast.DPcircles
(c
) -> Ast.DPcircles
(string_mcode c
)
893 | Ast.OptDParam
(dp
) -> Ast.OptDParam
(define_param dp
)
894 | Ast.UniqueDParam
(dp
) -> Ast.UniqueDParam
(define_param dp
)) in
897 and process_bef_aft s
=
899 (match Ast.get_dots_bef_aft s
with
900 Ast.NoDots
-> Ast.NoDots
901 | Ast.DroppingBetweenDots
(stm
,ind
) ->
902 Ast.DroppingBetweenDots
(statement stm
,ind
)
903 | Ast.AddingBetweenDots
(stm
,ind
) ->
904 Ast.AddingBetweenDots
(statement stm
,ind
))
910 (match Ast.unwrap s
with
911 Ast.Seq
(lbrace
,body
,rbrace
) ->
912 Ast.Seq
(rule_elem lbrace
,
913 statement_dots body
, rule_elem rbrace
)
914 | Ast.IfThen
(header
,branch
,aft
) ->
915 Ast.IfThen
(rule_elem header
, statement branch
,aft
)
916 | Ast.IfThenElse
(header
,branch1
,els
,branch2
,aft
) ->
917 Ast.IfThenElse
(rule_elem header
, statement branch1
, rule_elem els
,
918 statement branch2
, aft
)
919 | Ast.While
(header
,body
,aft
) ->
920 Ast.While
(rule_elem header
, statement body
, aft
)
921 | Ast.Do
(header
,body
,tail
) ->
922 Ast.Do
(rule_elem header
, statement body
, rule_elem tail
)
923 | Ast.For
(header
,body
,aft
) ->
924 Ast.For
(rule_elem header
, statement body
, aft
)
925 | Ast.Iterator
(header
,body
,aft
) ->
926 Ast.Iterator
(rule_elem header
, statement body
, aft
)
927 | Ast.Switch
(header
,lb
,decls
,cases
,rb
) ->
928 Ast.Switch
(rule_elem header
,rule_elem lb
,
929 statement_dots decls
,
930 List.map case_line cases
,rule_elem rb
)
931 | Ast.Atomic
(re
) -> Ast.Atomic
(rule_elem re
)
932 | Ast.Disj
(stmt_dots_list
) ->
933 Ast.Disj
(List.map statement_dots stmt_dots_list
)
934 | Ast.Nest
(starter
,stmt_dots
,ender
,whn
,multi
,bef
,aft
) ->
935 Ast.Nest
(string_mcode starter
,statement_dots stmt_dots
,
937 List.map
(whencode statement_dots statement
) whn
,
939 | Ast.FunDecl
(header
,lbrace
,body
,rbrace
) ->
940 Ast.FunDecl
(rule_elem header
,rule_elem lbrace
,
941 statement_dots body
, rule_elem rbrace
)
942 | Ast.Define
(header
,body
) ->
943 Ast.Define
(rule_elem header
,statement_dots body
)
944 | Ast.Dots
(d
,whn
,bef
,aft
) ->
945 Ast.Dots
(string_mcode d
,
946 List.map
(whencode statement_dots statement
) whn
,bef
,aft
)
947 | Ast.Circles
(d
,whn
,bef
,aft
) ->
948 Ast.Circles
(string_mcode d
,
949 List.map
(whencode statement_dots statement
) whn
,
951 | Ast.Stars
(d
,whn
,bef
,aft
) ->
952 Ast.Stars
(string_mcode d
,
953 List.map
(whencode statement_dots statement
) whn
,bef
,aft
)
954 | Ast.OptStm
(stmt
) -> Ast.OptStm
(statement stmt
)
955 | Ast.UniqueStm
(stmt
) -> Ast.UniqueStm
(statement stmt
)) in
956 let s = stmtfn all_functions
k s in
957 (* better to do this after, in case there is an equality test on the whole
958 statement, eg in free_vars. equality test would require that this
959 subterm not already be changed *)
962 and fninfo
= function
963 Ast.FStorage
(stg
) -> Ast.FStorage
(storage_mcode stg
)
964 | Ast.FType
(ty
) -> Ast.FType
(fullType ty
)
965 | Ast.FInline
(inline
) -> Ast.FInline
(string_mcode inline
)
966 | Ast.FAttr
(attr
) -> Ast.FAttr
(string_mcode attr
)
968 and whencode notfn alwaysfn
= function
969 Ast.WhenNot a
-> Ast.WhenNot
(notfn a
)
970 | Ast.WhenAlways a
-> Ast.WhenAlways
(alwaysfn a
)
971 | Ast.WhenModifier
(x
) -> Ast.WhenModifier
(x
)
972 | Ast.WhenNotTrue
(e
) -> Ast.WhenNotTrue
(rule_elem e
)
973 | Ast.WhenNotFalse
(e
) -> Ast.WhenNotFalse
(rule_elem e
)
978 (match Ast.unwrap c
with
979 Ast.CaseLine
(header
,code
) ->
980 Ast.CaseLine
(rule_elem header
,statement_dots code
)
981 | Ast.OptCase
(case
) -> Ast.OptCase
(case_line case
)) in
982 casefn all_functions
k c
987 (match Ast.unwrap t
with
988 Ast.FILEINFO
(old_file
,new_file
) ->
989 Ast.FILEINFO
(string_mcode old_file
, string_mcode new_file
)
990 | Ast.DECL
(stmt
) -> Ast.DECL
(statement stmt
)
991 | Ast.CODE
(stmt_dots
) -> Ast.CODE
(statement_dots stmt_dots
)
992 | Ast.ERRORWORDS
(exps
) -> Ast.ERRORWORDS
(List.map expression exps
)) in
993 topfn all_functions
k t
997 (*in many cases below, the thing is not even mcode, so we do nothing*)
998 Ast.FullTypeTag
(ft
) -> Ast.FullTypeTag
(fullType ft
)
999 | Ast.BaseTypeTag
(bt
) as x
-> x
1000 | Ast.StructUnionTag
(su
) as x
-> x
1001 | Ast.SignTag
(sgn
) as x
-> x
1002 | Ast.IdentTag
(id
) -> Ast.IdentTag
(ident id
)
1003 | Ast.ExpressionTag
(exp
) -> Ast.ExpressionTag
(expression exp
)
1004 | Ast.ConstantTag
(cst
) as x
-> x
1005 | Ast.UnaryOpTag
(unop
) as x
-> x
1006 | Ast.AssignOpTag
(asgnop
) as x
-> x
1007 | Ast.FixOpTag
(fixop
) as x
-> x
1008 | Ast.BinaryOpTag
(binop
) as x
-> x
1009 | Ast.ArithOpTag
(arithop
) as x
-> x
1010 | Ast.LogicalOpTag
(logop
) as x
-> x
1011 | Ast.InitTag
(decl
) -> Ast.InitTag
(initialiser decl
)
1012 | Ast.DeclarationTag
(decl
) -> Ast.DeclarationTag
(declaration decl
)
1013 | Ast.StorageTag
(stg
) as x
-> x
1014 | Ast.IncFileTag
(stg
) as x
-> x
1015 | Ast.Rule_elemTag
(rule
) -> Ast.Rule_elemTag
(rule_elem rule
)
1016 | Ast.StatementTag
(rule
) -> Ast.StatementTag
(statement rule
)
1017 | Ast.CaseLineTag
(case
) -> Ast.CaseLineTag
(case_line case
)
1018 | Ast.ConstVolTag
(cv
) as x
-> x
1019 | Ast.Token
(tok
,info
) as x
-> x
1020 | Ast.Pragma
(str
) as x
-> x
1021 | Ast.Code
(cd
) -> Ast.Code
(top_level cd
)
1022 | Ast.ExprDotsTag
(ed
) -> Ast.ExprDotsTag
(expression_dots ed
)
1023 | Ast.ParamDotsTag
(pd
) -> Ast.ParamDotsTag
(parameter_dots pd
)
1024 | Ast.StmtDotsTag
(sd
) -> Ast.StmtDotsTag
(statement_dots sd
)
1025 | Ast.DeclDotsTag
(sd
) -> Ast.DeclDotsTag
(declaration_dots sd
)
1026 | Ast.TypeCTag
(ty
) -> Ast.TypeCTag
(typeC ty
)
1027 | Ast.ParamTag
(param
) -> Ast.ParamTag
(parameterTypeDef param
)
1028 | Ast.SgrepStartTag
(tok
) as x
-> x
1029 | Ast.SgrepEndTag
(tok
) as x
-> x
in
1030 anyfn all_functions
k a
1033 {rebuilder_ident
= ident
;
1034 rebuilder_expression
= expression
;
1035 rebuilder_fullType
= fullType
;
1036 rebuilder_typeC
= typeC
;
1037 rebuilder_declaration
= declaration
;
1038 rebuilder_initialiser
= initialiser
;
1039 rebuilder_parameter
= parameterTypeDef
;
1040 rebuilder_parameter_list
= parameter_dots
;
1041 rebuilder_rule_elem
= rule_elem
;
1042 rebuilder_statement
= statement
;
1043 rebuilder_case_line
= case_line
;
1044 rebuilder_top_level
= top_level
;
1045 rebuilder_expression_dots
= expression_dots;
1046 rebuilder_statement_dots
= statement_dots
;
1047 rebuilder_declaration_dots
= declaration_dots
;
1048 rebuilder_define_param_dots
= define_param_dots
;
1049 rebuilder_define_param
= define_param
;
1050 rebuilder_define_parameters
= define_parameters
;
1051 rebuilder_anything
= anything
} in