Commit | Line | Data |
---|---|---|
f537ebc4 | 1 | (* |
17ba0788 C |
2 | * Copyright 2012, INRIA |
3 | * Julia Lawall, Gilles Muller | |
4 | * Copyright 2010-2011, INRIA, University of Copenhagen | |
f537ebc4 C |
5 | * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix |
6 | * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen | |
7 | * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix | |
8 | * This file is part of Coccinelle. | |
9 | * | |
10 | * Coccinelle is free software: you can redistribute it and/or modify | |
11 | * it under the terms of the GNU General Public License as published by | |
12 | * the Free Software Foundation, according to version 2 of the License. | |
13 | * | |
14 | * Coccinelle is distributed in the hope that it will be useful, | |
15 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | * GNU General Public License for more details. | |
18 | * | |
19 | * You should have received a copy of the GNU General Public License | |
20 | * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>. | |
21 | * | |
22 | * The authors reserve the right to distribute this or future versions of | |
d6ce1786 C |
23 | * Coccinelle under other licenses. |
24 | *) | |
25 | ||
26 | ||
feec80c3 | 27 | # 0 "./visitor_ast0.ml" |
b1b2de81 C |
28 | (* --------------------------------------------------------------------- *) |
29 | (* Generic traversal: rebuilder *) | |
30 | ||
34e49164 C |
31 | module Ast = Ast_cocci |
32 | module Ast0 = Ast0_cocci | |
b1b2de81 | 33 | module VT0 = Visitor_ast0_types |
34e49164 | 34 | |
b1b2de81 | 35 | type mode = COMBINER | REBUILDER | BOTH |
34e49164 | 36 | |
b1b2de81 | 37 | let map_split f l = List.split(List.map f l) |
34e49164 | 38 | |
b1b2de81 | 39 | let rewrap x (n,e) = (n,Ast0.rewrap x e) |
34e49164 | 40 | |
b1b2de81 | 41 | let visitor mode bind option_default |
34e49164 | 42 | meta_mcode string_mcode const_mcode assign_mcode fix_mcode unary_mcode |
faf9a90c | 43 | binary_mcode cv_mcode sign_mcode struct_mcode storage_mcode |
34e49164 C |
44 | inc_mcode |
45 | dotsexprfn dotsinitfn dotsparamfn dotsstmtfn dotsdeclfn dotscasefn | |
755320b0 | 46 | identfn exprfn tyfn initfn paramfn declfn stmtfn forinfofn casefn topfn = |
34e49164 C |
47 | let multibind l = |
48 | let rec loop = function | |
49 | [] -> option_default | |
50 | | [x] -> x | |
51 | | x::xs -> bind x (loop xs) in | |
52 | loop l in | |
b1b2de81 C |
53 | let map_split_bind f l = |
54 | let (n,e) = List.split(List.map f l) in (multibind n,e) in | |
34e49164 | 55 | let get_option f = function |
b1b2de81 C |
56 | Some x -> let (n,e) = f x in (n,Some e) |
57 | | None -> (option_default,None) in | |
d3f655c6 C |
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 | |
63 | (multibind | |
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 | |
34e49164 C |
67 | let rec expression_dots d = |
68 | let k d = | |
b1b2de81 | 69 | rewrap d |
34e49164 | 70 | (match Ast0.unwrap d with |
b1b2de81 C |
71 | Ast0.DOTS(l) -> |
72 | let (n,l) = map_split_bind expression l in (n,Ast0.DOTS(l)) | |
73 | | Ast0.CIRCLES(l) -> | |
74 | let (n,l) = map_split_bind expression l in (n,Ast0.CIRCLES(l)) | |
75 | | Ast0.STARS(l) -> | |
76 | let (n,l) = map_split_bind expression l in (n,Ast0.STARS(l))) in | |
34e49164 C |
77 | dotsexprfn all_functions k d |
78 | and initialiser_list i = | |
79 | let k i = | |
b1b2de81 | 80 | rewrap i |
34e49164 | 81 | (match Ast0.unwrap i with |
b1b2de81 C |
82 | Ast0.DOTS(l) -> |
83 | let (n,l) = map_split_bind initialiser l in (n,Ast0.DOTS(l)) | |
84 | | Ast0.CIRCLES(l) -> | |
85 | let (n,l) = map_split_bind initialiser l in (n,Ast0.CIRCLES(l)) | |
86 | | Ast0.STARS(l) -> | |
87 | let (n,l) = map_split_bind initialiser l in (n,Ast0.STARS(l))) in | |
34e49164 | 88 | dotsinitfn all_functions k i |
b1b2de81 | 89 | |
34e49164 C |
90 | and parameter_list d = |
91 | let k d = | |
b1b2de81 | 92 | rewrap d |
34e49164 | 93 | (match Ast0.unwrap d with |
b1b2de81 C |
94 | Ast0.DOTS(l) -> |
95 | let (n,l) = map_split_bind parameterTypeDef l in | |
96 | (n,Ast0.DOTS(l)) | |
97 | | Ast0.CIRCLES(l) -> | |
98 | let (n,l) = map_split_bind parameterTypeDef l in | |
99 | (n,Ast0.CIRCLES(l)) | |
100 | | Ast0.STARS(l) -> | |
101 | let (n,l) = map_split_bind parameterTypeDef l in | |
102 | (n,Ast0.STARS(l))) in | |
34e49164 | 103 | dotsparamfn all_functions k d |
b1b2de81 | 104 | |
34e49164 C |
105 | and statement_dots d = |
106 | let k d = | |
b1b2de81 | 107 | rewrap d |
34e49164 | 108 | (match Ast0.unwrap d with |
b1b2de81 C |
109 | Ast0.DOTS(l) -> |
110 | let (n,l) = map_split_bind statement l in (n,Ast0.DOTS(l)) | |
111 | | Ast0.CIRCLES(l) -> | |
112 | let (n,l) = map_split_bind statement l in (n,Ast0.CIRCLES(l)) | |
113 | | Ast0.STARS(l) -> | |
114 | let (n,l) = map_split_bind statement l in (n,Ast0.STARS(l))) in | |
34e49164 | 115 | dotsstmtfn all_functions k d |
b1b2de81 | 116 | |
34e49164 C |
117 | and declaration_dots d = |
118 | let k d = | |
b1b2de81 | 119 | rewrap d |
34e49164 | 120 | (match Ast0.unwrap d with |
b1b2de81 C |
121 | Ast0.DOTS(l) -> |
122 | let (n,l) = map_split_bind declaration l in (n, Ast0.DOTS(l)) | |
123 | | Ast0.CIRCLES(l) -> | |
124 | let (n,l) = map_split_bind declaration l in (n, Ast0.CIRCLES(l)) | |
125 | | Ast0.STARS(l) -> | |
126 | let (n,l) = map_split_bind declaration l in (n, Ast0.STARS(l))) in | |
34e49164 | 127 | dotsdeclfn all_functions k d |
b1b2de81 | 128 | |
34e49164 C |
129 | and case_line_dots d = |
130 | let k d = | |
b1b2de81 | 131 | rewrap d |
34e49164 | 132 | (match Ast0.unwrap d with |
b1b2de81 C |
133 | Ast0.DOTS(l) -> |
134 | let (n,l) = map_split_bind case_line l in (n, Ast0.DOTS(l)) | |
135 | | Ast0.CIRCLES(l) -> | |
136 | let (n,l) = map_split_bind case_line l in (n, Ast0.CIRCLES(l)) | |
137 | | Ast0.STARS(l) -> | |
138 | let (n,l) = map_split_bind case_line l in (n, Ast0.STARS(l))) in | |
34e49164 | 139 | dotscasefn all_functions k d |
b1b2de81 | 140 | |
34e49164 C |
141 | and ident i = |
142 | let k i = | |
b1b2de81 | 143 | rewrap i |
34e49164 | 144 | (match Ast0.unwrap i with |
b1b2de81 C |
145 | Ast0.Id(name) -> |
146 | let (n,name) = string_mcode name in (n,Ast0.Id(name)) | |
8babbc8f | 147 | | Ast0.MetaId(name,constraints,seed,pure) -> |
b1b2de81 | 148 | let (n,name) = meta_mcode name in |
8babbc8f | 149 | (n,Ast0.MetaId(name,constraints,seed,pure)) |
34e49164 | 150 | | Ast0.MetaFunc(name,constraints,pure) -> |
b1b2de81 C |
151 | let (n,name) = meta_mcode name in |
152 | (n,Ast0.MetaFunc(name,constraints,pure)) | |
34e49164 | 153 | | Ast0.MetaLocalFunc(name,constraints,pure) -> |
b1b2de81 C |
154 | let (n,name) = meta_mcode name in |
155 | (n,Ast0.MetaLocalFunc(name,constraints,pure)) | |
d3f655c6 C |
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)) | |
b1b2de81 C |
160 | | Ast0.OptIdent(id) -> |
161 | let (n,id) = ident id in (n,Ast0.OptIdent(id)) | |
162 | | Ast0.UniqueIdent(id) -> | |
d6ce1786 C |
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 | |
34e49164 | 168 | identfn all_functions k i |
b1b2de81 | 169 | |
34e49164 C |
170 | and expression e = |
171 | let k e = | |
b1b2de81 | 172 | rewrap e |
34e49164 | 173 | (match Ast0.unwrap e with |
b1b2de81 C |
174 | Ast0.Ident(id) -> |
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)) | |
34e49164 | 178 | | Ast0.FunCall(fn,lp,args,rp) -> |
b1b2de81 C |
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)) | |
34e49164 | 184 | | Ast0.Assignment(left,op,right,simple) -> |
b1b2de81 C |
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)) | |
17ba0788 C |
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)) | |
34e49164 | 196 | | Ast0.CondExpr(exp1,why,exp2,colon,exp3) -> |
b1b2de81 C |
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)) | |
34e49164 | 216 | | Ast0.Binary(left,op,right) -> |
b1b2de81 C |
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)) | |
34e49164 | 221 | | Ast0.Nested(left,op,right) -> |
b1b2de81 C |
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)) | |
34e49164 | 226 | | Ast0.Paren(lp,exp,rp) -> |
b1b2de81 C |
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)) | |
34e49164 | 231 | | Ast0.ArrayAccess(exp1,lb,exp2,rb) -> |
b1b2de81 C |
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)) | |
34e49164 | 238 | | Ast0.RecordAccess(exp,pt,field) -> |
b1b2de81 C |
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)) | |
34e49164 | 243 | | Ast0.RecordPtAccess(exp,ar,field) -> |
b1b2de81 C |
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)) | |
34e49164 | 248 | | Ast0.Cast(lp,ty,rp,exp) -> |
b1b2de81 C |
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)) | |
34e49164 | 254 | | Ast0.SizeOfExpr(szf,exp) -> |
b1b2de81 C |
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)) | |
34e49164 | 258 | | Ast0.SizeOfType(szf,lp,ty,rp) -> |
b1b2de81 C |
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)) | |
7fe62b65 C |
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)) | |
34e49164 | 273 | | Ast0.MetaErr(name,constraints,pure) -> |
b1b2de81 C |
274 | let (name_n,name) = meta_mcode name in |
275 | (name_n,Ast0.MetaErr(name,constraints,pure)) | |
34e49164 | 276 | | Ast0.MetaExpr(name,constraints,ty,form,pure) -> |
b1b2de81 C |
277 | let (name_n,name) = meta_mcode name in |
278 | (name_n,Ast0.MetaExpr(name,constraints,ty,form,pure)) | |
34e49164 | 279 | | Ast0.MetaExprList(name,lenname,pure) -> |
b1b2de81 C |
280 | let (name_n,name) = meta_mcode name in |
281 | (name_n,Ast0.MetaExprList(name,lenname,pure)) | |
282 | | Ast0.EComma(cm) -> | |
283 | let (cm_n,cm) = string_mcode cm in (cm_n,Ast0.EComma(cm)) | |
34e49164 | 284 | | Ast0.DisjExpr(starter,expr_list,mids,ender) -> |
d3f655c6 C |
285 | do_disj starter expr_list mids ender expression |
286 | (fun starter expr_list mids ender -> | |
287 | Ast0.DisjExpr(starter,expr_list,mids,ender)) | |
34e49164 | 288 | | Ast0.NestExpr(starter,expr_dots,ender,whencode,multi) -> |
b1b2de81 C |
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)) | |
34e49164 | 295 | | Ast0.Edots(dots,whencode) -> |
b1b2de81 C |
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)) | |
34e49164 | 299 | | Ast0.Ecircles(dots,whencode) -> |
b1b2de81 C |
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)) | |
34e49164 | 303 | | Ast0.Estars(dots,whencode) -> |
b1b2de81 C |
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 | |
17ba0788 C |
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 | |
34e49164 C |
317 | exprfn all_functions k e |
318 | and typeC t = | |
319 | let k t = | |
b1b2de81 | 320 | rewrap t |
34e49164 | 321 | (match Ast0.unwrap t with |
b1b2de81 C |
322 | Ast0.ConstVol(cv,ty) -> |
323 | let (cv_n,cv) = cv_mcode cv in | |
324 | let (ty_n,ty) = typeC ty in | |
755320b0 C |
325 | let front = |
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)) | |
faf9a90c | 331 | | Ast0.BaseType(ty,strings) -> |
b1b2de81 C |
332 | let (strings_n,strings) = map_split_bind string_mcode strings in |
333 | (strings_n, Ast0.BaseType(ty,strings)) | |
faf9a90c | 334 | | Ast0.Signed(sign,ty) -> |
b1b2de81 C |
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)) | |
34e49164 | 338 | | Ast0.Pointer(ty,star) -> |
b1b2de81 C |
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)) | |
34e49164 | 342 | | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> |
b1b2de81 | 343 | function_pointer (ty,lp1,star,rp1,lp2,params,rp2) [] |
34e49164 | 344 | | Ast0.FunctionType(ty,lp1,params,rp1) -> |
b1b2de81 C |
345 | function_type (ty,lp1,params,rp1) [] |
346 | | Ast0.Array(ty,lb,size,rb) -> array_type (ty,lb,size,rb) [] | |
faf9a90c | 347 | | Ast0.EnumName(kind,name) -> |
b1b2de81 | 348 | let (kind_n,kind) = string_mcode kind in |
c491d8ee | 349 | let (name_n,name) = get_option ident name in |
b1b2de81 | 350 | (bind kind_n name_n, Ast0.EnumName(kind,name)) |
c491d8ee C |
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)) | |
34e49164 | 357 | | Ast0.StructUnionName(kind,name) -> |
b1b2de81 C |
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)) | |
34e49164 | 361 | | Ast0.StructUnionDef(ty,lb,decls,rb) -> |
b1b2de81 C |
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)) | |
34e49164 | 371 | | Ast0.MetaType(name,pure) -> |
b1b2de81 C |
372 | let (name_n,name) = meta_mcode name in |
373 | (name_n,Ast0.MetaType(name,pure)) | |
34e49164 | 374 | | Ast0.DisjType(starter,types,mids,ender) -> |
d3f655c6 C |
375 | do_disj starter types mids ender typeC |
376 | (fun starter types mids ender -> | |
377 | Ast0.DisjType(starter,types,mids,ender)) | |
b1b2de81 C |
378 | | Ast0.OptType(ty) -> |
379 | let (ty_n,ty) = typeC ty in (ty_n, Ast0.OptType(ty)) | |
380 | | Ast0.UniqueType(ty) -> | |
17ba0788 C |
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 | |
34e49164 | 386 | tyfn all_functions k t |
b1b2de81 C |
387 | |
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)) | |
414 | ||
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) -> | |
419 | let tyres = | |
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) | |
429 | ||
34e49164 C |
430 | and declaration d = |
431 | let k d = | |
b1b2de81 | 432 | rewrap d |
34e49164 | 433 | (match Ast0.unwrap d with |
413ffc02 C |
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)) | |
190f1acf C |
440 | | Ast0.MetaFieldList(name,lenname,pure) -> |
441 | let (n,name) = meta_mcode name in | |
442 | (n,Ast0.MetaFieldList(name,lenname,pure)) | |
413ffc02 | 443 | | Ast0.Init(stg,ty,id,eq,ini,sem) -> |
b1b2de81 C |
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)) | |
34e49164 | 451 | | Ast0.UnInit(stg,ty,id,sem) -> |
b1b2de81 C |
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)) | |
34e49164 | 456 | | Ast0.MacroDecl(name,lp,args,rp,sem) -> |
b1b2de81 C |
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)) | |
17ba0788 C |
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)) | |
b1b2de81 C |
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)) | |
34e49164 | 478 | | Ast0.Typedef(stg,ty,id,sem) -> |
b1b2de81 C |
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)) | |
34e49164 | 484 | | Ast0.DisjDecl(starter,decls,mids,ender) -> |
d3f655c6 C |
485 | do_disj starter decls mids ender declaration |
486 | (fun starter decls mids ender -> | |
487 | Ast0.DisjDecl(starter,decls,mids,ender)) | |
34e49164 | 488 | | Ast0.Ddots(dots,whencode) -> |
b1b2de81 C |
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) -> | |
17ba0788 C |
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 | |
34e49164 | 500 | declfn all_functions k d |
b1b2de81 | 501 | |
34e49164 C |
502 | and initialiser i = |
503 | let k i = | |
b1b2de81 | 504 | rewrap i |
34e49164 | 505 | (match Ast0.unwrap i with |
113803cf | 506 | Ast0.MetaInit(name,pure) -> |
b1b2de81 C |
507 | let (name_n,name) = meta_mcode name in |
508 | (name_n,Ast0.MetaInit(name,pure)) | |
8f657093 C |
509 | | Ast0.MetaInitList(name,lenname,pure) -> |
510 | let (name_n,name) = meta_mcode name in | |
511 | (name_n,Ast0.MetaInitList(name,lenname,pure)) | |
b1b2de81 C |
512 | | Ast0.InitExpr(exp) -> |
513 | let (exp_n,exp) = expression exp in | |
514 | (exp_n,Ast0.InitExpr(exp)) | |
c491d8ee | 515 | | Ast0.InitList(lb,initlist,rb,ordered) -> |
b1b2de81 C |
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 | |
c491d8ee C |
519 | (multibind [lb_n;initlist_n;rb_n], |
520 | Ast0.InitList(lb,initlist,rb,ordered)) | |
113803cf | 521 | | Ast0.InitGccExt(designators,eq,ini) -> |
b1b2de81 C |
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)) | |
34e49164 | 526 | | Ast0.InitGccName(name,eq,ini) -> |
b1b2de81 C |
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)) | |
531 | | Ast0.IComma(cm) -> | |
532 | let (n,cm) = string_mcode cm in (n,Ast0.IComma(cm)) | |
34e49164 | 533 | | Ast0.Idots(d,whencode) -> |
b1b2de81 C |
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)) | |
537 | | Ast0.OptIni(i) -> | |
538 | let (n,i) = initialiser i in (n,Ast0.OptIni(i)) | |
539 | | Ast0.UniqueIni(i) -> | |
17ba0788 C |
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 | |
34e49164 | 545 | initfn all_functions k i |
113803cf C |
546 | |
547 | and designator = function | |
548 | Ast0.DesignatorField(dot,id) -> | |
b1b2de81 C |
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)) | |
113803cf | 552 | | Ast0.DesignatorIndex(lb,exp,rb) -> |
b1b2de81 C |
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)) | |
113803cf | 557 | | Ast0.DesignatorRange(lb,min,dots,max,rb) -> |
b1b2de81 C |
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)) | |
113803cf | 565 | |
34e49164 C |
566 | and parameterTypeDef p = |
567 | let k p = | |
b1b2de81 | 568 | rewrap p |
34e49164 | 569 | (match Ast0.unwrap p with |
b1b2de81 C |
570 | Ast0.VoidParam(ty) -> |
571 | let (n,ty) = typeC ty in (n,Ast0.VoidParam(ty)) | |
708f4980 C |
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) -> | |
b1b2de81 | 576 | let (ty_n,ty) = typeC ty in |
708f4980 | 577 | (ty_n, Ast0.Param(ty,None)) |
34e49164 | 578 | | Ast0.MetaParam(name,pure) -> |
b1b2de81 C |
579 | let (n,name) = meta_mcode name in |
580 | (n,Ast0.MetaParam(name,pure)) | |
34e49164 | 581 | | Ast0.MetaParamList(name,lenname,pure) -> |
b1b2de81 C |
582 | let (n,name) = meta_mcode name in |
583 | (n,Ast0.MetaParamList(name,lenname,pure)) | |
1b9ae606 C |
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)) | |
b1b2de81 C |
588 | | Ast0.PComma(cm) -> |
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)) | |
34e49164 | 596 | | Ast0.UniqueParam(param) -> |
b1b2de81 C |
597 | let (n,param) = parameterTypeDef param in |
598 | (n,Ast0.UniqueParam(param))) in | |
34e49164 | 599 | paramfn all_functions k p |
b1b2de81 | 600 | |
34e49164 C |
601 | (* not done for combiner, because the statement is assumed to be already |
602 | represented elsewhere in the code *) | |
b1b2de81 C |
603 | (* NOTE: This is not called for combiner_rebuilder. This is ok for its |
604 | only current use. *) | |
34e49164 C |
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) -> | |
b1b2de81 | 610 | let (_,stm) = statement stm in Ast0.DroppingBetweenDots(stm) |
34e49164 | 611 | | Ast0.AddingBetweenDots(stm) -> |
b1b2de81 | 612 | let (_,stm) = statement stm in Ast0.AddingBetweenDots(stm)) |
34e49164 C |
613 | |
614 | and statement s = | |
b1b2de81 | 615 | (if mode = COMBINER then let _ = process_bef_aft s in ()); |
34e49164 | 616 | let k s = |
b1b2de81 | 617 | rewrap s |
34e49164 C |
618 | (match Ast0.unwrap s with |
619 | Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace) -> | |
ae4735db | 620 | let (fi_n,fi) = map_split_bind fninfo fi in |
b1b2de81 | 621 | let (name_n,name) = ident name in |
ae4735db | 622 | let (lp_n,lp) = string_mcode lp in |
b1b2de81 | 623 | let (params_n,params) = parameter_list params in |
ae4735db | 624 | let (rp_n,rp) = string_mcode rp in |
b1b2de81 | 625 | let (lbrace_n,lbrace) = string_mcode lbrace in |
ae4735db | 626 | let (body_n,body) = statement_dots body in |
b1b2de81 C |
627 | let (rbrace_n,rbrace) = string_mcode rbrace in |
628 | (multibind | |
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)) | |
34e49164 | 634 | | Ast0.Seq(lbrace,body,rbrace) -> |
ae4735db | 635 | let (lbrace_n,lbrace) = string_mcode lbrace in |
b1b2de81 C |
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)) | |
34e49164 | 640 | | Ast0.ExprStatement(exp,sem) -> |
8babbc8f | 641 | let (exp_n,exp) = get_option expression exp in |
b1b2de81 C |
642 | let (sem_n,sem) = string_mcode sem in |
643 | (bind exp_n sem_n, Ast0.ExprStatement(exp,sem)) | |
34e49164 | 644 | | Ast0.IfThen(iff,lp,exp,rp,branch1,aft) -> |
ae4735db C |
645 | let (iff_n,iff) = string_mcode iff in |
646 | let (lp_n,lp) = string_mcode lp in | |
b1b2de81 C |
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)) | |
34e49164 | 652 | | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) -> |
ae4735db | 653 | let (iff_n,iff) = string_mcode iff in |
b1b2de81 C |
654 | let (lp_n,lp) = string_mcode lp in |
655 | let (exp_n,exp) = expression exp in | |
ae4735db C |
656 | let (rp_n,rp) = string_mcode rp in |
657 | let (branch1_n,branch1) = statement branch1 in | |
b1b2de81 C |
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)) | |
34e49164 | 662 | | Ast0.While(whl,lp,exp,rp,body,aft) -> |
b1b2de81 C |
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)) | |
34e49164 | 670 | | Ast0.Do(d,body,whl,lp,exp,rp,sem) -> |
b1b2de81 C |
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)) | |
755320b0 | 680 | | Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,aft) -> |
b1b2de81 C |
681 | let (fr_n,fr) = string_mcode fr in |
682 | let (lp_n,lp) = string_mcode lp in | |
755320b0 | 683 | let (first_n,first) = forinfo first in |
b1b2de81 C |
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 | |
755320b0 C |
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)) | |
34e49164 | 691 | | Ast0.Iterator(nm,lp,args,rp,body,aft) -> |
ae4735db | 692 | let (nm_n,nm) = ident nm in |
b1b2de81 C |
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)) | |
fc1ad971 | 699 | | Ast0.Switch(switch,lp,exp,rp,lb,decls,cases,rb) -> |
ae4735db | 700 | let (switch_n,switch) = string_mcode switch in |
b1b2de81 C |
701 | let (lp_n,lp) = string_mcode lp in |
702 | let (exp_n,exp) = expression exp in | |
ae4735db | 703 | let (rp_n,rp) = string_mcode rp in |
b1b2de81 | 704 | let (lb_n,lb) = string_mcode lb in |
ae4735db C |
705 | let (decls_n,decls) = statement_dots decls in |
706 | let (cases_n,cases) = case_line_dots cases in | |
b1b2de81 | 707 | let (rb_n,rb) = string_mcode rb in |
fc1ad971 C |
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)) | |
34e49164 | 710 | | Ast0.Break(br,sem) -> |
b1b2de81 C |
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)) | |
34e49164 | 714 | | Ast0.Continue(cont,sem) -> |
b1b2de81 C |
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)) | |
34e49164 | 722 | | Ast0.Goto(goto,l,sem) -> |
b1b2de81 C |
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)) | |
34e49164 | 727 | | Ast0.Return(ret,sem) -> |
b1b2de81 C |
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)) | |
34e49164 | 731 | | Ast0.ReturnExpr(ret,exp,sem) -> |
b1b2de81 C |
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)) | |
34e49164 | 736 | | Ast0.MetaStmt(name,pure) -> |
b1b2de81 C |
737 | let (name_n,name) = meta_mcode name in |
738 | (name_n,Ast0.MetaStmt(name,pure)) | |
34e49164 | 739 | | Ast0.MetaStmtList(name,pure) -> |
b1b2de81 C |
740 | let (name_n,name) = meta_mcode name in |
741 | (name_n,Ast0.MetaStmtList(name,pure)) | |
34e49164 | 742 | | Ast0.Disj(starter,statement_dots_list,mids,ender) -> |
d3f655c6 C |
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)) | |
34e49164 | 746 | | Ast0.Nest(starter,stmt_dots,ender,whn,multi) -> |
b1b2de81 C |
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 | |
750 | let (whn_n,whn) = | |
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)) | |
754 | | Ast0.Exp(exp) -> | |
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)) | |
760 | | Ast0.Ty(ty) -> | |
761 | let (ty_n,ty) = typeC ty in | |
762 | (ty_n,Ast0.Ty(ty)) | |
763 | | Ast0.TopInit(init) -> | |
764 | let (init_n,init) = initialiser init in | |
765 | (init_n,Ast0.TopInit(init)) | |
34e49164 | 766 | | Ast0.Dots(d,whn) -> |
b1b2de81 C |
767 | let (d_n,d) = string_mcode d in |
768 | let (whn_n,whn) = | |
769 | map_split_bind (whencode statement_dots statement) whn in | |
770 | (bind d_n whn_n, Ast0.Dots(d,whn)) | |
34e49164 | 771 | | Ast0.Circles(d,whn) -> |
b1b2de81 C |
772 | let (d_n,d) = string_mcode d in |
773 | let (whn_n,whn) = | |
774 | map_split_bind (whencode statement_dots statement) whn in | |
775 | (bind d_n whn_n, Ast0.Circles(d,whn)) | |
34e49164 | 776 | | Ast0.Stars(d,whn) -> |
b1b2de81 C |
777 | let (d_n,d) = string_mcode d in |
778 | let (whn_n,whn) = | |
779 | map_split_bind (whencode statement_dots statement) whn in | |
780 | (bind d_n whn_n, Ast0.Stars(d,whn)) | |
34e49164 | 781 | | Ast0.Include(inc,name) -> |
b1b2de81 C |
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)) | |
3a314143 C |
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)) | |
34e49164 | 789 | | Ast0.Define(def,id,params,body) -> |
b1b2de81 C |
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)) | |
796 | | Ast0.OptStm(re) -> | |
797 | let (re_n,re) = statement re in (re_n,Ast0.OptStm(re)) | |
798 | | Ast0.UniqueStm(re) -> | |
17ba0788 C |
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 | |
b1b2de81 C |
804 | let (n,s) = stmtfn all_functions k s in |
805 | (n,if mode = REBUILDER then process_bef_aft s else s) | |
34e49164 | 806 | |
755320b0 C |
807 | and forinfo fi = |
808 | let k fi = | |
809 | rewrap fi | |
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 | |
819 | ||
34e49164 C |
820 | (* not parameterizable for now... *) |
821 | and define_parameters p = | |
822 | let k p = | |
b1b2de81 | 823 | rewrap p |
34e49164 | 824 | (match Ast0.unwrap p with |
b1b2de81 | 825 | Ast0.NoParams -> (option_default,Ast0.NoParams) |
34e49164 | 826 | | Ast0.DParams(lp,params,rp) -> |
b1b2de81 C |
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 | |
34e49164 C |
831 | k p |
832 | ||
833 | and define_param_dots d = | |
834 | let k d = | |
b1b2de81 | 835 | rewrap d |
34e49164 | 836 | (match Ast0.unwrap d with |
b1b2de81 C |
837 | Ast0.DOTS(l) -> |
838 | let (n,l) = map_split_bind define_param l in (n,Ast0.DOTS(l)) | |
839 | | Ast0.CIRCLES(l) -> | |
840 | let (n,l) = map_split_bind define_param l in (n,Ast0.CIRCLES(l)) | |
841 | | Ast0.STARS(l) -> | |
842 | let (n,l) = map_split_bind define_param l in (n,Ast0.STARS(l))) in | |
34e49164 C |
843 | k d |
844 | ||
845 | and define_param p = | |
846 | let k p = | |
b1b2de81 | 847 | rewrap p |
34e49164 | 848 | (match Ast0.unwrap p with |
b1b2de81 C |
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)) | |
852 | | Ast0.DPdots(d) -> | |
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 | |
34e49164 C |
860 | k p |
861 | ||
862 | and fninfo = function | |
b1b2de81 C |
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)) | |
34e49164 C |
870 | |
871 | and whencode notfn alwaysfn = function | |
b1b2de81 C |
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)) | |
34e49164 C |
879 | |
880 | and case_line c = | |
881 | let k c = | |
b1b2de81 | 882 | rewrap c |
34e49164 C |
883 | (match Ast0.unwrap c with |
884 | Ast0.Default(def,colon,code) -> | |
b1b2de81 C |
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)) | |
34e49164 | 889 | | Ast0.Case(case,exp,colon,code) -> |
b1b2de81 C |
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)) | |
fc1ad971 | 896 | | Ast0.DisjCase(starter,case_lines,mids,ender) -> |
d3f655c6 C |
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)) | |
b1b2de81 C |
900 | | Ast0.OptCase(case) -> |
901 | let (n,case) = case_line case in (n,Ast0.OptCase(case))) in | |
34e49164 C |
902 | casefn all_functions k c |
903 | ||
904 | and top_level t = | |
905 | let k t = | |
b1b2de81 | 906 | rewrap t |
34e49164 C |
907 | (match Ast0.unwrap t with |
908 | Ast0.FILEINFO(old_file,new_file) -> | |
b1b2de81 C |
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)) | |
65038c61 | 912 | | Ast0.NONDECL(statement_dots) -> |
b1b2de81 | 913 | let (n,statement_dots) = statement statement_dots in |
65038c61 | 914 | (n,Ast0.NONDECL(statement_dots)) |
b1b2de81 C |
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)) | |
65038c61 C |
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)) | |
b1b2de81 C |
921 | | Ast0.ERRORWORDS(exps) -> |
922 | let (n,exps) = map_split_bind expression exps in | |
923 | (n, Ast0.ERRORWORDS(exps)) | |
34e49164 C |
924 | | Ast0.OTHER(_) -> failwith "unexpected code") in |
925 | topfn all_functions k t | |
926 | ||
927 | and anything a = (* for compile_iso, not parameterisable *) | |
928 | let k = function | |
b1b2de81 C |
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) -> | |
ae4735db | 939 | let (stmts_n,stmts) = statement_dots stmts in |
b1b2de81 C |
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)) | |
755320b0 C |
974 | | Ast0.ForInfoTag(fi) -> |
975 | let (fi_n,fi) = forinfo fi in | |
976 | (fi_n,Ast0.ForInfoTag(fi)) | |
b1b2de81 C |
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)) | |
17ba0788 C |
990 | | Ast0.MetaPosTag(var) -> failwith "not supported" |
991 | | Ast0.HiddenVarTag(var) -> failwith "not supported" in | |
34e49164 C |
992 | k a |
993 | ||
994 | (* not done for combiner, because the statement is assumed to be already | |
995 | represented elsewhere in the code *) | |
996 | ||
997 | and all_functions = | |
b1b2de81 C |
998 | {VT0.ident = ident; |
999 | VT0.expression = expression; | |
1000 | VT0.typeC = typeC; | |
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; | |
755320b0 | 1007 | VT0.forinfo = forinfo; |
b1b2de81 C |
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 | |
34e49164 | 1015 | all_functions |
b1b2de81 C |
1016 | |
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); | |
755320b0 | 1043 | VT0.combiner_forinfofn = (fun r k e -> k e); |
b1b2de81 C |
1044 | VT0.combiner_casefn = (fun r k e -> k e); |
1045 | VT0.combiner_topfn = (fun r k e -> k e)} | |
1046 | ||
1047 | let combiner_dz r = | |
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); | |
755320b0 C |
1066 | VT0.combiner_rec_forinfo = |
1067 | (function e -> let (n,_) = r.VT0.forinfo e in n); | |
b1b2de81 C |
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)} | |
1082 | ||
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 | |
1086 | combiner_dz | |
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)) | |
1098 | (function 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)) | |
755320b0 | 1114 | (fun r k e -> (functions.VT0.combiner_forinfofn (dz r) (xk k) e, e)) |
b1b2de81 C |
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))) | |
1117 | ||
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 | |
1121 | inc_mcode | |
1122 | dotsexprfn dotsinitfn dotsparamfn dotsstmtfn dotsdeclfn dotscasefn | |
755320b0 | 1123 | identfn exprfn tyfn initfn paramfn declfn stmtfn forinfofn casefn topfn = |
b1b2de81 C |
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)) | |
755320b0 | 1152 | (fun r k e -> (forinfofn (dz r) (xk k) e, e)) |
b1b2de81 C |
1153 | (fun r k e -> (casefn (dz r) (xk k) e, e)) |
1154 | (fun r k e -> (topfn (dz r) (xk k) e, e))) | |
1155 | ||
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); | |
755320b0 | 1182 | VT0.rebuilder_forinfofn = (fun r k e -> k e); |
b1b2de81 C |
1183 | VT0.rebuilder_casefn = (fun r k e -> k e); |
1184 | VT0.rebuilder_topfn = (fun r k e -> k e)} | |
1185 | ||
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); | |
755320b0 C |
1205 | VT0.rebuilder_rec_forinfo = |
1206 | (function e -> let (_,e) = r.VT0.forinfo e in e); | |
b1b2de81 C |
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)} | |
1221 | ||
1222 | let rebuilder functions = | |
1223 | let dz = rebuilder_dz in | |
1224 | let xk k e = let (_,e) = k e in e in | |
1225 | rebuilder_dz | |
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)) | |
755320b0 | 1252 | (fun r k e -> ((),functions.VT0.rebuilder_forinfofn (dz r) (xk k) e)) |
b1b2de81 C |
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))) | |
1255 | ||
1256 | let flat_rebuilder | |
1257 | meta_mcode string_mcode const_mcode assign_mcode fix_mcode unary_mcode | |
1258 | binary_mcode cv_mcode sign_mcode struct_mcode storage_mcode | |
1259 | inc_mcode | |
1260 | dotsexprfn dotsinitfn dotsparamfn dotsstmtfn dotsdeclfn dotscasefn | |
755320b0 | 1261 | identfn exprfn tyfn initfn paramfn declfn stmtfn forinfofn casefn topfn = |
b1b2de81 C |
1262 | let dz = rebuilder_dz in |
1263 | let xk k e = let (_,e) = k e in e in | |
1264 | rebuilder_dz | |
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)) | |
755320b0 | 1291 | (fun r k e -> ((),forinfofn (dz r) (xk k) e)) |
b1b2de81 C |
1292 | (fun r k e -> ((),casefn (dz r) (xk k) e)) |
1293 | (fun r k e -> ((),topfn (dz r) (xk k) e))) | |
1294 | ||
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); | |
755320b0 | 1333 | VT0.combiner_rebuilder_forinfofn = (fun r k e -> k e); |
b1b2de81 C |
1334 | VT0.combiner_rebuilder_casefn = (fun r k e -> k e); |
1335 | VT0.combiner_rebuilder_topfn = (fun r k e -> k e)} | |
1336 | ||
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 | |
755320b0 | 1364 | functions.VT0.combiner_rebuilder_forinfofn |
b1b2de81 C |
1365 | functions.VT0.combiner_rebuilder_casefn |
1366 | functions.VT0.combiner_rebuilder_topfn |