1 (* Find a directive or comment at the end of a statement. Things with aft
2 given None, because they can accomodate their own directives or comments *)
4 module Ast0
= Ast0_cocci
5 module V0
= Visitor_ast0
6 module VT0
= Visitor_ast0_types
8 let call_right processor data s cont
=
9 match processor data
with
11 | Some
(pragmas
,data
) -> Some
(pragmas
,Ast0.rewrap s
(cont data
))
13 let left_mcode (a
,b
,info
,mcodekind
,d
) =
14 match (info
.Ast0.strings_before
,mcodekind
) with
15 ([],_
) | (_
,Ast0.PLUS
) -> None
16 | (l
,_
) -> Some
(l
,(a
,b
,{info
with Ast0.strings_before
= []},mcodekind
,d
))
18 let right_mcode (a
,b
,info
,mcodekind
,d
) =
19 match (info
.Ast0.strings_after
,mcodekind
) with
20 ([],_
) | (_
,Ast0.PLUS
) -> None
21 | (l
,_
) -> Some
(l
,(a
,b
,{info
with Ast0.strings_after
= []},mcodekind
,d
))
23 let update_before pragmas
(info
,x
) =
24 ({info
with Ast0.strings_before
= pragmas
@ info
.Ast0.strings_before
},
27 let update_after pragmas
(info
,x
) =
28 ({info
with Ast0.strings_after
= info
.Ast0.strings_after
@ pragmas
},
31 let rec right_decl d
=
32 match Ast0.unwrap d
with
33 Ast0.Init
(Some stg
,ty
,id
,eq
,ini
,sem
) ->
34 call_right right_mcode sem d
35 (function sem
-> Ast0.Init
(Some stg
,ty
,id
,eq
,ini
,sem
))
36 | Ast0.Init
(None
,ty
,id
,eq
,ini
,sem
) ->
37 call_right right_mcode sem d
38 (function sem
-> Ast0.Init
(None
,ty
,id
,eq
,ini
,sem
))
39 | Ast0.UnInit
(Some stg
,ty
,id
,sem
) ->
40 call_right right_mcode sem d
41 (function sem
-> Ast0.UnInit
(Some stg
,ty
,id
,sem
))
42 | Ast0.UnInit
(None
,ty
,id
,sem
) ->
43 call_right right_mcode sem d
44 (function sem
-> Ast0.UnInit
(None
,ty
,id
,sem
))
45 | Ast0.MacroDecl
(name
,lp
,args
,rp
,sem
) ->
46 call_right right_mcode sem d
47 (function sem
-> Ast0.MacroDecl
(name
,lp
,args
,rp
,sem
))
48 | Ast0.TyDecl
(ty
,sem
) ->
49 call_right right_mcode sem d
50 (function sem
-> Ast0.TyDecl
(ty
,sem
))
51 | Ast0.Typedef
(stg
,ty
,id
,sem
) ->
52 call_right right_mcode sem d
53 (function sem
-> Ast0.Typedef
(stg
,ty
,id
,sem
))
54 | Ast0.DisjDecl
(starter
,decls
,mids
,ender
) -> None
55 | Ast0.Ddots
(dots
,whencode
) -> None
56 | Ast0.OptDecl
(decl
) ->
57 call_right right_decl decl d
(function decl
-> Ast0.OptDecl
(decl
))
58 | Ast0.UniqueDecl
(decl
) ->
59 call_right right_decl decl d
(function decl
-> Ast0.UniqueDecl
(decl
))
61 let rec right_statement s
=
62 match Ast0.unwrap s
with
63 Ast0.FunDecl
(bef
,fi
,name
,lp
,params
,rp
,lbrace
,body
,rbrace
) -> None
64 | Ast0.Decl
(bef
,decl
) ->
65 call_right right_decl decl s
66 (function decl
-> Ast0.Decl
(bef
,decl
))
67 | Ast0.Seq
(lbrace
,body
,rbrace
) ->
68 call_right right_mcode rbrace s
69 (function rbrace
-> Ast0.Seq
(lbrace
,body
,rbrace
))
70 | Ast0.ExprStatement
(exp
,sem
) ->
71 call_right right_mcode sem s
72 (function sem
-> Ast0.ExprStatement
(exp
,sem
))
73 | Ast0.IfThen
(iff
,lp
,exp
,rp
,branch1
,aft
) -> None
74 | Ast0.IfThenElse
(iff
,lp
,exp
,rp
,branch1
,els
,branch2
,aft
) -> None
75 | Ast0.While
(whl
,lp
,exp
,rp
,body
,aft
) -> None
76 | Ast0.Do
(d
,body
,whl
,lp
,exp
,rp
,sem
) ->
77 call_right right_mcode sem s
78 (function sem
-> Ast0.Do
(d
,body
,whl
,lp
,exp
,rp
,sem
))
79 | Ast0.For
(fr
,lp
,e1
,sem1
,e2
,sem2
,e3
,rp
,body
,aft
) -> None
80 | Ast0.Iterator
(nm
,lp
,args
,rp
,body
,aft
) -> None
81 | Ast0.Switch
(switch
,lp
,exp
,rp
,lb
,cases
,rb
) ->
82 call_right right_mcode rb s
83 (function rb
-> Ast0.Switch
(switch
,lp
,exp
,rp
,lb
,cases
,rb
))
84 | Ast0.Break
(br
,sem
) ->
85 call_right right_mcode sem s
86 (function sem
-> Ast0.Break
(br
,sem
))
87 | Ast0.Continue
(cont
,sem
) ->
88 call_right right_mcode sem s
89 (function sem
-> Ast0.Continue
(cont
,sem
))
91 call_right right_mcode dd s
92 (function dd
-> Ast0.Label
(l
,dd
))
93 | Ast0.Goto
(goto
,l
,sem
) ->
94 call_right right_mcode sem s
95 (function sem
-> Ast0.Goto
(goto
,l
,sem
))
96 | Ast0.Return
(ret
,sem
) ->
97 call_right right_mcode sem s
98 (function sem
-> Ast0.Return
(ret
,sem
))
99 | Ast0.ReturnExpr
(ret
,exp
,sem
) ->
100 call_right right_mcode sem s
101 (function sem
-> Ast0.ReturnExpr
(ret
,exp
,sem
))
102 | Ast0.MetaStmt
(name
,pure
) ->
103 call_right right_mcode name s
104 (function name
-> Ast0.MetaStmt
(name
,pure
))
105 | Ast0.MetaStmtList
(name
,pure
) ->
106 call_right right_mcode name s
107 (function name
-> Ast0.MetaStmtList
(name
,pure
))
108 | Ast0.Disj
(starter
,statement_dots_list
,mids
,ender
) -> None
109 | Ast0.Nest
(starter
,stmt_dots
,ender
,whn
,multi
) -> None
110 (* the following are None, because they can't be adjacent to an aft node *)
111 | Ast0.Exp
(exp
) -> None
112 | Ast0.TopExp
(exp
) -> None
113 | Ast0.Ty
(ty
) -> None
114 | Ast0.TopInit
(init
) -> None
115 | Ast0.Dots
(d
,whn
) -> None
116 | Ast0.Circles
(d
,whn
) -> None
117 | Ast0.Stars
(d
,whn
) -> None
118 | Ast0.Include
(inc
,name
) ->
119 call_right right_mcode name s
120 (function name
-> Ast0.Include
(inc
,name
))
121 | Ast0.Define
(def
,id
,params
,body
) ->
122 call_right right_statement_dots body s
123 (function body
-> Ast0.Define
(def
,id
,params
,body
))
125 call_right right_statement re s
(function re
-> Ast0.OptStm
(re
))
126 | Ast0.UniqueStm
(re
) ->
127 call_right right_statement re s
(function re
-> Ast0.UniqueStm
(re
))
129 and right_statement_dots sd
=
130 match Ast0.unwrap sd
with
131 Ast0.DOTS
([]) -> failwith
"empty statement dots"
133 call_right right_statement s sd
134 (function s
-> Ast0.DOTS
(List.rev
(s
::r
)))
135 | _
-> failwith
"circles and stars not supported"
138 match Ast0.unwrap t
with
139 Ast0.ConstVol
(cv
,ty
) ->
140 call_right left_mcode cv t
(function cv
-> Ast0.ConstVol
(cv
,ty
))
141 | Ast0.BaseType
(ty
,strings
) ->
143 [] -> failwith
"empty strings in type"
145 call_right left_mcode s t
(function s
-> Ast0.BaseType
(ty
,s
::r
)))
146 | Ast0.Signed
(sign
,ty
) ->
147 call_right left_mcode sign t
(function sign
-> Ast0.Signed
(sign
,ty
))
148 | Ast0.Pointer
(ty
,star
) ->
149 call_right left_ty ty t
(function ty
-> Ast0.Pointer
(ty
,star
))
150 | Ast0.FunctionPointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
151 call_right left_ty ty t
152 (function ty
-> Ast0.FunctionPointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
))
153 | Ast0.FunctionType
(Some ty
,lp1
,params
,rp1
) ->
154 call_right left_ty ty t
155 (function ty
-> Ast0.FunctionType
(Some ty
,lp1
,params
,rp1
))
156 | Ast0.FunctionType
(None
,lp1
,params
,rp1
) ->
157 call_right left_mcode lp1 t
158 (function lp1
-> Ast0.FunctionType
(None
,lp1
,params
,rp1
))
159 | Ast0.Array
(ty
,lb
,size
,rb
) ->
160 call_right left_ty ty t
(function ty
-> Ast0.Array
(ty
,lb
,size
,rb
))
161 | Ast0.EnumName
(kind
,name
) ->
162 call_right left_mcode kind t
(function kind
-> Ast0.EnumName
(kind
,name
))
163 | Ast0.StructUnionName
(kind
,name
) ->
164 call_right left_mcode kind t
165 (function kind
-> Ast0.StructUnionName
(kind
,name
))
166 | Ast0.StructUnionDef
(ty
,lb
,decls
,rb
) ->
167 call_right left_ty ty t
168 (function ty
-> Ast0.StructUnionDef
(ty
,lb
,decls
,rb
))
169 | Ast0.TypeName
(name
) ->
170 call_right left_mcode name t
(function name
-> Ast0.TypeName
(name
))
171 | Ast0.MetaType
(name
,x
) ->
172 call_right left_mcode name t
(function name
-> Ast0.MetaType
(name
,x
))
173 | Ast0.DisjType
(starter
,types
,mids
,ender
) -> None
174 | Ast0.OptType
(ty
) ->
175 call_right left_ty ty t
(function ty
-> Ast0.OptType
(ty
))
176 | Ast0.UniqueType
(ty
) ->
177 call_right left_ty ty t
(function ty
-> Ast0.UniqueType
(ty
))
179 let rec left_ident i
=
180 match Ast0.unwrap i
with
182 call_right left_mcode name i
183 (function name
-> Ast0.Id
(name
))
184 | Ast0.MetaId
(name
,a
,b
) ->
185 call_right left_mcode name i
186 (function name
-> Ast0.MetaId
(name
,a
,b
))
187 | Ast0.MetaFunc
(name
,a
,b
) ->
188 call_right left_mcode name i
189 (function name
-> Ast0.MetaFunc
(name
,a
,b
))
190 | Ast0.MetaLocalFunc
(name
,a
,b
) ->
191 call_right left_mcode name i
192 (function name
-> Ast0.MetaLocalFunc
(name
,a
,b
))
193 | Ast0.OptIdent
(id
) ->
194 call_right left_ident id i
(function id
-> Ast0.OptIdent
(id
))
195 | Ast0.UniqueIdent
(id
) ->
196 call_right left_ident id i
(function id
-> Ast0.UniqueIdent
(id
))
198 let left_fundecl name fninfo
=
199 let fncall_right processor data cont
=
200 match processor data
with
202 | Some
(pragmas
,data
) -> Some
(pragmas
,cont data
,name
) in
205 (match left_ident name
with
207 | Some
(pragmas
,name
) -> Some
(pragmas
,fninfo
,name
))
208 | (Ast0.FStorage sto
)::x
->
209 fncall_right left_mcode sto
(function sto
-> (Ast0.FStorage sto
)::x
)
210 | (Ast0.FType ty
)::x
->
211 fncall_right left_ty ty
(function ty
-> (Ast0.FType ty
)::x
)
212 | (Ast0.FInline inl
)::x
->
213 fncall_right left_mcode inl
(function inl
-> (Ast0.FInline inl
)::x
)
214 | (Ast0.FAttr atr
)::x
->
215 fncall_right left_mcode atr
(function atr
-> (Ast0.FAttr atr
)::x
)
217 let rec left_decl decl
=
218 match Ast0.unwrap decl
with
219 Ast0.Init
(Some stg
,ty
,id
,eq
,ini
,sem
) ->
220 call_right left_mcode stg decl
221 (function stg
-> Ast0.Init
(Some stg
,ty
,id
,eq
,ini
,sem
))
222 | Ast0.Init
(None
,ty
,id
,eq
,ini
,sem
) ->
223 call_right left_ty ty decl
224 (function ty
-> Ast0.Init
(None
,ty
,id
,eq
,ini
,sem
))
225 | Ast0.UnInit
(Some stg
,ty
,id
,sem
) ->
226 call_right left_mcode stg decl
227 (function stg
-> Ast0.UnInit
(Some stg
,ty
,id
,sem
))
228 | Ast0.UnInit
(None
,ty
,id
,sem
) ->
229 call_right left_ty ty decl
230 (function ty
-> Ast0.UnInit
(None
,ty
,id
,sem
))
231 | Ast0.MacroDecl
(name
,lp
,args
,rp
,sem
) ->
232 call_right left_ident name decl
233 (function name
-> Ast0.MacroDecl
(name
,lp
,args
,rp
,sem
))
234 | Ast0.TyDecl
(ty
,sem
) ->
235 call_right left_ty ty decl
(function ty
-> Ast0.TyDecl
(ty
,sem
))
236 | Ast0.Typedef
(stg
,ty
,id
,sem
) ->
237 call_right left_mcode stg decl
238 (function stg
-> Ast0.Typedef
(stg
,ty
,id
,sem
))
239 | Ast0.DisjDecl
(starter
,decls
,mids
,ender
) -> None
240 | Ast0.Ddots
(dots
,whencode
) -> None
242 call_right left_decl d decl
(function decl
-> Ast0.OptDecl
(decl
))
243 | Ast0.UniqueDecl
(d
) ->
244 call_right left_decl d decl
(function decl
-> Ast0.UniqueDecl
(decl
))
247 let statement r k s
=
250 (match Ast0.unwrap
s with
251 Ast0.FunDecl
(bef
,fi
,name
,lp
,params
,rp
,lbrace
,body
,rbrace
) ->
252 (match left_fundecl name fi
with
253 None
-> Ast0.unwrap
s
254 | Some
(pragmas
,fi
,name
) ->
256 (update_after pragmas bef
,
257 fi
,name
,lp
,params
,rp
,lbrace
,body
,rbrace
))
258 | Ast0.Decl
(bef
,decl
) ->
259 (match left_decl decl
with
260 None
-> Ast0.unwrap
s
261 | Some
(pragmas
,decl
) ->
262 Ast0.Decl
(update_after pragmas bef
,decl
))
263 | Ast0.IfThen
(iff
,lp
,exp
,rp
,branch1
,aft
) ->
264 (match right_statement branch1
with
265 None
-> Ast0.unwrap
s
266 | Some
(pragmas
,branch1
) ->
268 (iff
,lp
,exp
,rp
,branch1
,update_before pragmas aft
))
269 | Ast0.IfThenElse
(iff
,lp
,exp
,rp
,branch1
,els
,branch2
,aft
) ->
270 (match right_statement branch2
with
271 None
-> Ast0.unwrap
s
272 | Some
(pragmas
,branch2
) ->
274 (iff
,lp
,exp
,rp
,branch1
,els
,branch2
,
275 update_before pragmas aft
))
276 | Ast0.While
(whl
,lp
,exp
,rp
,body
,aft
) ->
277 (match right_statement body
with
278 None
-> Ast0.unwrap
s
279 | Some
(pragmas
,body
) ->
280 Ast0.While
(whl
,lp
,exp
,rp
,body
,update_before pragmas aft
))
281 | Ast0.For
(fr
,lp
,e1
,sem1
,e2
,sem2
,e3
,rp
,body
,aft
) ->
282 (match right_statement body
with
283 None
-> Ast0.unwrap
s
284 | Some
(pragmas
,body
) ->
286 (fr
,lp
,e1
,sem1
,e2
,sem2
,e3
,rp
,body
,
287 update_before pragmas aft
))
288 | Ast0.Iterator
(nm
,lp
,args
,rp
,body
,aft
) ->
289 (match right_statement body
with
290 None
-> Ast0.unwrap
s
291 | Some
(pragmas
,body
) ->
292 Ast0.Iterator
(nm
,lp
,args
,rp
,body
,update_before pragmas aft
))
293 | _
-> Ast0.unwrap
s) in
295 let res = V0.rebuilder
296 {V0.rebuilder_functions
with VT0.rebuilder_stmtfn
= statement} in
298 List.map
res.VT0.rebuilder_rec_top_level