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_ast0.ml"
28 (* --------------------------------------------------------------------- *)
29 (* Generic traversal: rebuilder *)
31 module Ast
= Ast_cocci
32 module Ast0
= Ast0_cocci
33 module VT0
= Visitor_ast0_types
35 type mode
= COMBINER
| REBUILDER
| BOTH
37 let map_split f l
= List.split
(List.map f l
)
39 let rewrap x
(n
,e
) = (n
,Ast0.rewrap x e
)
41 let visitor mode bind option_default
42 meta_mcode string_mcode const_mcode assign_mcode fix_mcode unary_mcode
43 binary_mcode cv_mcode sign_mcode struct_mcode storage_mcode
45 dotsexprfn dotsinitfn dotsparamfn dotsstmtfn dotsdeclfn dotscasefn
46 identfn exprfn tyfn initfn paramfn declfn stmtfn forinfofn casefn topfn
=
48 let rec loop = function
51 | x
::xs
-> bind x
(loop xs
) in
53 let map_split_bind f l
=
54 let (n
,e
) = List.split
(List.map f l
) in (multibind n
,e
) in
55 let get_option f
= function
56 Some x
-> let (n
,e
) = f x
in (n
,Some e
)
57 | None
-> (option_default
,None
) in
58 let do_disj starter lst mids ender processor rebuilder
=
59 let (starter_n
,starter
) = string_mcode starter
in
60 let (lst_n
,lst
) = map_split processor lst
in
61 let (mids_n
,mids
) = map_split string_mcode mids
in
62 let (ender_n
,ender
) = string_mcode ender
in
64 [starter_n
;List.hd lst_n
;
65 multibind (List.map2 bind mids_n
(List.tl lst_n
));ender_n
],
66 rebuilder starter lst mids ender
) in
67 let rec expression_dots d
=
70 (match Ast0.unwrap d
with
72 let (n
,l
) = map_split_bind expression l
in (n
,Ast0.DOTS
(l
))
74 let (n
,l
) = map_split_bind expression l
in (n
,Ast0.CIRCLES
(l
))
76 let (n
,l
) = map_split_bind expression l
in (n
,Ast0.STARS
(l
))) in
77 dotsexprfn all_functions
k d
78 and initialiser_list i
=
81 (match Ast0.unwrap i
with
83 let (n
,l
) = map_split_bind initialiser l
in (n
,Ast0.DOTS
(l
))
85 let (n
,l
) = map_split_bind initialiser l
in (n
,Ast0.CIRCLES
(l
))
87 let (n
,l
) = map_split_bind initialiser l
in (n
,Ast0.STARS
(l
))) in
88 dotsinitfn all_functions
k i
90 and parameter_list d
=
93 (match Ast0.unwrap d
with
95 let (n
,l
) = map_split_bind parameterTypeDef l
in
98 let (n
,l
) = map_split_bind parameterTypeDef l
in
101 let (n
,l
) = map_split_bind parameterTypeDef l
in
102 (n
,Ast0.STARS
(l
))) in
103 dotsparamfn all_functions
k d
105 and statement_dots d
=
108 (match Ast0.unwrap d
with
110 let (n
,l
) = map_split_bind statement l
in (n
,Ast0.DOTS
(l
))
112 let (n
,l
) = map_split_bind statement l
in (n
,Ast0.CIRCLES
(l
))
114 let (n
,l
) = map_split_bind statement l
in (n
,Ast0.STARS
(l
))) in
115 dotsstmtfn all_functions
k d
117 and declaration_dots d
=
120 (match Ast0.unwrap d
with
122 let (n
,l
) = map_split_bind declaration l
in (n
, Ast0.DOTS
(l
))
124 let (n
,l
) = map_split_bind declaration l
in (n
, Ast0.CIRCLES
(l
))
126 let (n
,l
) = map_split_bind declaration l
in (n
, Ast0.STARS
(l
))) in
127 dotsdeclfn all_functions
k d
129 and case_line_dots d
=
132 (match Ast0.unwrap d
with
134 let (n
,l
) = map_split_bind case_line l
in (n
, Ast0.DOTS
(l
))
136 let (n
,l
) = map_split_bind case_line l
in (n
, Ast0.CIRCLES
(l
))
138 let (n
,l
) = map_split_bind case_line l
in (n
, Ast0.STARS
(l
))) in
139 dotscasefn all_functions
k d
144 (match Ast0.unwrap i
with
146 let (n
,name
) = string_mcode name
in (n
,Ast0.Id
(name
))
147 | Ast0.MetaId
(name
,constraints
,seed
,pure
) ->
148 let (n
,name
) = meta_mcode name
in
149 (n
,Ast0.MetaId
(name
,constraints
,seed
,pure
))
150 | Ast0.MetaFunc
(name
,constraints
,pure
) ->
151 let (n
,name
) = meta_mcode name
in
152 (n
,Ast0.MetaFunc
(name
,constraints
,pure
))
153 | Ast0.MetaLocalFunc
(name
,constraints
,pure
) ->
154 let (n
,name
) = meta_mcode name
in
155 (n
,Ast0.MetaLocalFunc
(name
,constraints
,pure
))
156 | Ast0.DisjId
(starter
,id_list
,mids
,ender
) ->
157 do_disj starter id_list mids ender ident
158 (fun starter id_list mids ender
->
159 Ast0.DisjId
(starter
,id_list
,mids
,ender
))
160 | Ast0.OptIdent
(id
) ->
161 let (n
,id
) = ident id
in (n
,Ast0.OptIdent
(id
))
162 | Ast0.UniqueIdent
(id
) ->
163 let (n
,id
) = ident id
in (n
,Ast0.UniqueIdent
(id
))
164 | Ast0.AsIdent
(id
,asid
) ->
165 let (id_n
,id
) = ident id
in
166 let (asid_n
,asid
) = ident asid
in
167 (bind id_n asid_n
, Ast0.AsIdent
(id
,asid
))) in
168 identfn all_functions
k i
173 (match Ast0.unwrap e
with
175 let (n
,id
) = ident id
in (n
,Ast0.Ident
(id
))
176 | Ast0.Constant
(const
) ->
177 let (n
,const
) = const_mcode const
in (n
,Ast0.Constant
(const
))
178 | Ast0.FunCall
(fn
,lp
,args
,rp
) ->
179 let (fn_n
,fn
) = expression fn
in
180 let (lp_n
,lp
) = string_mcode lp
in
181 let (args_n
,args
) = expression_dots args
in
182 let (rp_n
,rp
) = string_mcode rp
in
183 (multibind [fn_n
;lp_n
;args_n
;rp_n
], Ast0.FunCall
(fn
,lp
,args
,rp
))
184 | Ast0.Assignment
(left
,op
,right
,simple
) ->
185 let (left_n
,left
) = expression left
in
186 let (op_n
,op
) = assign_mcode op
in
187 let (right_n
,right
) = expression right
in
188 (multibind [left_n
;op_n
;right_n
],
189 Ast0.Assignment
(left
,op
,right
,simple
))
190 | Ast0.Sequence
(left
,op
,right
) ->
191 let (left_n
,left
) = expression left
in
192 let (op_n
,op
) = string_mcode op
in
193 let (right_n
,right
) = expression right
in
194 (multibind [left_n
;op_n
;right_n
],
195 Ast0.Sequence
(left
,op
,right
))
196 | Ast0.CondExpr
(exp1
,why
,exp2
,colon
,exp3
) ->
197 let (exp1_n
,exp1
) = expression exp1
in
198 let (why_n
,why
) = string_mcode why
in
199 let (exp2_n
,exp2
) = get_option expression exp2
in
200 let (colon_n
,colon
) = string_mcode colon
in
201 let (exp3_n
,exp3
) = expression exp3
in
202 (multibind [exp1_n
;why_n
;exp2_n
;colon_n
;exp3_n
],
203 Ast0.CondExpr
(exp1
,why
,exp2
,colon
,exp3
))
204 | Ast0.Postfix
(exp
,op
) ->
205 let (exp_n
,exp
) = expression exp
in
206 let (op_n
,op
) = fix_mcode op
in
207 (bind exp_n op_n
, Ast0.Postfix
(exp
,op
))
208 | Ast0.Infix
(exp
,op
) ->
209 let (exp_n
,exp
) = expression exp
in
210 let (op_n
,op
) = fix_mcode op
in
211 (bind op_n exp_n
, Ast0.Infix
(exp
,op
))
212 | Ast0.Unary
(exp
,op
) ->
213 let (exp_n
,exp
) = expression exp
in
214 let (op_n
,op
) = unary_mcode op
in
215 (bind op_n exp_n
, Ast0.Unary
(exp
,op
))
216 | Ast0.Binary
(left
,op
,right
) ->
217 let (left_n
,left
) = expression left
in
218 let (op_n
,op
) = binary_mcode op
in
219 let (right_n
,right
) = expression right
in
220 (multibind [left_n
;op_n
;right_n
], Ast0.Binary
(left
,op
,right
))
221 | Ast0.Nested
(left
,op
,right
) ->
222 let (left_n
,left
) = expression left
in
223 let (op_n
,op
) = binary_mcode op
in
224 let (right_n
,right
) = expression right
in
225 (multibind [left_n
;op_n
;right_n
], Ast0.Nested
(left
,op
,right
))
226 | Ast0.Paren
(lp
,exp
,rp
) ->
227 let (lp_n
,lp
) = string_mcode lp
in
228 let (exp_n
,exp
) = expression exp
in
229 let (rp_n
,rp
) = string_mcode rp
in
230 (multibind [lp_n
;exp_n
;rp_n
], Ast0.Paren
(lp
,exp
,rp
))
231 | Ast0.ArrayAccess
(exp1
,lb
,exp2
,rb
) ->
232 let (exp1_n
,exp1
) = expression exp1
in
233 let (lb_n
,lb
) = string_mcode lb
in
234 let (exp2_n
,exp2
) = expression exp2
in
235 let (rb_n
,rb
) = string_mcode rb
in
236 (multibind [exp1_n
;lb_n
;exp2_n
;rb_n
],
237 Ast0.ArrayAccess
(exp1
,lb
,exp2
,rb
))
238 | Ast0.RecordAccess
(exp
,pt
,field
) ->
239 let (exp_n
,exp
) = expression exp
in
240 let (pt_n
,pt
) = string_mcode pt
in
241 let (field_n
,field
) = ident field
in
242 (multibind [exp_n
;pt_n
;field_n
], Ast0.RecordAccess
(exp
,pt
,field
))
243 | Ast0.RecordPtAccess
(exp
,ar
,field
) ->
244 let (exp_n
,exp
) = expression exp
in
245 let (ar_n
,ar
) = string_mcode ar
in
246 let (field_n
,field
) = ident field
in
247 (multibind [exp_n
;ar_n
;field_n
], Ast0.RecordPtAccess
(exp
,ar
,field
))
248 | Ast0.Cast
(lp
,ty
,rp
,exp
) ->
249 let (lp_n
,lp
) = string_mcode lp
in
250 let (ty_n
,ty
) = typeC ty
in
251 let (rp_n
,rp
) = string_mcode rp
in
252 let (exp_n
,exp
) = expression exp
in
253 (multibind [lp_n
;ty_n
;rp_n
;exp_n
], Ast0.Cast
(lp
,ty
,rp
,exp
))
254 | Ast0.SizeOfExpr
(szf
,exp
) ->
255 let (szf_n
,szf
) = string_mcode szf
in
256 let (exp_n
,exp
) = expression exp
in
257 (multibind [szf_n
;exp_n
],Ast0.SizeOfExpr
(szf
,exp
))
258 | Ast0.SizeOfType
(szf
,lp
,ty
,rp
) ->
259 let (szf_n
,szf
) = string_mcode szf
in
260 let (lp_n
,lp
) = string_mcode lp
in
261 let (ty_n
,ty
) = typeC ty
in
262 let (rp_n
,rp
) = string_mcode rp
in
263 (multibind [szf_n
;lp_n
;ty_n
;rp_n
], Ast0.SizeOfType
(szf
,lp
,ty
,rp
))
264 | Ast0.TypeExp
(ty
) ->
265 let (ty_n
,ty
) = typeC ty
in
266 (ty_n
,Ast0.TypeExp
(ty
))
267 | Ast0.Constructor
(lp
,ty
,rp
,init
) ->
268 let (lp_n
,lp
) = string_mcode lp
in
269 let (ty_n
,ty
) = typeC ty
in
270 let (rp_n
,rp
) = string_mcode rp
in
271 let (init_n
,init
) = initialiser init
in
272 (multibind [lp_n
;ty_n
;rp_n
;init_n
], Ast0.Constructor
(lp
,ty
,rp
,init
))
273 | Ast0.MetaErr
(name
,constraints
,pure
) ->
274 let (name_n
,name
) = meta_mcode name
in
275 (name_n
,Ast0.MetaErr
(name
,constraints
,pure
))
276 | Ast0.MetaExpr
(name
,constraints
,ty
,form
,pure
) ->
277 let (name_n
,name
) = meta_mcode name
in
278 (name_n
,Ast0.MetaExpr
(name
,constraints
,ty
,form
,pure
))
279 | Ast0.MetaExprList
(name
,lenname
,pure
) ->
280 let (name_n
,name
) = meta_mcode name
in
281 (name_n
,Ast0.MetaExprList
(name
,lenname
,pure
))
283 let (cm_n
,cm
) = string_mcode cm
in (cm_n
,Ast0.EComma
(cm
))
284 | Ast0.DisjExpr
(starter
,expr_list
,mids
,ender
) ->
285 do_disj starter expr_list mids ender expression
286 (fun starter expr_list mids ender
->
287 Ast0.DisjExpr
(starter
,expr_list
,mids
,ender
))
288 | Ast0.NestExpr
(starter
,expr_dots
,ender
,whencode
,multi
) ->
289 let (starter_n
,starter
) = string_mcode starter
in
290 let (expr_dots_n
,expr_dots
) = expression_dots expr_dots
in
291 let (ender_n
,ender
) = string_mcode ender
in
292 let (whencode_n
,whencode
) = get_option expression whencode
in
293 (multibind [starter_n
;expr_dots_n
;ender_n
;whencode_n
],
294 Ast0.NestExpr
(starter
,expr_dots
,ender
,whencode
,multi
))
295 | Ast0.Edots
(dots
,whencode
) ->
296 let (dots_n
,dots
) = string_mcode dots
in
297 let (whencode_n
,whencode
) = get_option expression whencode
in
298 (bind dots_n whencode_n
,Ast0.Edots
(dots
,whencode
))
299 | Ast0.Ecircles
(dots
,whencode
) ->
300 let (dots_n
,dots
) = string_mcode dots
in
301 let (whencode_n
,whencode
) = get_option expression whencode
in
302 (bind dots_n whencode_n
,Ast0.Ecircles
(dots
,whencode
))
303 | Ast0.Estars
(dots
,whencode
) ->
304 let (dots_n
,dots
) = string_mcode dots
in
305 let (whencode_n
,whencode
) = get_option expression whencode
in
306 (bind dots_n whencode_n
,Ast0.Estars
(dots
,whencode
))
307 | Ast0.OptExp
(exp
) ->
308 let (exp_n
,exp
) = expression exp
in
309 (exp_n
,Ast0.OptExp
(exp
))
310 | Ast0.UniqueExp
(exp
) ->
311 let (exp_n
,exp
) = expression exp
in
312 (exp_n
,Ast0.UniqueExp
(exp
))
313 | Ast0.AsExpr
(exp
,asexp
) ->
314 let (exp_n
,exp
) = expression exp
in
315 let (asexp_n
,asexp
) = expression asexp
in
316 (bind exp_n asexp_n
, Ast0.AsExpr
(exp
,asexp
))) in
317 exprfn all_functions
k e
321 (match Ast0.unwrap t
with
322 Ast0.ConstVol
(cv
,ty
) ->
323 let (cv_n
,cv
) = cv_mcode cv
in
324 let (ty_n
,ty
) = typeC ty
in
326 (* bind in the right order *)
327 match Ast0.unwrap ty
with
328 Ast0.Pointer
(ty
,star
) -> bind ty_n cv_n
329 | _
-> bind cv_n ty_n
in
330 (front, Ast0.ConstVol
(cv
,ty
))
331 | Ast0.BaseType
(ty
,strings
) ->
332 let (strings_n
,strings
) = map_split_bind string_mcode strings
in
333 (strings_n
, Ast0.BaseType
(ty
,strings
))
334 | Ast0.Signed
(sign
,ty
) ->
335 let (sign_n
,sign
) = sign_mcode sign
in
336 let (ty_n
,ty
) = get_option typeC ty
in
337 (bind sign_n ty_n
, Ast0.Signed
(sign
,ty
))
338 | Ast0.Pointer
(ty
,star
) ->
339 let (ty_n
,ty
) = typeC ty
in
340 let (star_n
,star
) = string_mcode star
in
341 (bind ty_n star_n
, Ast0.Pointer
(ty
,star
))
342 | Ast0.FunctionPointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
343 function_pointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) []
344 | Ast0.FunctionType
(ty
,lp1
,params
,rp1
) ->
345 function_type
(ty
,lp1
,params
,rp1
) []
346 | Ast0.Array
(ty
,lb
,size
,rb
) -> array_type
(ty
,lb
,size
,rb
) []
347 | Ast0.EnumName
(kind
,name
) ->
348 let (kind_n
,kind
) = string_mcode kind
in
349 let (name_n
,name
) = get_option ident name
in
350 (bind kind_n name_n
, Ast0.EnumName
(kind
,name
))
351 | Ast0.EnumDef
(ty
,lb
,ids
,rb
) ->
352 let (ty_n
,ty
) = typeC ty
in
353 let (lb_n
,lb
) = string_mcode lb
in
354 let (ids_n
,ids
) = expression_dots ids
in
355 let (rb_n
,rb
) = string_mcode rb
in
356 (multibind [ty_n
;lb_n
;ids_n
;rb_n
], Ast0.EnumDef
(ty
,lb
,ids
,rb
))
357 | Ast0.StructUnionName
(kind
,name
) ->
358 let (kind_n
,kind
) = struct_mcode kind
in
359 let (name_n
,name
) = get_option ident name
in
360 (bind kind_n name_n
, Ast0.StructUnionName
(kind
,name
))
361 | Ast0.StructUnionDef
(ty
,lb
,decls
,rb
) ->
362 let (ty_n
,ty
) = typeC ty
in
363 let (lb_n
,lb
) = string_mcode lb
in
364 let (decls_n
,decls
) = declaration_dots decls
in
365 let (rb_n
,rb
) = string_mcode rb
in
366 (multibind [ty_n
;lb_n
;decls_n
;rb_n
],
367 Ast0.StructUnionDef
(ty
,lb
,decls
,rb
))
368 | Ast0.TypeName
(name
) ->
369 let (name_n
,name
) = string_mcode name
in
370 (name_n
,Ast0.TypeName
(name
))
371 | Ast0.MetaType
(name
,pure
) ->
372 let (name_n
,name
) = meta_mcode name
in
373 (name_n
,Ast0.MetaType
(name
,pure
))
374 | Ast0.DisjType
(starter
,types
,mids
,ender
) ->
375 do_disj starter types mids ender typeC
376 (fun starter types mids ender
->
377 Ast0.DisjType
(starter
,types
,mids
,ender
))
378 | Ast0.OptType
(ty
) ->
379 let (ty_n
,ty
) = typeC ty
in (ty_n
, Ast0.OptType
(ty
))
380 | Ast0.UniqueType
(ty
) ->
381 let (ty_n
,ty
) = typeC ty
in (ty_n
, Ast0.UniqueType
(ty
))
382 | Ast0.AsType
(ty
,asty
) ->
383 let (ty_n
,ty
) = typeC ty
in
384 let (asty_n
,asty
) = typeC asty
in
385 (bind ty_n asty_n
, Ast0.AsType
(ty
,asty
))) in
386 tyfn all_functions
k t
388 and function_pointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) extra
=
389 let (ty_n
,ty
) = typeC ty
in
390 let (lp1_n
,lp1
) = string_mcode lp1
in
391 let (star_n
,star
) = string_mcode star
in
392 let (rp1_n
,rp1
) = string_mcode rp1
in
393 let (lp2_n
,lp2
) = string_mcode lp2
in
394 let (params_n
,params
) = parameter_list params
in
395 let (rp2_n
,rp2
) = string_mcode rp2
in
396 (* have to put the treatment of the identifier into the right position *)
397 (multibind ([ty_n
;lp1_n
;star_n
] @ extra
@ [rp1_n
;lp2_n
;params_n
;rp2_n
]),
398 Ast0.FunctionPointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
))
399 and function_type
(ty
,lp1
,params
,rp1
) extra
=
400 let (ty_n
,ty
) = get_option typeC ty
in
401 let (lp1_n
,lp1
) = string_mcode lp1
in
402 let (params_n
,params
) = parameter_list params
in
403 let (rp1_n
,rp1
) = string_mcode rp1
in
404 (* have to put the treatment of the identifier into the right position *)
405 (multibind (ty_n
:: extra
@ [lp1_n
;params_n
;rp1_n
]),
406 Ast0.FunctionType
(ty
,lp1
,params
,rp1
))
407 and array_type
(ty
,lb
,size
,rb
) extra
=
408 let (ty_n
,ty
) = typeC ty
in
409 let (lb_n
,lb
) = string_mcode lb
in
410 let (size_n
,size
) = get_option expression size
in
411 let (rb_n
,rb
) = string_mcode rb
in
412 (multibind (ty_n
:: extra
@ [lb_n
;size_n
;rb_n
]),
413 Ast0.Array
(ty
,lb
,size
,rb
))
415 and named_type ty id
=
416 let (id_n
,id
) = ident id
in
417 match Ast0.unwrap ty
with
418 Ast0.FunctionPointer
(rty
,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
420 function_pointer
(rty
,lp1
,star
,rp1
,lp2
,params
,rp2
) [id_n
] in
421 (rewrap ty
tyres, id
)
422 | Ast0.FunctionType
(rty
,lp1
,params
,rp1
) ->
423 let tyres = function_type
(rty
,lp1
,params
,rp1
) [id_n
] in
424 (rewrap ty
tyres, id
)
425 | Ast0.Array
(rty
,lb
,size
,rb
) ->
426 let tyres = array_type
(rty
,lb
,size
,rb
) [id_n
] in
427 (rewrap ty
tyres, id
)
428 | _
-> let (ty_n
,ty
) = typeC ty
in ((bind ty_n id_n
, ty
), id
)
433 (match Ast0.unwrap d
with
434 Ast0.MetaDecl
(name
,pure
) ->
435 let (n
,name
) = meta_mcode name
in
436 (n
,Ast0.MetaDecl
(name
,pure
))
437 | Ast0.MetaField
(name
,pure
) ->
438 let (n
,name
) = meta_mcode name
in
439 (n
,Ast0.MetaField
(name
,pure
))
440 | Ast0.MetaFieldList
(name
,lenname
,pure
) ->
441 let (n
,name
) = meta_mcode name
in
442 (n
,Ast0.MetaFieldList
(name
,lenname
,pure
))
443 | Ast0.Init
(stg
,ty
,id
,eq
,ini
,sem
) ->
444 let (stg_n
,stg
) = get_option storage_mcode stg
in
445 let ((ty_id_n
,ty
),id
) = named_type ty id
in
446 let (eq_n
,eq
) = string_mcode eq
in
447 let (ini_n
,ini
) = initialiser ini
in
448 let (sem_n
,sem
) = string_mcode sem
in
449 (multibind [stg_n
;ty_id_n
;eq_n
;ini_n
;sem_n
],
450 Ast0.Init
(stg
,ty
,id
,eq
,ini
,sem
))
451 | Ast0.UnInit
(stg
,ty
,id
,sem
) ->
452 let (stg_n
,stg
) = get_option storage_mcode stg
in
453 let ((ty_id_n
,ty
),id
) = named_type ty id
in
454 let (sem_n
,sem
) = string_mcode sem
in
455 (multibind [stg_n
;ty_id_n
;sem_n
], Ast0.UnInit
(stg
,ty
,id
,sem
))
456 | Ast0.MacroDecl
(name
,lp
,args
,rp
,sem
) ->
457 let (name_n
,name
) = ident name
in
458 let (lp_n
,lp
) = string_mcode lp
in
459 let (args_n
,args
) = expression_dots args
in
460 let (rp_n
,rp
) = string_mcode rp
in
461 let (sem_n
,sem
) = string_mcode sem
in
462 (multibind [name_n
;lp_n
;args_n
;rp_n
;sem_n
],
463 Ast0.MacroDecl
(name
,lp
,args
,rp
,sem
))
464 | Ast0.MacroDeclInit
(name
,lp
,args
,rp
,eq
,ini
,sem
) ->
465 let (name_n
,name
) = ident name
in
466 let (lp_n
,lp
) = string_mcode lp
in
467 let (args_n
,args
) = expression_dots args
in
468 let (rp_n
,rp
) = string_mcode rp
in
469 let (eq_n
,eq
) = string_mcode eq
in
470 let (ini_n
,ini
) = initialiser ini
in
471 let (sem_n
,sem
) = string_mcode sem
in
472 (multibind [name_n
;lp_n
;args_n
;rp_n
;eq_n
;ini_n
;sem_n
],
473 Ast0.MacroDeclInit
(name
,lp
,args
,rp
,eq
,ini
,sem
))
474 | Ast0.TyDecl
(ty
,sem
) ->
475 let (ty_n
,ty
) = typeC ty
in
476 let (sem_n
,sem
) = string_mcode sem
in
477 (bind ty_n sem_n
, Ast0.TyDecl
(ty
,sem
))
478 | Ast0.Typedef
(stg
,ty
,id
,sem
) ->
479 let (stg_n
,stg
) = string_mcode stg
in
480 let (ty_n
,ty
) = typeC ty
in
481 let (id_n
,id
) = typeC id
in
482 let (sem_n
,sem
) = string_mcode sem
in
483 (multibind [stg_n
;ty_n
;id_n
;sem_n
], Ast0.Typedef
(stg
,ty
,id
,sem
))
484 | Ast0.DisjDecl
(starter
,decls
,mids
,ender
) ->
485 do_disj starter decls mids ender declaration
486 (fun starter decls mids ender
->
487 Ast0.DisjDecl
(starter
,decls
,mids
,ender
))
488 | Ast0.Ddots
(dots
,whencode
) ->
489 let (dots_n
,dots
) = string_mcode dots
in
490 let (whencode_n
,whencode
) = get_option declaration whencode
in
491 (bind dots_n whencode_n
, Ast0.Ddots
(dots
,whencode
))
492 | Ast0.OptDecl
(decl
) ->
493 let (n
,decl
) = declaration decl
in (n
,Ast0.OptDecl
(decl
))
494 | Ast0.UniqueDecl
(decl
) ->
495 let (n
,decl
) = declaration decl
in (n
,Ast0.UniqueDecl
(decl
))
496 | Ast0.AsDecl
(decl
,asdecl
) ->
497 let (decl_n
,decl
) = declaration decl
in
498 let (asdecl_n
,asdecl
) = declaration asdecl
in
499 (bind decl_n asdecl_n
, Ast0.AsDecl
(decl
,asdecl
))) in
500 declfn all_functions
k d
505 (match Ast0.unwrap i
with
506 Ast0.MetaInit
(name
,pure
) ->
507 let (name_n
,name
) = meta_mcode name
in
508 (name_n
,Ast0.MetaInit
(name
,pure
))
509 | Ast0.MetaInitList
(name
,lenname
,pure
) ->
510 let (name_n
,name
) = meta_mcode name
in
511 (name_n
,Ast0.MetaInitList
(name
,lenname
,pure
))
512 | Ast0.InitExpr
(exp
) ->
513 let (exp_n
,exp
) = expression exp
in
514 (exp_n
,Ast0.InitExpr
(exp
))
515 | Ast0.InitList
(lb
,initlist
,rb
,ordered
) ->
516 let (lb_n
,lb
) = string_mcode lb
in
517 let (initlist_n
,initlist
) = initialiser_list initlist
in
518 let (rb_n
,rb
) = string_mcode rb
in
519 (multibind [lb_n
;initlist_n
;rb_n
],
520 Ast0.InitList
(lb
,initlist
,rb
,ordered
))
521 | Ast0.InitGccExt
(designators
,eq
,ini
) ->
522 let (dn
,designators
) = map_split_bind designator designators
in
523 let (eq_n
,eq
) = string_mcode eq
in
524 let (ini_n
,ini
) = initialiser ini
in
525 (multibind [dn
;eq_n
;ini_n
], Ast0.InitGccExt
(designators
,eq
,ini
))
526 | Ast0.InitGccName
(name
,eq
,ini
) ->
527 let (name_n
,name
) = ident name
in
528 let (eq_n
,eq
) = string_mcode eq
in
529 let (ini_n
,ini
) = initialiser ini
in
530 (multibind [name_n
;eq_n
;ini_n
], Ast0.InitGccName
(name
,eq
,ini
))
532 let (n
,cm
) = string_mcode cm
in (n
,Ast0.IComma
(cm
))
533 | Ast0.Idots
(d
,whencode
) ->
534 let (d_n
,d
) = string_mcode d
in
535 let (whencode_n
,whencode
) = get_option initialiser whencode
in
536 (bind d_n whencode_n
, Ast0.Idots
(d
,whencode
))
538 let (n
,i
) = initialiser i
in (n
,Ast0.OptIni
(i
))
539 | Ast0.UniqueIni
(i
) ->
540 let (n
,i
) = initialiser i
in (n
,Ast0.UniqueIni
(i
))
541 | Ast0.AsInit
(ini
,asini
) ->
542 let (ini_n
,ini
) = initialiser ini
in
543 let (asini_n
,asini
) = initialiser asini
in
544 (bind ini_n asini_n
, Ast0.AsInit
(ini
,asini
))) in
545 initfn all_functions
k i
547 and designator
= function
548 Ast0.DesignatorField
(dot
,id
) ->
549 let (dot_n
,dot
) = string_mcode dot
in
550 let (id_n
,id
) = ident id
in
551 (bind dot_n id_n
, Ast0.DesignatorField
(dot
,id
))
552 | Ast0.DesignatorIndex
(lb
,exp
,rb
) ->
553 let (lb_n
,lb
) = string_mcode lb
in
554 let (exp_n
,exp
) = expression exp
in
555 let (rb_n
,rb
) = string_mcode rb
in
556 (multibind [lb_n
;exp_n
;rb_n
], Ast0.DesignatorIndex
(lb
,exp
,rb
))
557 | Ast0.DesignatorRange
(lb
,min
,dots
,max
,rb
) ->
558 let (lb_n
,lb
) = string_mcode lb
in
559 let (min_n
,min
) = expression min
in
560 let (dots_n
,dots
) = string_mcode dots
in
561 let (max_n
,max
) = expression max
in
562 let (rb_n
,rb
) = string_mcode rb
in
563 (multibind [lb_n
;min_n
;dots_n
;max_n
;rb_n
],
564 Ast0.DesignatorRange
(lb
,min
,dots
,max
,rb
))
566 and parameterTypeDef p
=
569 (match Ast0.unwrap p
with
570 Ast0.VoidParam
(ty
) ->
571 let (n
,ty
) = typeC ty
in (n
,Ast0.VoidParam
(ty
))
572 | Ast0.Param
(ty
,Some id
) ->
573 let ((ty_id_n
,ty
),id
) = named_type ty id
in
574 (ty_id_n
, Ast0.Param
(ty
,Some id
))
575 | Ast0.Param
(ty
,None
) ->
576 let (ty_n
,ty
) = typeC ty
in
577 (ty_n
, Ast0.Param
(ty
,None
))
578 | Ast0.MetaParam
(name
,pure
) ->
579 let (n
,name
) = meta_mcode name
in
580 (n
,Ast0.MetaParam
(name
,pure
))
581 | Ast0.MetaParamList
(name
,lenname
,pure
) ->
582 let (n
,name
) = meta_mcode name
in
583 (n
,Ast0.MetaParamList
(name
,lenname
,pure
))
584 | Ast0.AsParam
(p
,asexp
) ->
585 let (p_n
,p
) = parameterTypeDef p
in
586 let (asexp_n
,asexp
) = expression asexp
in
587 (bind p_n asexp_n
, Ast0.AsParam
(p
,asexp
))
589 let (n
,cm
) = string_mcode cm
in (n
,Ast0.PComma
(cm
))
590 | Ast0.Pdots
(dots
) ->
591 let (n
,dots
) = string_mcode dots
in (n
,Ast0.Pdots
(dots
))
592 | Ast0.Pcircles
(dots
) ->
593 let (n
,dots
) = string_mcode dots
in (n
,Ast0.Pcircles
(dots
))
594 | Ast0.OptParam
(param
) ->
595 let (n
,param
) = parameterTypeDef param
in (n
,Ast0.OptParam
(param
))
596 | Ast0.UniqueParam
(param
) ->
597 let (n
,param
) = parameterTypeDef param
in
598 (n
,Ast0.UniqueParam
(param
))) in
599 paramfn all_functions
k p
601 (* not done for combiner, because the statement is assumed to be already
602 represented elsewhere in the code *)
603 (* NOTE: This is not called for combiner_rebuilder. This is ok for its
605 and process_bef_aft s
=
606 Ast0.set_dots_bef_aft s
607 (match Ast0.get_dots_bef_aft s
with
608 Ast0.NoDots
-> Ast0.NoDots
609 | Ast0.DroppingBetweenDots
(stm
) ->
610 let (_
,stm
) = statement stm
in Ast0.DroppingBetweenDots
(stm
)
611 | Ast0.AddingBetweenDots
(stm
) ->
612 let (_
,stm
) = statement stm
in Ast0.AddingBetweenDots
(stm
))
615 (if mode
= COMBINER
then let _ = process_bef_aft s
in ());
618 (match Ast0.unwrap s
with
619 Ast0.FunDecl
(bef
,fi
,name
,lp
,params
,rp
,lbrace
,body
,rbrace
) ->
620 let (fi_n
,fi
) = map_split_bind fninfo fi
in
621 let (name_n
,name
) = ident name
in
622 let (lp_n
,lp
) = string_mcode lp
in
623 let (params_n
,params
) = parameter_list params
in
624 let (rp_n
,rp
) = string_mcode rp
in
625 let (lbrace_n
,lbrace
) = string_mcode lbrace
in
626 let (body_n
,body
) = statement_dots body
in
627 let (rbrace_n
,rbrace
) = string_mcode rbrace
in
629 [fi_n
;name_n
;lp_n
;params_n
;rp_n
;lbrace_n
;body_n
;rbrace_n
],
630 Ast0.FunDecl
(bef
,fi
,name
,lp
,params
,rp
,lbrace
,body
,rbrace
))
631 | Ast0.Decl
(bef
,decl
) ->
632 let (decl_n
,decl
) = declaration decl
in
633 (decl_n
,Ast0.Decl
(bef
,decl
))
634 | Ast0.Seq
(lbrace
,body
,rbrace
) ->
635 let (lbrace_n
,lbrace
) = string_mcode lbrace
in
636 let (body_n
,body
) = statement_dots body
in
637 let (rbrace_n
,rbrace
) = string_mcode rbrace
in
638 (multibind [lbrace_n
;body_n
;rbrace_n
],
639 Ast0.Seq
(lbrace
,body
,rbrace
))
640 | Ast0.ExprStatement
(exp
,sem
) ->
641 let (exp_n
,exp
) = get_option expression exp
in
642 let (sem_n
,sem
) = string_mcode sem
in
643 (bind exp_n sem_n
, Ast0.ExprStatement
(exp
,sem
))
644 | Ast0.IfThen
(iff
,lp
,exp
,rp
,branch1
,aft
) ->
645 let (iff_n
,iff
) = string_mcode iff
in
646 let (lp_n
,lp
) = string_mcode lp
in
647 let (exp_n
,exp
) = expression exp
in
648 let (rp_n
,rp
) = string_mcode rp
in
649 let (branch1_n
,branch1
) = statement branch1
in
650 (multibind [iff_n
;lp_n
;exp_n
;rp_n
;branch1_n
],
651 Ast0.IfThen
(iff
,lp
,exp
,rp
,branch1
,aft
))
652 | Ast0.IfThenElse
(iff
,lp
,exp
,rp
,branch1
,els
,branch2
,aft
) ->
653 let (iff_n
,iff
) = string_mcode iff
in
654 let (lp_n
,lp
) = string_mcode lp
in
655 let (exp_n
,exp
) = expression exp
in
656 let (rp_n
,rp
) = string_mcode rp
in
657 let (branch1_n
,branch1
) = statement branch1
in
658 let (els_n
,els
) = string_mcode els
in
659 let (branch2_n
,branch2
) = statement branch2
in
660 (multibind [iff_n
;lp_n
;exp_n
;rp_n
;branch1_n
;els_n
;branch2_n
],
661 Ast0.IfThenElse
(iff
,lp
,exp
,rp
,branch1
,els
,branch2
,aft
))
662 | Ast0.While
(whl
,lp
,exp
,rp
,body
,aft
) ->
663 let (whl_n
,whl
) = string_mcode whl
in
664 let (lp_n
,lp
) = string_mcode lp
in
665 let (exp_n
,exp
) = expression exp
in
666 let (rp_n
,rp
) = string_mcode rp
in
667 let (body_n
,body
) = statement body
in
668 (multibind [whl_n
;lp_n
;exp_n
;rp_n
;body_n
],
669 Ast0.While
(whl
,lp
,exp
,rp
,body
,aft
))
670 | Ast0.Do
(d
,body
,whl
,lp
,exp
,rp
,sem
) ->
671 let (d_n
,d
) = string_mcode d
in
672 let (body_n
,body
) = statement body
in
673 let (whl_n
,whl
) = string_mcode whl
in
674 let (lp_n
,lp
) = string_mcode lp
in
675 let (exp_n
,exp
) = expression exp
in
676 let (rp_n
,rp
) = string_mcode rp
in
677 let (sem_n
,sem
) = string_mcode sem
in
678 (multibind [d_n
;body_n
;whl_n
;lp_n
;exp_n
;rp_n
;sem_n
],
679 Ast0.Do
(d
,body
,whl
,lp
,exp
,rp
,sem
))
680 | Ast0.For
(fr
,lp
,first
,e2
,sem2
,e3
,rp
,body
,aft
) ->
681 let (fr_n
,fr
) = string_mcode fr
in
682 let (lp_n
,lp
) = string_mcode lp
in
683 let (first_n
,first
) = forinfo first
in
684 let (e2_n
,e2
) = get_option expression e2
in
685 let (sem2_n
,sem2
) = string_mcode sem2
in
686 let (e3_n
,e3
) = get_option expression e3
in
687 let (rp_n
,rp
) = string_mcode rp
in
688 let (body_n
,body
) = statement body
in
689 (multibind [fr_n
;lp_n
;first_n
;e2_n
;sem2_n
;e3_n
;rp_n
;body_n
],
690 Ast0.For
(fr
,lp
,first
,e2
,sem2
,e3
,rp
,body
,aft
))
691 | Ast0.Iterator
(nm
,lp
,args
,rp
,body
,aft
) ->
692 let (nm_n
,nm
) = ident nm
in
693 let (lp_n
,lp
) = string_mcode lp
in
694 let (args_n
,args
) = expression_dots args
in
695 let (rp_n
,rp
) = string_mcode rp
in
696 let (body_n
,body
) = statement body
in
697 (multibind [nm_n
;lp_n
;args_n
;rp_n
;body_n
],
698 Ast0.Iterator
(nm
,lp
,args
,rp
,body
,aft
))
699 | Ast0.Switch
(switch
,lp
,exp
,rp
,lb
,decls
,cases
,rb
) ->
700 let (switch_n
,switch
) = string_mcode switch
in
701 let (lp_n
,lp
) = string_mcode lp
in
702 let (exp_n
,exp
) = expression exp
in
703 let (rp_n
,rp
) = string_mcode rp
in
704 let (lb_n
,lb
) = string_mcode lb
in
705 let (decls_n
,decls
) = statement_dots decls
in
706 let (cases_n
,cases
) = case_line_dots cases
in
707 let (rb_n
,rb
) = string_mcode rb
in
708 (multibind [switch_n
;lp_n
;exp_n
;rp_n
;lb_n
;decls_n
;cases_n
;rb_n
],
709 Ast0.Switch
(switch
,lp
,exp
,rp
,lb
,decls
,cases
,rb
))
710 | Ast0.Break
(br
,sem
) ->
711 let (br_n
,br
) = string_mcode br
in
712 let (sem_n
,sem
) = string_mcode sem
in
713 (bind br_n sem_n
, Ast0.Break
(br
,sem
))
714 | Ast0.Continue
(cont
,sem
) ->
715 let (cont_n
,cont
) = string_mcode cont
in
716 let (sem_n
,sem
) = string_mcode sem
in
717 (bind cont_n sem_n
, Ast0.Continue
(cont
,sem
))
718 | Ast0.Label
(l
,dd
) ->
719 let (l_n
,l
) = ident l
in
720 let (dd_n
,dd
) = string_mcode dd
in
721 (bind l_n dd_n
, Ast0.Label
(l
,dd
))
722 | Ast0.Goto
(goto
,l
,sem
) ->
723 let (goto_n
,goto
) = string_mcode goto
in
724 let (l_n
,l
) = ident l
in
725 let (sem_n
,sem
) = string_mcode sem
in
726 (bind goto_n
(bind l_n sem_n
), Ast0.Goto
(goto
,l
,sem
))
727 | Ast0.Return
(ret
,sem
) ->
728 let (ret_n
,ret
) = string_mcode ret
in
729 let (sem_n
,sem
) = string_mcode sem
in
730 (bind ret_n sem_n
, Ast0.Return
(ret
,sem
))
731 | Ast0.ReturnExpr
(ret
,exp
,sem
) ->
732 let (ret_n
,ret
) = string_mcode ret
in
733 let (exp_n
,exp
) = expression exp
in
734 let (sem_n
,sem
) = string_mcode sem
in
735 (multibind [ret_n
;exp_n
;sem_n
], Ast0.ReturnExpr
(ret
,exp
,sem
))
736 | Ast0.MetaStmt
(name
,pure
) ->
737 let (name_n
,name
) = meta_mcode name
in
738 (name_n
,Ast0.MetaStmt
(name
,pure
))
739 | Ast0.MetaStmtList
(name
,pure
) ->
740 let (name_n
,name
) = meta_mcode name
in
741 (name_n
,Ast0.MetaStmtList
(name
,pure
))
742 | Ast0.Disj
(starter
,statement_dots_list
,mids
,ender
) ->
743 do_disj starter statement_dots_list mids ender statement_dots
744 (fun starter statement_dots_list mids ender
->
745 Ast0.Disj
(starter
,statement_dots_list
,mids
,ender
))
746 | Ast0.Nest
(starter
,stmt_dots
,ender
,whn
,multi
) ->
747 let (starter_n
,starter
) = string_mcode starter
in
748 let (stmt_dots_n
,stmt_dots
) = statement_dots stmt_dots
in
749 let (ender_n
,ender
) = string_mcode ender
in
751 map_split_bind (whencode statement_dots statement
) whn
in
752 (multibind [starter_n
;stmt_dots_n
;ender_n
;whn_n
],
753 Ast0.Nest
(starter
,stmt_dots
,ender
,whn
,multi
))
755 let (exp_n
,exp
) = expression exp
in
756 (exp_n
,Ast0.Exp
(exp
))
757 | Ast0.TopExp
(exp
) ->
758 let (exp_n
,exp
) = expression exp
in
759 (exp_n
,Ast0.TopExp
(exp
))
761 let (ty_n
,ty
) = typeC ty
in
763 | Ast0.TopInit
(init
) ->
764 let (init_n
,init
) = initialiser init
in
765 (init_n
,Ast0.TopInit
(init
))
766 | Ast0.Dots
(d
,whn
) ->
767 let (d_n
,d
) = string_mcode d
in
769 map_split_bind (whencode statement_dots statement
) whn
in
770 (bind d_n whn_n
, Ast0.Dots
(d
,whn
))
771 | Ast0.Circles
(d
,whn
) ->
772 let (d_n
,d
) = string_mcode d
in
774 map_split_bind (whencode statement_dots statement
) whn
in
775 (bind d_n whn_n
, Ast0.Circles
(d
,whn
))
776 | Ast0.Stars
(d
,whn
) ->
777 let (d_n
,d
) = string_mcode d
in
779 map_split_bind (whencode statement_dots statement
) whn
in
780 (bind d_n whn_n
, Ast0.Stars
(d
,whn
))
781 | Ast0.Include
(inc
,name
) ->
782 let (inc_n
,inc
) = string_mcode inc
in
783 let (name_n
,name
) = inc_mcode name
in
784 (bind inc_n name_n
, Ast0.Include
(inc
,name
))
785 | Ast0.Undef
(def
,id
) ->
786 let (def_n
,def
) = string_mcode def
in
787 let (id_n
,id
) = ident id
in
788 (multibind [def_n
;id_n
],Ast0.Undef
(def
,id
))
789 | Ast0.Define
(def
,id
,params
,body
) ->
790 let (def_n
,def
) = string_mcode def
in
791 let (id_n
,id
) = ident id
in
792 let (params_n
,params
) = define_parameters params
in
793 let (body_n
,body
) = statement_dots body
in
794 (multibind [def_n
;id_n
;params_n
;body_n
],
795 Ast0.Define
(def
,id
,params
,body
))
797 let (re_n
,re
) = statement re
in (re_n
,Ast0.OptStm
(re
))
798 | Ast0.UniqueStm
(re
) ->
799 let (re_n
,re
) = statement re
in (re_n
,Ast0.UniqueStm
(re
))
800 | Ast0.AsStmt
(stm
,asstm
) ->
801 let (stm_n
,stm
) = statement stm
in
802 let (asstm_n
,asstm
) = statement asstm
in
803 (bind stm_n asstm_n
, Ast0.AsStmt
(stm
,asstm
))) in
804 let (n
,s
) = stmtfn all_functions
k s
in
805 (n
,if mode
= REBUILDER
then process_bef_aft s
else s
)
810 (match Ast0.unwrap fi
with
811 Ast0.ForExp
(e1
,sem1
) ->
812 let (e1_n
,e1
) = get_option expression e1
in
813 let (sem1_n
,sem1
) = string_mcode sem1
in
814 (bind e1_n sem1_n
, Ast0.ForExp
(e1
,sem1
))
815 | Ast0.ForDecl
(bef
,decl
) ->
816 let (decl_n
,decl
) = declaration decl
in
817 (decl_n
,Ast0.ForDecl
(bef
,decl
))) in
818 forinfofn all_functions
k fi
820 (* not parameterizable for now... *)
821 and define_parameters p
=
824 (match Ast0.unwrap p
with
825 Ast0.NoParams
-> (option_default
,Ast0.NoParams
)
826 | Ast0.DParams
(lp
,params
,rp
) ->
827 let (lp_n
,lp
) = string_mcode lp
in
828 let (params_n
,params
) = define_param_dots params
in
829 let (rp_n
,rp
) = string_mcode rp
in
830 (multibind [lp_n
;params_n
;rp_n
], Ast0.DParams
(lp
,params
,rp
))) in
833 and define_param_dots d
=
836 (match Ast0.unwrap d
with
838 let (n
,l
) = map_split_bind define_param l
in (n
,Ast0.DOTS
(l
))
840 let (n
,l
) = map_split_bind define_param l
in (n
,Ast0.CIRCLES
(l
))
842 let (n
,l
) = map_split_bind define_param l
in (n
,Ast0.STARS
(l
))) in
848 (match Ast0.unwrap p
with
849 Ast0.DParam
(id
) -> let (n
,id
) = ident id
in (n
,Ast0.DParam
(id
))
850 | Ast0.DPComma
(comma
) ->
851 let (n
,comma
) = string_mcode comma
in (n
,Ast0.DPComma
(comma
))
853 let (n
,d
) = string_mcode d
in (n
,Ast0.DPdots
(d
))
854 | Ast0.DPcircles
(c
) ->
855 let (n
,c
) = string_mcode c
in (n
,Ast0.DPcircles
(c
))
856 | Ast0.OptDParam
(dp
) ->
857 let (n
,dp
) = define_param dp
in (n
,Ast0.OptDParam
(dp
))
858 | Ast0.UniqueDParam
(dp
) ->
859 let (n
,dp
) = define_param dp
in (n
,Ast0.UniqueDParam
(dp
))) in
862 and fninfo
= function
863 Ast0.FStorage
(stg
) ->
864 let (n
,stg
) = storage_mcode stg
in (n
,Ast0.FStorage
(stg
))
865 | Ast0.FType
(ty
) -> let (n
,ty
) = typeC ty
in (n
,Ast0.FType
(ty
))
866 | Ast0.FInline
(inline
) ->
867 let (n
,inline
) = string_mcode inline
in (n
,Ast0.FInline
(inline
))
868 | Ast0.FAttr
(init
) ->
869 let (n
,init
) = string_mcode init
in (n
,Ast0.FAttr
(init
))
871 and whencode notfn alwaysfn
= function
872 Ast0.WhenNot a
-> let (n
,a
) = notfn a
in (n
,Ast0.WhenNot
(a
))
873 | Ast0.WhenAlways a
-> let (n
,a
) = alwaysfn a
in (n
,Ast0.WhenAlways
(a
))
874 | Ast0.WhenModifier
(x
) -> (option_default
,Ast0.WhenModifier
(x
))
875 | Ast0.WhenNotTrue
(e
) ->
876 let (n
,e
) = expression e
in (n
,Ast0.WhenNotTrue
(e
))
877 | Ast0.WhenNotFalse
(e
) ->
878 let (n
,e
) = expression e
in (n
,Ast0.WhenNotFalse
(e
))
883 (match Ast0.unwrap c
with
884 Ast0.Default
(def
,colon
,code
) ->
885 let (def_n
,def
) = string_mcode def
in
886 let (colon_n
,colon
) = string_mcode colon
in
887 let (code_n
,code
) = statement_dots code
in
888 (multibind [def_n
;colon_n
;code_n
], Ast0.Default
(def
,colon
,code
))
889 | Ast0.Case
(case
,exp
,colon
,code
) ->
890 let (case_n
,case
) = string_mcode case
in
891 let (exp_n
,exp
) = expression exp
in
892 let (colon_n
,colon
) = string_mcode colon
in
893 let (code_n
,code
) = statement_dots code
in
894 (multibind [case_n
;exp_n
;colon_n
;code_n
],
895 Ast0.Case
(case
,exp
,colon
,code
))
896 | Ast0.DisjCase
(starter
,case_lines
,mids
,ender
) ->
897 do_disj starter case_lines mids ender case_line
898 (fun starter case_lines mids ender
->
899 Ast0.DisjCase
(starter
,case_lines
,mids
,ender
))
900 | Ast0.OptCase
(case
) ->
901 let (n
,case
) = case_line case
in (n
,Ast0.OptCase
(case
))) in
902 casefn all_functions
k c
907 (match Ast0.unwrap t
with
908 Ast0.FILEINFO
(old_file
,new_file
) ->
909 let (old_file_n
,old_file
) = string_mcode old_file
in
910 let (new_file_n
,new_file
) = string_mcode new_file
in
911 (bind old_file_n new_file_n
,Ast0.FILEINFO
(old_file
,new_file
))
912 | Ast0.NONDECL
(statement_dots
) ->
913 let (n
,statement_dots
) = statement statement_dots
in
914 (n
,Ast0.NONDECL
(statement_dots
))
915 | Ast0.CODE
(stmt_dots
) ->
916 let (stmt_dots_n
,stmt_dots
) = statement_dots stmt_dots
in
917 (stmt_dots_n
, Ast0.CODE
(stmt_dots
))
918 | Ast0.TOPCODE
(stmt_dots
) ->
919 let (stmt_dots_n
,stmt_dots
) = statement_dots stmt_dots
in
920 (stmt_dots_n
, Ast0.TOPCODE
(stmt_dots
))
921 | Ast0.ERRORWORDS
(exps
) ->
922 let (n
,exps
) = map_split_bind expression exps
in
923 (n
, Ast0.ERRORWORDS
(exps
))
924 | Ast0.OTHER
(_) -> failwith
"unexpected code") in
925 topfn all_functions
k t
927 and anything a
= (* for compile_iso, not parameterisable *)
929 Ast0.DotsExprTag
(exprs
) ->
930 let (exprs_n
,exprs
) = expression_dots exprs
in
931 (exprs_n
,Ast0.DotsExprTag
(exprs
))
932 | Ast0.DotsInitTag
(inits
) ->
933 let (inits_n
,inits
) = initialiser_list inits
in
934 (inits_n
,Ast0.DotsInitTag
(inits
))
935 | Ast0.DotsParamTag
(params
) ->
936 let (params_n
,params
) = parameter_list params
in
937 (params_n
,Ast0.DotsParamTag
(params
))
938 | Ast0.DotsStmtTag
(stmts
) ->
939 let (stmts_n
,stmts
) = statement_dots stmts
in
940 (stmts_n
,Ast0.DotsStmtTag
(stmts
))
941 | Ast0.DotsDeclTag
(decls
) ->
942 let (decls_n
,decls
) = declaration_dots decls
in
943 (decls_n
,Ast0.DotsDeclTag
(decls
))
944 | Ast0.DotsCaseTag
(cases
) ->
945 let (cases_n
,cases
) = case_line_dots cases
in
946 (cases_n
,Ast0.DotsCaseTag
(cases
))
947 | Ast0.IdentTag
(id
) ->
948 let (id_n
,id
) = ident id
in
949 (id_n
,Ast0.IdentTag
(id
))
950 | Ast0.ExprTag
(exp
) ->
951 let (exp_n
,exp
) = expression exp
in
952 (exp_n
,Ast0.ExprTag
(exp
))
953 | Ast0.ArgExprTag
(exp
) ->
954 let (exp_n
,exp
) = expression exp
in
955 (exp_n
,Ast0.ArgExprTag
(exp
))
956 | Ast0.TestExprTag
(exp
) ->
957 let (exp_n
,exp
) = expression exp
in
958 (exp_n
,Ast0.TestExprTag
(exp
))
959 | Ast0.TypeCTag
(ty
) ->
960 let (ty_n
,ty
) = typeC ty
in
961 (ty_n
,Ast0.TypeCTag
(ty
))
962 | Ast0.ParamTag
(param
) ->
963 let (param_n
,param
) = parameterTypeDef param
in
964 (param_n
,Ast0.ParamTag
(param
))
965 | Ast0.InitTag
(init
) ->
966 let (init_n
,init
) = initialiser init
in
967 (init_n
,Ast0.InitTag
(init
))
968 | Ast0.DeclTag
(decl
) ->
969 let (decl_n
,decl
) = declaration decl
in
970 (decl_n
,Ast0.DeclTag
(decl
))
971 | Ast0.StmtTag
(stmt
) ->
972 let (stmt_n
,stmt
) = statement stmt
in
973 (stmt_n
,Ast0.StmtTag
(stmt
))
974 | Ast0.ForInfoTag
(fi
) ->
975 let (fi_n
,fi
) = forinfo fi
in
976 (fi_n
,Ast0.ForInfoTag
(fi
))
977 | Ast0.CaseLineTag
(c
) ->
978 let (c_n
,c
) = case_line c
in
979 (c_n
,Ast0.CaseLineTag
(c
))
980 | Ast0.TopTag
(top
) ->
981 let (top_n
,top
) = top_level top
in
982 (top_n
,Ast0.TopTag
(top
))
983 | Ast0.IsoWhenTag
(x
) -> (option_default
,Ast0.IsoWhenTag
(x
))
984 | Ast0.IsoWhenTTag
(e
) ->
985 let (e_n
,e
) = expression e
in
986 (e_n
,Ast0.IsoWhenTTag
(e
))
987 | Ast0.IsoWhenFTag
(e
) ->
988 let (e_n
,e
) = expression e
in
989 (e_n
,Ast0.IsoWhenFTag
(e
))
990 | Ast0.MetaPosTag
(var
) -> failwith
"not supported"
991 | Ast0.HiddenVarTag
(var
) -> failwith
"not supported" in
994 (* not done for combiner, because the statement is assumed to be already
995 represented elsewhere in the code *)
999 VT0.expression
= expression
;
1001 VT0.declaration
= declaration
;
1002 VT0.initialiser
= initialiser
;
1003 VT0.initialiser_list
= initialiser_list
;
1004 VT0.parameter
= parameterTypeDef
;
1005 VT0.parameter_list
= parameter_list
;
1006 VT0.statement
= statement
;
1007 VT0.forinfo
= forinfo
;
1008 VT0.case_line
= case_line
;
1009 VT0.top_level
= top_level
;
1010 VT0.expression_dots = expression_dots;
1011 VT0.statement_dots
= statement_dots
;
1012 VT0.declaration_dots
= declaration_dots
;
1013 VT0.case_line_dots
= case_line_dots
;
1014 VT0.anything
= anything
} in
1017 let combiner_functions =
1018 {VT0.combiner_meta_mcode
= (fun opt_default mc
-> opt_default
);
1019 VT0.combiner_string_mcode
= (fun opt_default mc
-> opt_default
);
1020 VT0.combiner_const_mcode
= (fun opt_default mc
-> opt_default
);
1021 VT0.combiner_assign_mcode
= (fun opt_default mc
-> opt_default
);
1022 VT0.combiner_fix_mcode
= (fun opt_default mc
-> opt_default
);
1023 VT0.combiner_unary_mcode
= (fun opt_default mc
-> opt_default
);
1024 VT0.combiner_binary_mcode
= (fun opt_default mc
-> opt_default
);
1025 VT0.combiner_cv_mcode
= (fun opt_default mc
-> opt_default
);
1026 VT0.combiner_sign_mcode
= (fun opt_default mc
-> opt_default
);
1027 VT0.combiner_struct_mcode
= (fun opt_default mc
-> opt_default
);
1028 VT0.combiner_storage_mcode
= (fun opt_default mc
-> opt_default
);
1029 VT0.combiner_inc_mcode
= (fun opt_default mc
-> opt_default
);
1030 VT0.combiner_dotsexprfn
= (fun r
k e
-> k e
);
1031 VT0.combiner_dotsinitfn
= (fun r
k e
-> k e
);
1032 VT0.combiner_dotsparamfn
= (fun r
k e
-> k e
);
1033 VT0.combiner_dotsstmtfn
= (fun r
k e
-> k e
);
1034 VT0.combiner_dotsdeclfn
= (fun r
k e
-> k e
);
1035 VT0.combiner_dotscasefn
= (fun r
k e
-> k e
);
1036 VT0.combiner_identfn
= (fun r
k e
-> k e
);
1037 VT0.combiner_exprfn
= (fun r
k e
-> k e
);
1038 VT0.combiner_tyfn
= (fun r
k e
-> k e
);
1039 VT0.combiner_initfn
= (fun r
k e
-> k e
);
1040 VT0.combiner_paramfn
= (fun r
k e
-> k e
);
1041 VT0.combiner_declfn
= (fun r
k e
-> k e
);
1042 VT0.combiner_stmtfn
= (fun r
k e
-> k e
);
1043 VT0.combiner_forinfofn
= (fun r
k e
-> k e
);
1044 VT0.combiner_casefn
= (fun r
k e
-> k e
);
1045 VT0.combiner_topfn
= (fun r
k e
-> k e
)}
1048 {VT0.combiner_rec_ident
=
1049 (function e
-> let (n
,_) = r
.VT0.ident e
in n
);
1050 VT0.combiner_rec_expression
=
1051 (function e
-> let (n
,_) = r
.VT0.expression e
in n
);
1052 VT0.combiner_rec_typeC
=
1053 (function e
-> let (n
,_) = r
.VT0.typeC e
in n
);
1054 VT0.combiner_rec_declaration
=
1055 (function e
-> let (n
,_) = r
.VT0.declaration e
in n
);
1056 VT0.combiner_rec_initialiser
=
1057 (function e
-> let (n
,_) = r
.VT0.initialiser e
in n
);
1058 VT0.combiner_rec_initialiser_list
=
1059 (function e
-> let (n
,_) = r
.VT0.initialiser_list e
in n
);
1060 VT0.combiner_rec_parameter
=
1061 (function e
-> let (n
,_) = r
.VT0.parameter e
in n
);
1062 VT0.combiner_rec_parameter_list
=
1063 (function e
-> let (n
,_) = r
.VT0.parameter_list e
in n
);
1064 VT0.combiner_rec_statement
=
1065 (function e
-> let (n
,_) = r
.VT0.statement e
in n
);
1066 VT0.combiner_rec_forinfo
=
1067 (function e
-> let (n
,_) = r
.VT0.forinfo e
in n
);
1068 VT0.combiner_rec_case_line
=
1069 (function e
-> let (n
,_) = r
.VT0.case_line e
in n
);
1070 VT0.combiner_rec_top_level
=
1071 (function e
-> let (n
,_) = r
.VT0.top_level e
in n
);
1072 VT0.combiner_rec_expression_dots
=
1073 (function e
-> let (n
,_) = r
.VT0.expression_dots e
in n
);
1074 VT0.combiner_rec_statement_dots
=
1075 (function e
-> let (n
,_) = r
.VT0.statement_dots e
in n
);
1076 VT0.combiner_rec_declaration_dots
=
1077 (function e
-> let (n
,_) = r
.VT0.declaration_dots e
in n
);
1078 VT0.combiner_rec_case_line_dots
=
1079 (function e
-> let (n
,_) = r
.VT0.case_line_dots e
in n
);
1080 VT0.combiner_rec_anything
=
1081 (function e
-> let (n
,_) = r
.VT0.anything e
in n
)}
1083 let combiner bind option_default functions
=
1084 let xk k e
= let (n
,_) = k e
in n
in
1085 let dz = combiner_dz in
1087 (visitor COMBINER bind option_default
1088 (function mc
-> (functions
.VT0.combiner_meta_mcode option_default mc
,mc
))
1089 (function mc
-> (functions
.VT0.combiner_string_mcode option_default mc
,mc
))
1090 (function mc
-> (functions
.VT0.combiner_const_mcode option_default mc
,mc
))
1091 (function mc
-> (functions
.VT0.combiner_assign_mcode option_default mc
,mc
))
1092 (function mc
-> (functions
.VT0.combiner_fix_mcode option_default mc
,mc
))
1093 (function mc
-> (functions
.VT0.combiner_unary_mcode option_default mc
,mc
))
1094 (function mc
-> (functions
.VT0.combiner_binary_mcode option_default mc
,mc
))
1095 (function mc
-> (functions
.VT0.combiner_cv_mcode option_default mc
,mc
))
1096 (function mc
-> (functions
.VT0.combiner_sign_mcode option_default mc
,mc
))
1097 (function mc
-> (functions
.VT0.combiner_struct_mcode option_default mc
,mc
))
1099 (functions
.VT0.combiner_storage_mcode option_default mc
,mc
))
1100 (function mc
-> (functions
.VT0.combiner_inc_mcode option_default mc
,mc
))
1101 (fun r
k e
-> (functions
.VT0.combiner_dotsexprfn
(dz r
) (xk k) e
, e
))
1102 (fun r
k e
-> (functions
.VT0.combiner_dotsinitfn
(dz r
) (xk k) e
, e
))
1103 (fun r
k e
-> (functions
.VT0.combiner_dotsparamfn
(dz r
) (xk k) e
, e
))
1104 (fun r
k e
-> (functions
.VT0.combiner_dotsstmtfn
(dz r
) (xk k) e
, e
))
1105 (fun r
k e
-> (functions
.VT0.combiner_dotsdeclfn
(dz r
) (xk k) e
, e
))
1106 (fun r
k e
-> (functions
.VT0.combiner_dotscasefn
(dz r
) (xk k) e
, e
))
1107 (fun r
k e
-> (functions
.VT0.combiner_identfn
(dz r
) (xk k) e
, e
))
1108 (fun r
k e
-> (functions
.VT0.combiner_exprfn
(dz r
) (xk k) e
, e
))
1109 (fun r
k e
-> (functions
.VT0.combiner_tyfn
(dz r
) (xk k) e
, e
))
1110 (fun r
k e
-> (functions
.VT0.combiner_initfn
(dz r
) (xk k) e
, e
))
1111 (fun r
k e
-> (functions
.VT0.combiner_paramfn
(dz r
) (xk k) e
, e
))
1112 (fun r
k e
-> (functions
.VT0.combiner_declfn
(dz r
) (xk k) e
, e
))
1113 (fun r
k e
-> (functions
.VT0.combiner_stmtfn
(dz r
) (xk k) e
, e
))
1114 (fun r
k e
-> (functions
.VT0.combiner_forinfofn
(dz r
) (xk k) e
, e
))
1115 (fun r
k e
-> (functions
.VT0.combiner_casefn
(dz r
) (xk k) e
, e
))
1116 (fun r
k e
-> (functions
.VT0.combiner_topfn
(dz r
) (xk k) e
, e
)))
1118 let flat_combiner bind option_default
1119 meta_mcode string_mcode const_mcode assign_mcode fix_mcode unary_mcode
1120 binary_mcode cv_mcode sign_mcode struct_mcode storage_mcode
1122 dotsexprfn dotsinitfn dotsparamfn dotsstmtfn dotsdeclfn dotscasefn
1123 identfn exprfn tyfn initfn paramfn declfn stmtfn forinfofn casefn topfn
=
1124 let dz = combiner_dz in
1125 let xk k e
= let (n
,_) = k e
in n
in
1126 combiner_dz (visitor COMBINER bind option_default
1127 (function mc
-> (meta_mcode mc
,mc
))
1128 (function mc
-> (string_mcode mc
,mc
))
1129 (function mc
-> (const_mcode mc
,mc
))
1130 (function mc
-> (assign_mcode mc
,mc
))
1131 (function mc
-> (fix_mcode mc
,mc
))
1132 (function mc
-> (unary_mcode mc
,mc
))
1133 (function mc
-> (binary_mcode mc
,mc
))
1134 (function mc
-> (cv_mcode mc
,mc
))
1135 (function mc
-> (sign_mcode mc
,mc
))
1136 (function mc
-> (struct_mcode mc
,mc
))
1137 (function mc
-> (storage_mcode mc
,mc
))
1138 (function mc
-> (inc_mcode mc
,mc
))
1139 (fun r
k e
-> (dotsexprfn
(dz r
) (xk k) e
, e
))
1140 (fun r
k e
-> (dotsinitfn
(dz r
) (xk k) e
, e
))
1141 (fun r
k e
-> (dotsparamfn
(dz r
) (xk k) e
, e
))
1142 (fun r
k e
-> (dotsstmtfn
(dz r
) (xk k) e
, e
))
1143 (fun r
k e
-> (dotsdeclfn
(dz r
) (xk k) e
, e
))
1144 (fun r
k e
-> (dotscasefn
(dz r
) (xk k) e
, e
))
1145 (fun r
k e
-> (identfn
(dz r
) (xk k) e
, e
))
1146 (fun r
k e
-> (exprfn
(dz r
) (xk k) e
, e
))
1147 (fun r
k e
-> (tyfn
(dz r
) (xk k) e
, e
))
1148 (fun r
k e
-> (initfn
(dz r
) (xk k) e
, e
))
1149 (fun r
k e
-> (paramfn
(dz r
) (xk k) e
, e
))
1150 (fun r
k e
-> (declfn
(dz r
) (xk k) e
, e
))
1151 (fun r
k e
-> (stmtfn
(dz r
) (xk k) e
, e
))
1152 (fun r
k e
-> (forinfofn
(dz r
) (xk k) e
, e
))
1153 (fun r
k e
-> (casefn
(dz r
) (xk k) e
, e
))
1154 (fun r
k e
-> (topfn
(dz r
) (xk k) e
, e
)))
1156 let rebuilder_functions =
1157 {VT0.rebuilder_meta_mcode
= (fun mc
-> mc
);
1158 VT0.rebuilder_string_mcode
= (fun mc
-> mc
);
1159 VT0.rebuilder_const_mcode
= (fun mc
-> mc
);
1160 VT0.rebuilder_assign_mcode
= (fun mc
-> mc
);
1161 VT0.rebuilder_fix_mcode
= (fun mc
-> mc
);
1162 VT0.rebuilder_unary_mcode
= (fun mc
-> mc
);
1163 VT0.rebuilder_binary_mcode
= (fun mc
-> mc
);
1164 VT0.rebuilder_cv_mcode
= (fun mc
-> mc
);
1165 VT0.rebuilder_sign_mcode
= (fun mc
-> mc
);
1166 VT0.rebuilder_struct_mcode
= (fun mc
-> mc
);
1167 VT0.rebuilder_storage_mcode
= (fun mc
-> mc
);
1168 VT0.rebuilder_inc_mcode
= (fun mc
-> mc
);
1169 VT0.rebuilder_dotsexprfn
= (fun r
k e
-> k e
);
1170 VT0.rebuilder_dotsinitfn
= (fun r
k e
-> k e
);
1171 VT0.rebuilder_dotsparamfn
= (fun r
k e
-> k e
);
1172 VT0.rebuilder_dotsstmtfn
= (fun r
k e
-> k e
);
1173 VT0.rebuilder_dotsdeclfn
= (fun r
k e
-> k e
);
1174 VT0.rebuilder_dotscasefn
= (fun r
k e
-> k e
);
1175 VT0.rebuilder_identfn
= (fun r
k e
-> k e
);
1176 VT0.rebuilder_exprfn
= (fun r
k e
-> k e
);
1177 VT0.rebuilder_tyfn
= (fun r
k e
-> k e
);
1178 VT0.rebuilder_initfn
= (fun r
k e
-> k e
);
1179 VT0.rebuilder_paramfn
= (fun r
k e
-> k e
);
1180 VT0.rebuilder_declfn
= (fun r
k e
-> k e
);
1181 VT0.rebuilder_stmtfn
= (fun r
k e
-> k e
);
1182 VT0.rebuilder_forinfofn
= (fun r
k e
-> k e
);
1183 VT0.rebuilder_casefn
= (fun r
k e
-> k e
);
1184 VT0.rebuilder_topfn
= (fun r
k e
-> k e
)}
1186 let rebuilder_dz r
=
1187 {VT0.rebuilder_rec_ident
=
1188 (function e
-> let (_,e
) = r
.VT0.ident e
in e
);
1189 VT0.rebuilder_rec_expression
=
1190 (function e
-> let (_,e
) = r
.VT0.expression e
in e
);
1191 VT0.rebuilder_rec_typeC
=
1192 (function e
-> let (_,e
) = r
.VT0.typeC e
in e
);
1193 VT0.rebuilder_rec_declaration
=
1194 (function e
-> let (_,e
) = r
.VT0.declaration e
in e
);
1195 VT0.rebuilder_rec_initialiser
=
1196 (function e
-> let (_,e
) = r
.VT0.initialiser e
in e
);
1197 VT0.rebuilder_rec_initialiser_list
=
1198 (function e
-> let (_,e
) = r
.VT0.initialiser_list e
in e
);
1199 VT0.rebuilder_rec_parameter
=
1200 (function e
-> let (_,e
) = r
.VT0.parameter e
in e
);
1201 VT0.rebuilder_rec_parameter_list
=
1202 (function e
-> let (_,e
) = r
.VT0.parameter_list e
in e
);
1203 VT0.rebuilder_rec_statement
=
1204 (function e
-> let (_,e
) = r
.VT0.statement e
in e
);
1205 VT0.rebuilder_rec_forinfo
=
1206 (function e
-> let (_,e
) = r
.VT0.forinfo e
in e
);
1207 VT0.rebuilder_rec_case_line
=
1208 (function e
-> let (_,e
) = r
.VT0.case_line e
in e
);
1209 VT0.rebuilder_rec_top_level
=
1210 (function e
-> let (_,e
) = r
.VT0.top_level e
in e
);
1211 VT0.rebuilder_rec_expression_dots
=
1212 (function e
-> let (_,e
) = r
.VT0.expression_dots e
in e
);
1213 VT0.rebuilder_rec_statement_dots
=
1214 (function e
-> let (_,e
) = r
.VT0.statement_dots e
in e
);
1215 VT0.rebuilder_rec_declaration_dots
=
1216 (function e
-> let (_,e
) = r
.VT0.declaration_dots e
in e
);
1217 VT0.rebuilder_rec_case_line_dots
=
1218 (function e
-> let (_,e
) = r
.VT0.case_line_dots e
in e
);
1219 VT0.rebuilder_rec_anything
=
1220 (function e
-> let (_,e
) = r
.VT0.anything e
in e
)}
1222 let rebuilder functions
=
1223 let dz = rebuilder_dz in
1224 let xk k e
= let (_,e
) = k e
in e
in
1226 (visitor REBUILDER
(fun x y
-> x
) ()
1227 (function mc
-> ((),functions
.VT0.rebuilder_meta_mcode mc
))
1228 (function mc
-> ((),functions
.VT0.rebuilder_string_mcode mc
))
1229 (function mc
-> ((),functions
.VT0.rebuilder_const_mcode mc
))
1230 (function mc
-> ((),functions
.VT0.rebuilder_assign_mcode mc
))
1231 (function mc
-> ((),functions
.VT0.rebuilder_fix_mcode mc
))
1232 (function mc
-> ((),functions
.VT0.rebuilder_unary_mcode mc
))
1233 (function mc
-> ((),functions
.VT0.rebuilder_binary_mcode mc
))
1234 (function mc
-> ((),functions
.VT0.rebuilder_cv_mcode mc
))
1235 (function mc
-> ((),functions
.VT0.rebuilder_sign_mcode mc
))
1236 (function mc
-> ((),functions
.VT0.rebuilder_struct_mcode mc
))
1237 (function mc
-> ((),functions
.VT0.rebuilder_storage_mcode mc
))
1238 (function mc
-> ((),functions
.VT0.rebuilder_inc_mcode mc
))
1239 (fun r
k e
-> ((),functions
.VT0.rebuilder_dotsexprfn
(dz r
) (xk k) e
))
1240 (fun r
k e
-> ((),functions
.VT0.rebuilder_dotsinitfn
(dz r
) (xk k) e
))
1241 (fun r
k e
-> ((),functions
.VT0.rebuilder_dotsparamfn
(dz r
) (xk k) e
))
1242 (fun r
k e
-> ((),functions
.VT0.rebuilder_dotsstmtfn
(dz r
) (xk k) e
))
1243 (fun r
k e
-> ((),functions
.VT0.rebuilder_dotsdeclfn
(dz r
) (xk k) e
))
1244 (fun r
k e
-> ((),functions
.VT0.rebuilder_dotscasefn
(dz r
) (xk k) e
))
1245 (fun r
k e
-> ((),functions
.VT0.rebuilder_identfn
(dz r
) (xk k) e
))
1246 (fun r
k e
-> ((),functions
.VT0.rebuilder_exprfn
(dz r
) (xk k) e
))
1247 (fun r
k e
-> ((),functions
.VT0.rebuilder_tyfn
(dz r
) (xk k) e
))
1248 (fun r
k e
-> ((),functions
.VT0.rebuilder_initfn
(dz r
) (xk k) e
))
1249 (fun r
k e
-> ((),functions
.VT0.rebuilder_paramfn
(dz r
) (xk k) e
))
1250 (fun r
k e
-> ((),functions
.VT0.rebuilder_declfn
(dz r
) (xk k) e
))
1251 (fun r
k e
-> ((),functions
.VT0.rebuilder_stmtfn
(dz r
) (xk k) e
))
1252 (fun r
k e
-> ((),functions
.VT0.rebuilder_forinfofn
(dz r
) (xk k) e
))
1253 (fun r
k e
-> ((),functions
.VT0.rebuilder_casefn
(dz r
) (xk k) e
))
1254 (fun r
k e
-> ((),functions
.VT0.rebuilder_topfn
(dz r
) (xk k) e
)))
1257 meta_mcode string_mcode const_mcode assign_mcode fix_mcode unary_mcode
1258 binary_mcode cv_mcode sign_mcode struct_mcode storage_mcode
1260 dotsexprfn dotsinitfn dotsparamfn dotsstmtfn dotsdeclfn dotscasefn
1261 identfn exprfn tyfn initfn paramfn declfn stmtfn forinfofn casefn topfn
=
1262 let dz = rebuilder_dz in
1263 let xk k e
= let (_,e
) = k e
in e
in
1265 (visitor REBUILDER
(fun x y
-> x
) ()
1266 (function mc
-> ((),meta_mcode mc
))
1267 (function mc
-> ((),string_mcode mc
))
1268 (function mc
-> ((),const_mcode mc
))
1269 (function mc
-> ((),assign_mcode mc
))
1270 (function mc
-> ((),fix_mcode mc
))
1271 (function mc
-> ((),unary_mcode mc
))
1272 (function mc
-> ((),binary_mcode mc
))
1273 (function mc
-> ((),cv_mcode mc
))
1274 (function mc
-> ((),sign_mcode mc
))
1275 (function mc
-> ((),struct_mcode mc
))
1276 (function mc
-> ((),storage_mcode mc
))
1277 (function mc
-> ((),inc_mcode mc
))
1278 (fun r
k e
-> ((),dotsexprfn
(dz r
) (xk k) e
))
1279 (fun r
k e
-> ((),dotsinitfn
(dz r
) (xk k) e
))
1280 (fun r
k e
-> ((),dotsparamfn
(dz r
) (xk k) e
))
1281 (fun r
k e
-> ((),dotsstmtfn
(dz r
) (xk k) e
))
1282 (fun r
k e
-> ((),dotsdeclfn
(dz r
) (xk k) e
))
1283 (fun r
k e
-> ((),dotscasefn
(dz r
) (xk k) e
))
1284 (fun r
k e
-> ((),identfn
(dz r
) (xk k) e
))
1285 (fun r
k e
-> ((),exprfn
(dz r
) (xk k) e
))
1286 (fun r
k e
-> ((),tyfn
(dz r
) (xk k) e
))
1287 (fun r
k e
-> ((),initfn
(dz r
) (xk k) e
))
1288 (fun r
k e
-> ((),paramfn
(dz r
) (xk k) e
))
1289 (fun r
k e
-> ((),declfn
(dz r
) (xk k) e
))
1290 (fun r
k e
-> ((),stmtfn
(dz r
) (xk k) e
))
1291 (fun r
k e
-> ((),forinfofn
(dz r
) (xk k) e
))
1292 (fun r
k e
-> ((),casefn
(dz r
) (xk k) e
))
1293 (fun r
k e
-> ((),topfn
(dz r
) (xk k) e
)))
1295 let combiner_rebuilder_functions =
1296 {VT0.combiner_rebuilder_meta_mcode
=
1297 (fun opt_default mc
-> (opt_default
,mc
));
1298 VT0.combiner_rebuilder_string_mcode
=
1299 (fun opt_default mc
-> (opt_default
,mc
));
1300 VT0.combiner_rebuilder_const_mcode
=
1301 (fun opt_default mc
-> (opt_default
,mc
));
1302 VT0.combiner_rebuilder_assign_mcode
=
1303 (fun opt_default mc
-> (opt_default
,mc
));
1304 VT0.combiner_rebuilder_fix_mcode
=
1305 (fun opt_default mc
-> (opt_default
,mc
));
1306 VT0.combiner_rebuilder_unary_mcode
=
1307 (fun opt_default mc
-> (opt_default
,mc
));
1308 VT0.combiner_rebuilder_binary_mcode
=
1309 (fun opt_default mc
-> (opt_default
,mc
));
1310 VT0.combiner_rebuilder_cv_mcode
=
1311 (fun opt_default mc
-> (opt_default
,mc
));
1312 VT0.combiner_rebuilder_sign_mcode
=
1313 (fun opt_default mc
-> (opt_default
,mc
));
1314 VT0.combiner_rebuilder_struct_mcode
=
1315 (fun opt_default mc
-> (opt_default
,mc
));
1316 VT0.combiner_rebuilder_storage_mcode
=
1317 (fun opt_default mc
-> (opt_default
,mc
));
1318 VT0.combiner_rebuilder_inc_mcode
=
1319 (fun opt_default mc
-> (opt_default
,mc
));
1320 VT0.combiner_rebuilder_dotsexprfn
= (fun r
k e
-> k e
);
1321 VT0.combiner_rebuilder_dotsinitfn
= (fun r
k e
-> k e
);
1322 VT0.combiner_rebuilder_dotsparamfn
= (fun r
k e
-> k e
);
1323 VT0.combiner_rebuilder_dotsstmtfn
= (fun r
k e
-> k e
);
1324 VT0.combiner_rebuilder_dotsdeclfn
= (fun r
k e
-> k e
);
1325 VT0.combiner_rebuilder_dotscasefn
= (fun r
k e
-> k e
);
1326 VT0.combiner_rebuilder_identfn
= (fun r
k e
-> k e
);
1327 VT0.combiner_rebuilder_exprfn
= (fun r
k e
-> k e
);
1328 VT0.combiner_rebuilder_tyfn
= (fun r
k e
-> k e
);
1329 VT0.combiner_rebuilder_initfn
= (fun r
k e
-> k e
);
1330 VT0.combiner_rebuilder_paramfn
= (fun r
k e
-> k e
);
1331 VT0.combiner_rebuilder_declfn
= (fun r
k e
-> k e
);
1332 VT0.combiner_rebuilder_stmtfn
= (fun r
k e
-> k e
);
1333 VT0.combiner_rebuilder_forinfofn
= (fun r
k e
-> k e
);
1334 VT0.combiner_rebuilder_casefn
= (fun r
k e
-> k e
);
1335 VT0.combiner_rebuilder_topfn
= (fun r
k e
-> k e
)}
1337 let combiner_rebuilder bind option_default functions
=
1338 visitor BOTH bind option_default
1339 (functions
.VT0.combiner_rebuilder_meta_mcode option_default
)
1340 (functions
.VT0.combiner_rebuilder_string_mcode option_default
)
1341 (functions
.VT0.combiner_rebuilder_const_mcode option_default
)
1342 (functions
.VT0.combiner_rebuilder_assign_mcode option_default
)
1343 (functions
.VT0.combiner_rebuilder_fix_mcode option_default
)
1344 (functions
.VT0.combiner_rebuilder_unary_mcode option_default
)
1345 (functions
.VT0.combiner_rebuilder_binary_mcode option_default
)
1346 (functions
.VT0.combiner_rebuilder_cv_mcode option_default
)
1347 (functions
.VT0.combiner_rebuilder_sign_mcode option_default
)
1348 (functions
.VT0.combiner_rebuilder_struct_mcode option_default
)
1349 (functions
.VT0.combiner_rebuilder_storage_mcode option_default
)
1350 (functions
.VT0.combiner_rebuilder_inc_mcode option_default
)
1351 functions
.VT0.combiner_rebuilder_dotsexprfn
1352 functions
.VT0.combiner_rebuilder_dotsinitfn
1353 functions
.VT0.combiner_rebuilder_dotsparamfn
1354 functions
.VT0.combiner_rebuilder_dotsstmtfn
1355 functions
.VT0.combiner_rebuilder_dotsdeclfn
1356 functions
.VT0.combiner_rebuilder_dotscasefn
1357 functions
.VT0.combiner_rebuilder_identfn
1358 functions
.VT0.combiner_rebuilder_exprfn
1359 functions
.VT0.combiner_rebuilder_tyfn
1360 functions
.VT0.combiner_rebuilder_initfn
1361 functions
.VT0.combiner_rebuilder_paramfn
1362 functions
.VT0.combiner_rebuilder_declfn
1363 functions
.VT0.combiner_rebuilder_stmtfn
1364 functions
.VT0.combiner_rebuilder_forinfofn
1365 functions
.VT0.combiner_rebuilder_casefn
1366 functions
.VT0.combiner_rebuilder_topfn