HCoop / bpt / coccinelle.git / blame
| Commit | Line | Data |
|---|---|---|
| 113803cf C |
1 | (* |
| 2 | * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen | |
| 3 | * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller | |
| 4 | * This file is part of Coccinelle. | |
| 5 | * | |
| 6 | * Coccinelle is free software: you can redistribute it and/or modify | |
| 7 | * it under the terms of the GNU General Public License as published by | |
| 8 | * the Free Software Foundation, according to version 2 of the License. | |
| 9 | * | |
| 10 | * Coccinelle is distributed in the hope that it will be useful, | |
| 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 13 | * GNU General Public License for more details. | |
| 14 | * | |
| 15 | * You should have received a copy of the GNU General Public License | |
| 16 | * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>. | |
| 17 | * | |
| 18 | * The authors reserve the right to distribute this or future versions of | |
| 19 | * Coccinelle under other licenses. | |
| 20 | *) | |
| 21 | ||
| 22 | ||
| 23 | module Ast = Ast_cocci | |
| 24 | module Ast0 = Ast0_cocci | |
| 25 | ||
| 26 | (* --------------------------------------------------------------------- *) | |
| 27 | (* Generic traversal: combiner *) | |
| 28 | (* parameters: | |
| 29 | combining function | |
| 30 | treatment of: mcode, identifiers, expressions, typeCs, types, | |
| 31 | declarations, statements, toplevels | |
| 32 | default value for options *) | |
| 33 | ||
| 34 | type 'a combiner = | |
| 35 | {combiner_ident : Ast0.ident -> 'a; | |
| 36 | combiner_expression : Ast0.expression -> 'a; | |
| 37 | combiner_typeC : Ast0.typeC -> 'a; | |
| 38 | combiner_declaration : Ast0.declaration -> 'a; | |
| 39 | combiner_initialiser : Ast0.initialiser -> 'a; | |
| 40 | combiner_initialiser_list : Ast0.initialiser_list -> 'a; | |
| 41 | combiner_parameter : Ast0.parameterTypeDef -> 'a; | |
| 42 | combiner_parameter_list : Ast0.parameter_list -> 'a; | |
| 43 | combiner_statement : Ast0.statement -> 'a; | |
| 44 | combiner_case_line : Ast0.case_line -> 'a; | |
| 45 | combiner_top_level : Ast0.top_level -> 'a; | |
| 46 | combiner_expression_dots : | |
| 47 | Ast0.expression Ast0.dots -> 'a; | |
| 48 | combiner_statement_dots : | |
| 49 | Ast0.statement Ast0.dots -> 'a; | |
| 50 | combiner_declaration_dots : | |
| 51 | Ast0.declaration Ast0.dots -> 'a; | |
| 52 | combiner_case_line_dots : | |
| 53 | Ast0.case_line Ast0.dots -> 'a; | |
| 54 | combiner_anything : Ast0.anything -> 'a} | |
| 55 | ||
| 56 | ||
| 57 | type ('mc,'a) cmcode = 'mc Ast0.mcode -> 'a | |
| 58 | type ('cd,'a) ccode = 'a combiner -> ('cd -> 'a) -> 'cd -> 'a | |
| 59 | ||
| 60 | let combiner bind option_default | |
| 61 | meta_mcode string_mcode const_mcode assign_mcode fix_mcode unary_mcode | |
| 62 | binary_mcode cv_mcode sign_mcode struct_mcode storage_mcode | |
| 63 | inc_mcode | |
| 64 | dotsexprfn dotsinitfn dotsparamfn dotsstmtfn dotsdeclfn dotscasefn | |
| 65 | identfn exprfn | |
| 66 | tyfn initfn paramfn declfn stmtfn casefn topfn = | |
| 67 | let multibind l = | |
| 68 | let rec loop = function | |
| 69 | [] -> option_default | |
| 70 | | [x] -> x | |
| 71 | | x::xs -> bind x (loop xs) in | |
| 72 | loop l in | |
| 73 | let get_option f = function | |
| 74 | Some x -> f x | |
| 75 | | None -> option_default in | |
| 76 | let rec expression_dots d = | |
| 77 | let k d = | |
| 78 | match Ast0.unwrap d with | |
| 79 | Ast0.DOTS(l) | Ast0.CIRCLES(l) | Ast0.STARS(l) -> | |
| 80 | multibind (List.map expression l) in | |
| 81 | dotsexprfn all_functions k d | |
| 82 | and initialiser_dots d = | |
| 83 | let k d = | |
| 84 | match Ast0.unwrap d with | |
| 85 | Ast0.DOTS(l) | Ast0.CIRCLES(l) | Ast0.STARS(l) -> | |
| 86 | multibind (List.map initialiser l) in | |
| 87 | dotsinitfn all_functions k d | |
| 88 | and parameter_dots d = | |
| 89 | let k d = | |
| 90 | match Ast0.unwrap d with | |
| 91 | Ast0.DOTS(l) | Ast0.CIRCLES(l) | Ast0.STARS(l) -> | |
| 92 | multibind (List.map parameterTypeDef l) in | |
| 93 | dotsparamfn all_functions k d | |
| 94 | and statement_dots d = | |
| 95 | let k d = | |
| 96 | match Ast0.unwrap d with | |
| 97 | Ast0.DOTS(l) | Ast0.CIRCLES(l) | Ast0.STARS(l) -> | |
| 98 | multibind (List.map statement l) in | |
| 99 | dotsstmtfn all_functions k d | |
| 100 | and declaration_dots d = | |
| 101 | let k d = | |
| 102 | match Ast0.unwrap d with | |
| 103 | Ast0.DOTS(l) | Ast0.CIRCLES(l) | Ast0.STARS(l) -> | |
| 104 | multibind (List.map declaration l) in | |
| 105 | dotsdeclfn all_functions k d | |
| 106 | and case_line_dots d = | |
| 107 | let k d = | |
| 108 | match Ast0.unwrap d with | |
| 109 | Ast0.DOTS(l) | Ast0.CIRCLES(l) | Ast0.STARS(l) -> | |
| 110 | multibind (List.map case_line l) in | |
| 111 | dotscasefn all_functions k d | |
| 112 | and ident i = | |
| 113 | let k i = | |
| 114 | match Ast0.unwrap i with | |
| 115 | Ast0.Id(name) -> string_mcode name | |
| 116 | | Ast0.MetaId(name,_,_) -> meta_mcode name | |
| 117 | | Ast0.MetaFunc(name,_,_) -> meta_mcode name | |
| 118 | | Ast0.MetaLocalFunc(name,_,_) -> meta_mcode name | |
| 119 | | Ast0.OptIdent(id) -> ident id | |
| 120 | | Ast0.UniqueIdent(id) -> ident id in | |
| 121 | identfn all_functions k i | |
| 122 | and expression e = | |
| 123 | let k e = | |
| 124 | match Ast0.unwrap e with | |
| 125 | Ast0.Ident(id) -> ident id | |
| 126 | | Ast0.Constant(const) -> const_mcode const | |
| 127 | | Ast0.FunCall(fn,lp,args,rp) -> | |
| 128 | multibind | |
| 129 | [expression fn; string_mcode lp; expression_dots args; | |
| 130 | string_mcode rp] | |
| 131 | | Ast0.Assignment(left,op,right,_) -> | |
| 132 | multibind [expression left; assign_mcode op; expression right] | |
| 133 | | Ast0.CondExpr(exp1,why,exp2,colon,exp3) -> | |
| 134 | multibind | |
| 135 | [expression exp1; string_mcode why; get_option expression exp2; | |
| 136 | string_mcode colon; expression exp3] | |
| 137 | | Ast0.Postfix(exp,op) -> bind (expression exp) (fix_mcode op) | |
| 138 | | Ast0.Infix(exp,op) -> bind (fix_mcode op) (expression exp) | |
| 139 | | Ast0.Unary(exp,op) -> bind (unary_mcode op) (expression exp) | |
| 140 | | Ast0.Binary(left,op,right) -> | |
| 141 | multibind [expression left; binary_mcode op; expression right] | |
| 142 | | Ast0.Nested(left,op,right) -> | |
| 143 | multibind [expression left; binary_mcode op; expression right] | |
| 144 | | Ast0.Paren(lp,exp,rp) -> | |
| 145 | multibind [string_mcode lp; expression exp; string_mcode rp] | |
| 146 | | Ast0.ArrayAccess(exp1,lb,exp2,rb) -> | |
| 147 | multibind | |
| 148 | [expression exp1; string_mcode lb; expression exp2; | |
| 149 | string_mcode rb] | |
| 150 | | Ast0.RecordAccess(exp,pt,field) -> | |
| 151 | multibind [expression exp; string_mcode pt; ident field] | |
| 152 | | Ast0.RecordPtAccess(exp,ar,field) -> | |
| 153 | multibind [expression exp; string_mcode ar; ident field] | |
| 154 | | Ast0.Cast(lp,ty,rp,exp) -> | |
| 155 | multibind | |
| 156 | [string_mcode lp; typeC ty; string_mcode rp; expression exp] | |
| 157 | | Ast0.SizeOfExpr(szf,exp) -> | |
| 158 | multibind [string_mcode szf; expression exp] | |
| 159 | | Ast0.SizeOfType(szf,lp,ty,rp) -> | |
| 160 | multibind | |
| 161 | [string_mcode szf; string_mcode lp; typeC ty; string_mcode rp] | |
| 162 | | Ast0.TypeExp(ty) -> typeC ty | |
| 163 | | Ast0.MetaErr(name,_,_) | |
| 164 | | Ast0.MetaExpr(name,_,_,_,_) | |
| 165 | | Ast0.MetaExprList(name,_,_) -> meta_mcode name | |
| 166 | | Ast0.EComma(cm) -> string_mcode cm | |
| 167 | | Ast0.DisjExpr(starter,expr_list,mids,ender) -> | |
| 168 | (match expr_list with | |
| 169 | [] -> failwith "bad disjunction" | |
| 170 | | x::xs -> | |
| 171 | bind (string_mcode starter) | |
| 172 | (bind (expression x) | |
| 173 | (bind | |
| 174 | (multibind | |
| 175 | (List.map2 | |
| 176 | (function mid -> | |
| 177 | function x -> | |
| 178 | bind (string_mcode mid) (expression x)) | |
| 179 | mids xs)) | |
| 180 | (string_mcode ender)))) | |
| 181 | | Ast0.NestExpr(starter,expr_dots,ender,whencode,multi) -> | |
| 182 | bind (string_mcode starter) | |
| 183 | (bind (expression_dots expr_dots) | |
| 184 | (bind (string_mcode ender) (get_option expression whencode))) | |
| 185 | | Ast0.Edots(dots,whencode) | Ast0.Ecircles(dots,whencode) | |
| 186 | | Ast0.Estars(dots,whencode) -> | |
| 187 | bind (string_mcode dots) (get_option expression whencode) | |
| 188 | | Ast0.OptExp(exp) -> expression exp | |
| 189 | | Ast0.UniqueExp(exp) -> expression exp in | |
| 190 | exprfn all_functions k e | |
| 191 | and function_pointer (ty,lp1,star,rp1,lp2,params,rp2) extra = | |
| 192 | (* have to put the treatment of the identifier into the right position *) | |
| 193 | multibind | |
| 194 | ([typeC ty; string_mcode lp1; string_mcode star] @ extra @ | |
| 195 | [string_mcode rp1; | |
| 196 | string_mcode lp2; parameter_dots params; string_mcode rp2]) | |
| 197 | and function_type (ty,lp1,params,rp1) extra = | |
| 198 | (* have to put the treatment of the identifier into the right position *) | |
| 199 | multibind ([get_option typeC ty] @ extra @ | |
| 200 | [string_mcode lp1; parameter_dots params; string_mcode rp1]) | |
| 201 | and array_type (ty,lb,size,rb) extra = | |
| 202 | multibind | |
| 203 | ([typeC ty] @ extra @ | |
| 204 | [string_mcode lb; get_option expression size; string_mcode rb]) | |
| 205 | and typeC t = | |
| 206 | let k t = | |
| 207 | match Ast0.unwrap t with | |
| 208 | Ast0.ConstVol(cv,ty) -> bind (cv_mcode cv) (typeC ty) | |
| 209 | | Ast0.BaseType(ty,strings) -> multibind (List.map string_mcode strings) | |
| 210 | | Ast0.Signed(sign,ty) -> bind (sign_mcode sign) (get_option typeC ty) | |
| 211 | | Ast0.Pointer(ty,star) -> bind (typeC ty) (string_mcode star) | |
| 212 | | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> | |
| 213 | function_pointer (ty,lp1,star,rp1,lp2,params,rp2) [] | |
| 214 | | Ast0.FunctionType(ty,lp1,params,rp1) -> | |
| 215 | function_type (ty,lp1,params,rp1) [] | |
| 216 | | Ast0.Array(ty,lb,size,rb) -> | |
| 217 | array_type (ty,lb,size,rb) [] | |
| 218 | | Ast0.EnumName(kind,name) -> bind (string_mcode kind) (ident name) | |
| 219 | | Ast0.StructUnionName(kind,name) -> | |
| 220 | bind (struct_mcode kind) (get_option ident name) | |
| 221 | | Ast0.StructUnionDef(ty,lb,decls,rb) -> | |
| 222 | multibind | |
| 223 | [typeC ty;string_mcode lb;declaration_dots decls;string_mcode rb] | |
| 224 | | Ast0.TypeName(name) -> string_mcode name | |
| 225 | | Ast0.MetaType(name,_) -> meta_mcode name | |
| 226 | | Ast0.DisjType(starter,types,mids,ender) -> | |
| 227 | (match types with | |
| 228 | [] -> failwith "bad disjunction" | |
| 229 | | x::xs -> | |
| 230 | bind (string_mcode starter) | |
| 231 | (bind (typeC x) | |
| 232 | (bind | |
| 233 | (multibind | |
| 234 | (List.map2 | |
| 235 | (function mid -> | |
| 236 | function x -> | |
| 237 | bind (string_mcode mid) (typeC x)) | |
| 238 | mids xs)) | |
| 239 | (string_mcode ender)))) | |
| 240 | | Ast0.OptType(ty) -> typeC ty | |
| 241 | | Ast0.UniqueType(ty) -> typeC ty in | |
| 242 | tyfn all_functions k t | |
| 243 | and named_type ty id = | |
| 244 | match Ast0.unwrap ty with | |
| 245 | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> | |
| 246 | function_pointer (ty,lp1,star,rp1,lp2,params,rp2) [ident id] | |
| 247 | | Ast0.FunctionType(ty,lp1,params,rp1) -> | |
| 248 | function_type (ty,lp1,params,rp1) [ident id] | |
| 249 | | Ast0.Array(ty,lb,size,rb) -> | |
| 250 | array_type (ty,lb,size,rb) [ident id] | |
| 251 | | _ -> bind (typeC ty) (ident id) | |
| 252 | and declaration d = | |
| 253 | let k d = | |
| 254 | match Ast0.unwrap d with | |
| 255 | Ast0.Init(stg,ty,id,eq,ini,sem) -> | |
| 256 | bind (get_option storage_mcode stg) | |
| 257 | (bind (named_type ty id) | |
| 258 | (multibind | |
| 259 | [string_mcode eq; initialiser ini; string_mcode sem])) | |
| 260 | | Ast0.UnInit(stg,ty,id,sem) -> | |
| 261 | bind (get_option storage_mcode stg) | |
| 262 | (bind (named_type ty id) (string_mcode sem)) | |
| 263 | | Ast0.MacroDecl(name,lp,args,rp,sem) -> | |
| 264 | multibind | |
| 265 | [ident name; string_mcode lp; expression_dots args; | |
| 266 | string_mcode rp; string_mcode sem] | |
| 267 | | Ast0.TyDecl(ty,sem) -> bind (typeC ty) (string_mcode sem) | |
| 268 | | Ast0.Typedef(stg,ty,id,sem) -> | |
| 269 | bind (string_mcode stg) | |
| 270 | (bind (typeC ty) (bind (typeC id) (string_mcode sem))) | |
| 271 | | Ast0.DisjDecl(starter,decls,mids,ender) -> | |
| 272 | (match decls with | |
| 273 | [] -> failwith "bad disjunction" | |
| 274 | | x::xs -> | |
| 275 | bind (string_mcode starter) | |
| 276 | (bind (declaration x) | |
| 277 | (bind | |
| 278 | (multibind | |
| 279 | (List.map2 | |
| 280 | (function mid -> | |
| 281 | function x -> | |
| 282 | bind (string_mcode mid) (declaration x)) | |
| 283 | mids xs)) | |
| 284 | (string_mcode ender)))) | |
| 285 | | Ast0.Ddots(dots,whencode) -> | |
| 286 | bind (string_mcode dots) (get_option declaration whencode) | |
| 287 | | Ast0.OptDecl(decl) -> declaration decl | |
| 288 | | Ast0.UniqueDecl(decl) -> declaration decl in | |
| 289 | declfn all_functions k d | |
| 290 | and initialiser i = | |
| 291 | let k i = | |
| 292 | match Ast0.unwrap i with | |
| 293 | Ast0.InitExpr(exp) -> expression exp | |
| 294 | | Ast0.InitList(lb,initlist,rb) -> | |
| 295 | multibind | |
| 296 | [string_mcode lb; initialiser_dots initlist; string_mcode rb] | |
| 297 | | Ast0.InitGccDotName(dot,name,eq,ini) -> | |
| 298 | multibind | |
| 299 | [string_mcode dot; ident name; string_mcode eq; initialiser ini] | |
| 300 | | Ast0.InitGccName(name,eq,ini) -> | |
| 301 | multibind [ident name; string_mcode eq; initialiser ini] | |
| 302 | | Ast0.InitGccIndex(lb,exp,rb,eq,ini) -> | |
| 303 | multibind | |
| 304 | [string_mcode lb; expression exp; string_mcode rb; | |
| 305 | string_mcode eq; initialiser ini] | |
| 306 | | Ast0.InitGccRange(lb,exp1,dots,exp2,rb,eq,ini) -> | |
| 307 | multibind | |
| 308 | [string_mcode lb; expression exp1; string_mcode dots; | |
| 309 | expression exp2; string_mcode rb; string_mcode eq; | |
| 310 | initialiser ini] | |
| 311 | | Ast0.IComma(cm) -> string_mcode cm | |
| 312 | | Ast0.Idots(dots,whencode) -> | |
| 313 | bind (string_mcode dots) (get_option initialiser whencode) | |
| 314 | | Ast0.OptIni(i) -> initialiser i | |
| 315 | | Ast0.UniqueIni(i) -> initialiser i in | |
| 316 | initfn all_functions k i | |
| 317 | and parameterTypeDef p = | |
| 318 | let k p = | |
| 319 | match Ast0.unwrap p with | |
| 320 | Ast0.VoidParam(ty) -> typeC ty | |
| 321 | | Ast0.Param(ty,Some id) -> named_type ty id | |
| 322 | | Ast0.Param(ty,None) -> typeC ty | |
| 323 | | Ast0.MetaParam(name,_) -> meta_mcode name | |
| 324 | | Ast0.MetaParamList(name,_,_) -> meta_mcode name | |
| 325 | | Ast0.PComma(cm) -> string_mcode cm | |
| 326 | | Ast0.Pdots(dots) -> string_mcode dots | |
| 327 | | Ast0.Pcircles(dots) -> string_mcode dots | |
| 328 | | Ast0.OptParam(param) -> parameterTypeDef param | |
| 329 | | Ast0.UniqueParam(param) -> parameterTypeDef param in | |
| 330 | paramfn all_functions k p | |
| 331 | ||
| 332 | (* discard the result, because the statement is assumed to be already | |
| 333 | represented elsewhere in the code *) | |
| 334 | and process_bef_aft s = | |
| 335 | match Ast0.get_dots_bef_aft s with | |
| 336 | Ast0.NoDots -> () | |
| 337 | | Ast0.DroppingBetweenDots(stm) -> let _ = statement stm in () | |
| 338 | | Ast0.AddingBetweenDots(stm) -> let _ = statement stm in () | |
| 339 | ||
| 340 | and statement s = | |
| 341 | process_bef_aft s; | |
| 342 | let k s = | |
| 343 | match Ast0.unwrap s with | |
| 344 | Ast0.FunDecl(_,fi,name,lp,params,rp,lbrace,body,rbrace) -> | |
| 345 | multibind | |
| 346 | ((List.map fninfo fi) @ | |
| 347 | [ident name; string_mcode lp; | |
| 348 | parameter_dots params; string_mcode rp; string_mcode lbrace; | |
| 349 | statement_dots body; string_mcode rbrace]) | |
| 350 | | Ast0.Decl(_,decl) -> declaration decl | |
| 351 | | Ast0.Seq(lbrace,body,rbrace) -> | |
| 352 | multibind | |
| 353 | [string_mcode lbrace; statement_dots body; string_mcode rbrace] | |
| 354 | | Ast0.ExprStatement(exp,sem) -> | |
| 355 | bind (expression exp) (string_mcode sem) | |
| 356 | | Ast0.IfThen(iff,lp,exp,rp,branch1,_) -> | |
| 357 | multibind | |
| 358 | [string_mcode iff; string_mcode lp; expression exp; | |
| 359 | string_mcode rp; statement branch1] | |
| 360 | | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,_) -> | |
| 361 | multibind | |
| 362 | [string_mcode iff; string_mcode lp; expression exp; | |
| 363 | string_mcode rp; statement branch1; string_mcode els; | |
| 364 | statement branch2] | |
| 365 | | Ast0.While(whl,lp,exp,rp,body,_) -> | |
| 366 | multibind | |
| 367 | [string_mcode whl; string_mcode lp; expression exp; | |
| 368 | string_mcode rp; statement body] | |
| 369 | | Ast0.Do(d,body,whl,lp,exp,rp,sem) -> | |
| 370 | multibind | |
| 371 | [string_mcode d; statement body; string_mcode whl; | |
| 372 | string_mcode lp; expression exp; string_mcode rp; | |
| 373 | string_mcode sem] | |
| 374 | | Ast0.For(fr,lp,e1,sem1,e2,sem2,e3,rp,body,_) -> | |
| 375 | multibind | |
| 376 | [string_mcode fr; string_mcode lp; get_option expression e1; | |
| 377 | string_mcode sem1; get_option expression e2; string_mcode sem2; | |
| 378 | get_option expression e3; | |
| 379 | string_mcode rp; statement body] | |
| 380 | | Ast0.Iterator(nm,lp,args,rp,body,_) -> | |
| 381 | multibind | |
| 382 | [ident nm; string_mcode lp; expression_dots args; | |
| 383 | string_mcode rp; statement body] | |
| 384 | | Ast0.Switch(switch,lp,exp,rp,lb,cases,rb) -> | |
| 385 | multibind | |
| 386 | [string_mcode switch; string_mcode lp; expression exp; | |
| 387 | string_mcode rp; string_mcode lb; case_line_dots cases; | |
| 388 | string_mcode rb] | |
| 389 | | Ast0.Break(br,sem) -> bind (string_mcode br) (string_mcode sem) | |
| 390 | | Ast0.Continue(cont,sem) -> bind (string_mcode cont) (string_mcode sem) | |
| 391 | | Ast0.Label(l,dd) -> bind (ident l) (string_mcode dd) | |
| 392 | | Ast0.Goto(goto,l,sem) -> | |
| 393 | bind (string_mcode goto) (bind (ident l) (string_mcode sem)) | |
| 394 | | Ast0.Return(ret,sem) -> bind (string_mcode ret) (string_mcode sem) | |
| 395 | | Ast0.ReturnExpr(ret,exp,sem) -> | |
| 396 | multibind [string_mcode ret; expression exp; string_mcode sem] | |
| 397 | | Ast0.MetaStmt(name,_) -> meta_mcode name | |
| 398 | | Ast0.MetaStmtList(name,_) -> meta_mcode name | |
| 399 | | Ast0.Disj(starter,statement_dots_list,mids,ender) -> | |
| 400 | (match statement_dots_list with | |
| 401 | [] -> failwith "bad disjunction" | |
| 402 | | x::xs -> | |
| 403 | bind (string_mcode starter) | |
| 404 | (bind (statement_dots x) | |
| 405 | (bind | |
| 406 | (multibind | |
| 407 | (List.map2 | |
| 408 | (function mid -> | |
| 409 | function x -> | |
| 410 | bind (string_mcode mid) (statement_dots x)) | |
| 411 | mids xs)) | |
| 412 | (string_mcode ender)))) | |
| 413 | | Ast0.Nest(starter,stmt_dots,ender,whn,multi) -> | |
| 414 | bind (string_mcode starter) | |
| 415 | (bind (statement_dots stmt_dots) | |
| 416 | (bind (string_mcode ender) | |
| 417 | (multibind | |
| 418 | (List.map (whencode statement_dots statement) whn)))) | |
| 419 | | Ast0.Exp(exp) -> expression exp | |
| 420 | | Ast0.TopExp(exp) -> expression exp | |
| 421 | | Ast0.Ty(ty) -> typeC ty | |
| 422 | | Ast0.TopInit(init) -> initialiser init | |
| 423 | | Ast0.Dots(d,whn) | Ast0.Circles(d,whn) | Ast0.Stars(d,whn) -> | |
| 424 | bind (string_mcode d) | |
| 425 | (multibind (List.map (whencode statement_dots statement) whn)) | |
| 426 | | Ast0.Include(inc,name) -> bind (string_mcode inc) (inc_mcode name) | |
| 427 | | Ast0.Define(def,id,params,body) -> | |
| 428 | multibind [string_mcode def; ident id; define_parameters params; | |
| 429 | statement_dots body] | |
| 430 | | Ast0.OptStm(re) -> statement re | |
| 431 | | Ast0.UniqueStm(re) -> statement re in | |
| 432 | stmtfn all_functions k s | |
| 433 | ||
| 434 | (* not parameterizable for now... *) | |
| 435 | and define_parameters p = | |
| 436 | let k p = | |
| 437 | match Ast0.unwrap p with | |
| 438 | Ast0.NoParams -> option_default | |
| 439 | | Ast0.DParams(lp,params,rp) -> | |
| 440 | multibind | |
| 441 | [string_mcode lp; define_param_dots params; string_mcode rp] in | |
| 442 | k p | |
| 443 | ||
| 444 | and define_param_dots d = | |
| 445 | let k d = | |
| 446 | match Ast0.unwrap d with | |
| 447 | Ast0.DOTS(l) | Ast0.CIRCLES(l) | Ast0.STARS(l) -> | |
| 448 | multibind (List.map define_param l) in | |
| 449 | k d | |
| 450 | ||
| 451 | and define_param p = | |
| 452 | let k p = | |
| 453 | match Ast0.unwrap p with | |
| 454 | Ast0.DParam(id) -> ident id | |
| 455 | | Ast0.DPComma(comma) -> string_mcode comma | |
| 456 | | Ast0.DPdots(d) -> string_mcode d | |
| 457 | | Ast0.DPcircles(c) -> string_mcode c | |
| 458 | | Ast0.OptDParam(dp) -> define_param dp | |
| 459 | | Ast0.UniqueDParam(dp) -> define_param dp in | |
| 460 | k p | |
| 461 | ||
| 462 | and fninfo = function | |
| 463 | Ast0.FStorage(stg) -> storage_mcode stg | |
| 464 | | Ast0.FType(ty) -> typeC ty | |
| 465 | | Ast0.FInline(inline) -> string_mcode inline | |
| 466 | | Ast0.FAttr(init) -> string_mcode init | |
| 467 | ||
| 468 | and whencode notfn alwaysfn = function | |
| 469 | Ast0.WhenNot a -> notfn a | |
| 470 | | Ast0.WhenAlways a -> alwaysfn a | |
| 471 | | Ast0.WhenModifier(_) -> option_default | |
| 472 | | Ast0.WhenNotTrue(e) -> expression e | |
| 473 | | Ast0.WhenNotFalse(e) -> expression e | |
| 474 | ||
| 475 | and case_line c = | |
| 476 | let k c = | |
| 477 | match Ast0.unwrap c with | |
| 478 | Ast0.Default(def,colon,code) -> | |
| 479 | multibind [string_mcode def;string_mcode colon;statement_dots code] | |
| 480 | | Ast0.Case(case,exp,colon,code) -> | |
| 481 | multibind [string_mcode case;expression exp;string_mcode colon; | |
| 482 | statement_dots code] | |
| 483 | | Ast0.OptCase(case) -> case_line case in | |
| 484 | casefn all_functions k c | |
| 485 | ||
| 486 | and anything a = (* for compile_iso, not parameterisable *) | |
| 487 | let k = function | |
| 488 | Ast0.DotsExprTag(exprs) -> expression_dots exprs | |
| 489 | | Ast0.DotsInitTag(inits) -> initialiser_dots inits | |
| 490 | | Ast0.DotsParamTag(params) -> parameter_dots params | |
| 491 | | Ast0.DotsStmtTag(stmts) -> statement_dots stmts | |
| 492 | | Ast0.DotsDeclTag(decls) -> declaration_dots decls | |
| 493 | | Ast0.DotsCaseTag(cases) -> case_line_dots cases | |
| 494 | | Ast0.IdentTag(id) -> ident id | |
| 495 | | Ast0.ExprTag(exp) -> expression exp | |
| 496 | | Ast0.ArgExprTag(exp) -> expression exp | |
| 497 | | Ast0.TestExprTag(exp) -> expression exp | |
| 498 | | Ast0.TypeCTag(ty) -> typeC ty | |
| 499 | | Ast0.ParamTag(param) -> parameterTypeDef param | |
| 500 | | Ast0.InitTag(init) -> initialiser init | |
| 501 | | Ast0.DeclTag(decl) -> declaration decl | |
| 502 | | Ast0.StmtTag(stmt) -> statement stmt | |
| 503 | | Ast0.CaseLineTag(c) -> case_line c | |
| 504 | | Ast0.TopTag(top) -> top_level top | |
| 505 | | Ast0.IsoWhenTag(_) -> option_default | |
| 506 | | Ast0.IsoWhenTTag(e) -> expression e | |
| 507 | | Ast0.IsoWhenFTag(e) -> expression e | |
| 508 | | Ast0.MetaPosTag(var) -> failwith "not supported" in | |
| 509 | k a | |
| 510 | ||
| 511 | and top_level t = | |
| 512 | let k t = | |
| 513 | match Ast0.unwrap t with | |
| 514 | Ast0.FILEINFO(old_file,new_file) -> | |
| 515 | bind (string_mcode old_file) (string_mcode new_file) | |
| 516 | | Ast0.DECL(stmt_dots) -> statement stmt_dots | |
| 517 | | Ast0.CODE(stmt_dots) -> statement_dots stmt_dots | |
| 518 | | Ast0.ERRORWORDS(exps) -> multibind (List.map expression exps) | |
| 519 | | Ast0.OTHER(_) -> failwith "unexpected code" in | |
| 520 | topfn all_functions k t | |
| 521 | and all_functions = | |
| 522 | {combiner_ident = ident; | |
| 523 | combiner_expression = expression; | |
| 524 | combiner_typeC = typeC; | |
| 525 | combiner_declaration = declaration; | |
| 526 | combiner_initialiser = initialiser; | |
| 527 | combiner_initialiser_list = initialiser_dots; | |
| 528 | combiner_parameter = parameterTypeDef; | |
| 529 | combiner_parameter_list = parameter_dots; | |
| 530 | combiner_statement = statement; | |
| 531 | combiner_case_line = case_line; | |
| 532 | combiner_top_level = top_level; | |
| 533 | combiner_expression_dots = expression_dots; | |
| 534 | combiner_statement_dots = statement_dots; | |
| 535 | combiner_declaration_dots = declaration_dots; | |
| 536 | combiner_case_line_dots = case_line_dots; | |
| 537 | combiner_anything = anything} in | |
| 538 | all_functions | |
| 539 | ||
| 540 | (* --------------------------------------------------------------------- *) | |
| 541 | (* Generic traversal: rebuilder *) | |
| 542 | ||
| 543 | type 'a inout = 'a -> 'a (* for specifying the type of rebuilder *) | |
| 544 | ||
| 545 | type rebuilder = | |
| 546 | {rebuilder_ident : Ast0.ident inout; | |
| 547 | rebuilder_expression : Ast0.expression inout; | |
| 548 | rebuilder_typeC : Ast0.typeC inout; | |
| 549 | rebuilder_declaration : Ast0.declaration inout; | |
| 550 | rebuilder_initialiser : Ast0.initialiser inout; | |
| 551 | rebuilder_initialiser_list : Ast0.initialiser_list inout; | |
| 552 | rebuilder_parameter : Ast0.parameterTypeDef inout; | |
| 553 | rebuilder_parameter_list : Ast0.parameter_list inout; | |
| 554 | rebuilder_statement : Ast0.statement inout; | |
| 555 | rebuilder_case_line : Ast0.case_line inout; | |
| 556 | rebuilder_top_level : Ast0.top_level inout; | |
| 557 | rebuilder_expression_dots : | |
| 558 | Ast0.expression Ast0.dots -> | |
| 559 | Ast0.expression Ast0.dots; | |
| 560 | rebuilder_statement_dots : | |
| 561 | Ast0.statement Ast0.dots -> | |
| 562 | Ast0.statement Ast0.dots; | |
| 563 | rebuilder_declaration_dots : | |
| 564 | Ast0.declaration Ast0.dots -> | |
| 565 | Ast0.declaration Ast0.dots; | |
| 566 | rebuilder_case_line_dots : | |
| 567 | Ast0.case_line Ast0.dots -> | |
| 568 | Ast0.case_line Ast0.dots; | |
| 569 | rebuilder_anything : | |
| 570 | Ast0.anything -> Ast0.anything} | |
| 571 | ||
| 572 | type 'mc rmcode = 'mc Ast0.mcode inout | |
| 573 | type 'cd rcode = rebuilder -> ('cd inout) -> 'cd inout | |
| 574 | ||
| 575 | let rebuilder = fun | |
| 576 | meta_mcode string_mcode const_mcode assign_mcode fix_mcode unary_mcode | |
| 577 | binary_mcode cv_mcode sign_mcode struct_mcode storage_mcode | |
| 578 | inc_mcode | |
| 579 | dotsexprfn dotsinitfn dotsparamfn dotsstmtfn dotsdeclfn dotscasefn | |
| 580 | identfn exprfn tyfn initfn paramfn declfn stmtfn casefn topfn -> | |
| 581 | let get_option f = function | |
| 582 | Some x -> Some (f x) | |
| 583 | | None -> None in | |
| 584 | let rec expression_dots d = | |
| 585 | let k d = | |
| 586 | Ast0.rewrap d | |
| 587 | (match Ast0.unwrap d with | |
| 588 | Ast0.DOTS(l) -> Ast0.DOTS(List.map expression l) | |
| 589 | | Ast0.CIRCLES(l) -> Ast0.CIRCLES(List.map expression l) | |
| 590 | | Ast0.STARS(l) -> Ast0.STARS(List.map expression l)) in | |
| 591 | dotsexprfn all_functions k d | |
| 592 | and initialiser_list i = | |
| 593 | let k i = | |
| 594 | Ast0.rewrap i | |
| 595 | (match Ast0.unwrap i with | |
| 596 | Ast0.DOTS(l) -> Ast0.DOTS(List.map initialiser l) | |
| 597 | | Ast0.CIRCLES(l) -> Ast0.CIRCLES(List.map initialiser l) | |
| 598 | | Ast0.STARS(l) -> Ast0.STARS(List.map initialiser l)) in | |
| 599 | dotsinitfn all_functions k i | |
| 600 | and parameter_list d = | |
| 601 | let k d = | |
| 602 | Ast0.rewrap d | |
| 603 | (match Ast0.unwrap d with | |
| 604 | Ast0.DOTS(l) -> Ast0.DOTS(List.map parameterTypeDef l) | |
| 605 | | Ast0.CIRCLES(l) -> Ast0.CIRCLES(List.map parameterTypeDef l) | |
| 606 | | Ast0.STARS(l) -> Ast0.STARS(List.map parameterTypeDef l)) in | |
| 607 | dotsparamfn all_functions k d | |
| 608 | and statement_dots d = | |
| 609 | let k d = | |
| 610 | Ast0.rewrap d | |
| 611 | (match Ast0.unwrap d with | |
| 612 | Ast0.DOTS(l) -> Ast0.DOTS(List.map statement l) | |
| 613 | | Ast0.CIRCLES(l) -> Ast0.CIRCLES(List.map statement l) | |
| 614 | | Ast0.STARS(l) -> Ast0.STARS(List.map statement l)) in | |
| 615 | dotsstmtfn all_functions k d | |
| 616 | and declaration_dots d = | |
| 617 | let k d = | |
| 618 | Ast0.rewrap d | |
| 619 | (match Ast0.unwrap d with | |
| 620 | Ast0.DOTS(l) -> Ast0.DOTS(List.map declaration l) | |
| 621 | | Ast0.CIRCLES(l) -> Ast0.CIRCLES(List.map declaration l) | |
| 622 | | Ast0.STARS(l) -> Ast0.STARS(List.map declaration l)) in | |
| 623 | dotsdeclfn all_functions k d | |
| 624 | and case_line_dots d = | |
| 625 | let k d = | |
| 626 | Ast0.rewrap d | |
| 627 | (match Ast0.unwrap d with | |
| 628 | Ast0.DOTS(l) -> Ast0.DOTS(List.map case_line l) | |
| 629 | | Ast0.CIRCLES(l) -> Ast0.CIRCLES(List.map case_line l) | |
| 630 | | Ast0.STARS(l) -> Ast0.STARS(List.map case_line l)) in | |
| 631 | dotscasefn all_functions k d | |
| 632 | and ident i = | |
| 633 | let k i = | |
| 634 | Ast0.rewrap i | |
| 635 | (match Ast0.unwrap i with | |
| 636 | Ast0.Id(name) -> Ast0.Id(string_mcode name) | |
| 637 | | Ast0.MetaId(name,constraints,pure) -> | |
| 638 | Ast0.MetaId(meta_mcode name,constraints,pure) | |
| 639 | | Ast0.MetaFunc(name,constraints,pure) -> | |
| 640 | Ast0.MetaFunc(meta_mcode name,constraints,pure) | |
| 641 | | Ast0.MetaLocalFunc(name,constraints,pure) -> | |
| 642 | Ast0.MetaLocalFunc(meta_mcode name,constraints,pure) | |
| 643 | | Ast0.OptIdent(id) -> Ast0.OptIdent(ident id) | |
| 644 | | Ast0.UniqueIdent(id) -> Ast0.UniqueIdent(ident id)) in | |
| 645 | identfn all_functions k i | |
| 646 | and expression e = | |
| 647 | let k e = | |
| 648 | Ast0.rewrap e | |
| 649 | (match Ast0.unwrap e with | |
| 650 | Ast0.Ident(id) -> Ast0.Ident(ident id) | |
| 651 | | Ast0.Constant(const) -> Ast0.Constant(const_mcode const) | |
| 652 | | Ast0.FunCall(fn,lp,args,rp) -> | |
| 653 | Ast0.FunCall(expression fn,string_mcode lp,expression_dots args, | |
| 654 | string_mcode rp) | |
| 655 | | Ast0.Assignment(left,op,right,simple) -> | |
| 656 | Ast0.Assignment(expression left,assign_mcode op,expression right, | |
| 657 | simple) | |
| 658 | | Ast0.CondExpr(exp1,why,exp2,colon,exp3) -> | |
| 659 | Ast0.CondExpr(expression exp1, string_mcode why, | |
| 660 | get_option expression exp2, string_mcode colon, | |
| 661 | expression exp3) | |
| 662 | | Ast0.Postfix(exp,op) -> Ast0.Postfix(expression exp, fix_mcode op) | |
| 663 | | Ast0.Infix(exp,op) -> Ast0.Infix(expression exp, fix_mcode op) | |
| 664 | | Ast0.Unary(exp,op) -> Ast0.Unary(expression exp, unary_mcode op) | |
| 665 | | Ast0.Binary(left,op,right) -> | |
| 666 | Ast0.Binary(expression left, binary_mcode op, expression right) | |
| 667 | | Ast0.Nested(left,op,right) -> | |
| 668 | Ast0.Nested(expression left, binary_mcode op, expression right) | |
| 669 | | Ast0.Paren(lp,exp,rp) -> | |
| 670 | Ast0.Paren(string_mcode lp, expression exp, string_mcode rp) | |
| 671 | | Ast0.ArrayAccess(exp1,lb,exp2,rb) -> | |
| 672 | Ast0.ArrayAccess(expression exp1,string_mcode lb,expression exp2, | |
| 673 | string_mcode rb) | |
| 674 | | Ast0.RecordAccess(exp,pt,field) -> | |
| 675 | Ast0.RecordAccess(expression exp, string_mcode pt, ident field) | |
| 676 | | Ast0.RecordPtAccess(exp,ar,field) -> | |
| 677 | Ast0.RecordPtAccess(expression exp, string_mcode ar, ident field) | |
| 678 | | Ast0.Cast(lp,ty,rp,exp) -> | |
| 679 | Ast0.Cast(string_mcode lp, typeC ty, string_mcode rp, | |
| 680 | expression exp) | |
| 681 | | Ast0.SizeOfExpr(szf,exp) -> | |
| 682 | Ast0.SizeOfExpr(string_mcode szf, expression exp) | |
| 683 | | Ast0.SizeOfType(szf,lp,ty,rp) -> | |
| 684 | Ast0.SizeOfType(string_mcode szf,string_mcode lp, typeC ty, | |
| 685 | string_mcode rp) | |
| 686 | | Ast0.TypeExp(ty) -> Ast0.TypeExp(typeC ty) | |
| 687 | | Ast0.MetaErr(name,constraints,pure) -> | |
| 688 | Ast0.MetaErr(meta_mcode name,constraints,pure) | |
| 689 | | Ast0.MetaExpr(name,constraints,ty,form,pure) -> | |
| 690 | Ast0.MetaExpr(meta_mcode name,constraints,ty,form,pure) | |
| 691 | | Ast0.MetaExprList(name,lenname,pure) -> | |
| 692 | Ast0.MetaExprList(meta_mcode name,lenname,pure) | |
| 693 | | Ast0.EComma(cm) -> Ast0.EComma(string_mcode cm) | |
| 694 | | Ast0.DisjExpr(starter,expr_list,mids,ender) -> | |
| 695 | Ast0.DisjExpr(string_mcode starter,List.map expression expr_list, | |
| 696 | List.map string_mcode mids,string_mcode ender) | |
| 697 | | Ast0.NestExpr(starter,expr_dots,ender,whencode,multi) -> | |
| 698 | Ast0.NestExpr(string_mcode starter,expression_dots expr_dots, | |
| 699 | string_mcode ender, get_option expression whencode, | |
| 700 | multi) | |
| 701 | | Ast0.Edots(dots,whencode) -> | |
| 702 | Ast0.Edots(string_mcode dots, get_option expression whencode) | |
| 703 | | Ast0.Ecircles(dots,whencode) -> | |
| 704 | Ast0.Ecircles(string_mcode dots, get_option expression whencode) | |
| 705 | | Ast0.Estars(dots,whencode) -> | |
| 706 | Ast0.Estars(string_mcode dots, get_option expression whencode) | |
| 707 | | Ast0.OptExp(exp) -> Ast0.OptExp(expression exp) | |
| 708 | | Ast0.UniqueExp(exp) -> Ast0.UniqueExp(expression exp)) in | |
| 709 | exprfn all_functions k e | |
| 710 | and typeC t = | |
| 711 | let k t = | |
| 712 | Ast0.rewrap t | |
| 713 | (match Ast0.unwrap t with | |
| 714 | Ast0.ConstVol(cv,ty) -> Ast0.ConstVol(cv_mcode cv,typeC ty) | |
| 715 | | Ast0.BaseType(ty,strings) -> | |
| 716 | Ast0.BaseType(ty, List.map string_mcode strings) | |
| 717 | | Ast0.Signed(sign,ty) -> | |
| 718 | Ast0.Signed(sign_mcode sign,get_option typeC ty) | |
| 719 | | Ast0.Pointer(ty,star) -> | |
| 720 | Ast0.Pointer(typeC ty, string_mcode star) | |
| 721 | | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) -> | |
| 722 | Ast0.FunctionPointer(typeC ty,string_mcode lp1,string_mcode star, | |
| 723 | string_mcode rp1,string_mcode lp2, | |
| 724 | parameter_list params, | |
| 725 | string_mcode rp2) | |
| 726 | | Ast0.FunctionType(ty,lp1,params,rp1) -> | |
| 727 | Ast0.FunctionType(get_option typeC ty, | |
| 728 | string_mcode lp1,parameter_list params, | |
| 729 | string_mcode rp1) | |
| 730 | | Ast0.Array(ty,lb,size,rb) -> | |
| 731 | Ast0.Array(typeC ty, string_mcode lb, | |
| 732 | get_option expression size, string_mcode rb) | |
| 733 | | Ast0.EnumName(kind,name) -> | |
| 734 | Ast0.EnumName(string_mcode kind, ident name) | |
| 735 | | Ast0.StructUnionName(kind,name) -> | |
| 736 | Ast0.StructUnionName (struct_mcode kind, get_option ident name) | |
| 737 | | Ast0.StructUnionDef(ty,lb,decls,rb) -> | |
| 738 | Ast0.StructUnionDef (typeC ty, | |
| 739 | string_mcode lb, declaration_dots decls, | |
| 740 | string_mcode rb) | |
| 741 | | Ast0.TypeName(name) -> Ast0.TypeName(string_mcode name) | |
| 742 | | Ast0.MetaType(name,pure) -> | |
| 743 | Ast0.MetaType(meta_mcode name,pure) | |
| 744 | | Ast0.DisjType(starter,types,mids,ender) -> | |
| 745 | Ast0.DisjType(string_mcode starter,List.map typeC types, | |
| 746 | List.map string_mcode mids,string_mcode ender) | |
| 747 | | Ast0.OptType(ty) -> Ast0.OptType(typeC ty) | |
| 748 | | Ast0.UniqueType(ty) -> Ast0.UniqueType(typeC ty)) in | |
| 749 | tyfn all_functions k t | |
| 750 | and declaration d = | |
| 751 | let k d = | |
| 752 | Ast0.rewrap d | |
| 753 | (match Ast0.unwrap d with | |
| 754 | Ast0.Init(stg,ty,id,eq,ini,sem) -> | |
| 755 | Ast0.Init(get_option storage_mcode stg, | |
| 756 | typeC ty, ident id, string_mcode eq, initialiser ini, | |
| 757 | string_mcode sem) | |
| 758 | | Ast0.UnInit(stg,ty,id,sem) -> | |
| 759 | Ast0.UnInit(get_option storage_mcode stg, | |
| 760 | typeC ty, ident id, string_mcode sem) | |
| 761 | | Ast0.MacroDecl(name,lp,args,rp,sem) -> | |
| 762 | Ast0.MacroDecl(ident name,string_mcode lp, | |
| 763 | expression_dots args, | |
| 764 | string_mcode rp,string_mcode sem) | |
| 765 | | Ast0.TyDecl(ty,sem) -> Ast0.TyDecl(typeC ty, string_mcode sem) | |
| 766 | | Ast0.Typedef(stg,ty,id,sem) -> | |
| 767 | Ast0.Typedef(string_mcode stg, typeC ty, typeC id, | |
| 768 | string_mcode sem) | |
| 769 | | Ast0.DisjDecl(starter,decls,mids,ender) -> | |
| 770 | Ast0.DisjDecl(string_mcode starter,List.map declaration decls, | |
| 771 | List.map string_mcode mids,string_mcode ender) | |
| 772 | | Ast0.Ddots(dots,whencode) -> | |
| 773 | Ast0.Ddots(string_mcode dots, get_option declaration whencode) | |
| 774 | | Ast0.OptDecl(decl) -> Ast0.OptDecl(declaration decl) | |
| 775 | | Ast0.UniqueDecl(decl) -> Ast0.UniqueDecl(declaration decl)) in | |
| 776 | declfn all_functions k d | |
| 777 | and initialiser i = | |
| 778 | let k i = | |
| 779 | Ast0.rewrap i | |
| 780 | (match Ast0.unwrap i with | |
| 781 | Ast0.InitExpr(exp) -> Ast0.InitExpr(expression exp) | |
| 782 | | Ast0.InitList(lb,initlist,rb) -> | |
| 783 | Ast0.InitList(string_mcode lb, initialiser_list initlist, | |
| 784 | string_mcode rb) | |
| 785 | | Ast0.InitGccDotName(dot,name,eq,ini) -> | |
| 786 | Ast0.InitGccDotName | |
| 787 | (string_mcode dot, ident name, string_mcode eq, initialiser ini) | |
| 788 | | Ast0.InitGccName(name,eq,ini) -> | |
| 789 | Ast0.InitGccName(ident name, string_mcode eq, initialiser ini) | |
| 790 | | Ast0.InitGccIndex(lb,exp,rb,eq,ini) -> | |
| 791 | Ast0.InitGccIndex | |
| 792 | (string_mcode lb, expression exp, string_mcode rb, | |
| 793 | string_mcode eq, initialiser ini) | |
| 794 | | Ast0.InitGccRange(lb,exp1,dots,exp2,rb,eq,ini) -> | |
| 795 | Ast0.InitGccRange | |
| 796 | (string_mcode lb, expression exp1, string_mcode dots, | |
| 797 | expression exp2, string_mcode rb, string_mcode eq, | |
| 798 | initialiser ini) | |
| 799 | | Ast0.IComma(cm) -> Ast0.IComma(string_mcode cm) | |
| 800 | | Ast0.Idots(d,whencode) -> | |
| 801 | Ast0.Idots(string_mcode d, get_option initialiser whencode) | |
| 802 | | Ast0.OptIni(i) -> Ast0.OptIni(initialiser i) | |
| 803 | | Ast0.UniqueIni(i) -> Ast0.UniqueIni(initialiser i)) in | |
| 804 | initfn all_functions k i | |
| 805 | and parameterTypeDef p = | |
| 806 | let k p = | |
| 807 | Ast0.rewrap p | |
| 808 | (match Ast0.unwrap p with | |
| 809 | Ast0.VoidParam(ty) -> Ast0.VoidParam(typeC ty) | |
| 810 | | Ast0.Param(ty,id) -> Ast0.Param(typeC ty, get_option ident id) | |
| 811 | | Ast0.MetaParam(name,pure) -> | |
| 812 | Ast0.MetaParam(meta_mcode name,pure) | |
| 813 | | Ast0.MetaParamList(name,lenname,pure) -> | |
| 814 | Ast0.MetaParamList(meta_mcode name,lenname,pure) | |
| 815 | | Ast0.PComma(cm) -> Ast0.PComma(string_mcode cm) | |
| 816 | | Ast0.Pdots(dots) -> Ast0.Pdots(string_mcode dots) | |
| 817 | | Ast0.Pcircles(dots) -> Ast0.Pcircles(string_mcode dots) | |
| 818 | | Ast0.OptParam(param) -> Ast0.OptParam(parameterTypeDef param) | |
| 819 | | Ast0.UniqueParam(param) -> | |
| 820 | Ast0.UniqueParam(parameterTypeDef param)) in | |
| 821 | paramfn all_functions k p | |
| 822 | (* not done for combiner, because the statement is assumed to be already | |
| 823 | represented elsewhere in the code *) | |
| 824 | and process_bef_aft s = | |
| 825 | Ast0.set_dots_bef_aft s | |
| 826 | (match Ast0.get_dots_bef_aft s with | |
| 827 | Ast0.NoDots -> Ast0.NoDots | |
| 828 | | Ast0.DroppingBetweenDots(stm) -> | |
| 829 | Ast0.DroppingBetweenDots(statement stm) | |
| 830 | | Ast0.AddingBetweenDots(stm) -> | |
| 831 | Ast0.AddingBetweenDots(statement stm)) | |
| 832 | ||
| 833 | and statement s = | |
| 834 | let k s = | |
| 835 | Ast0.rewrap s | |
| 836 | (match Ast0.unwrap s with | |
| 837 | Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace) -> | |
| 838 | Ast0.FunDecl(bef,List.map fninfo fi, ident name, | |
| 839 | string_mcode lp, parameter_list params, | |
| 840 | string_mcode rp, string_mcode lbrace, | |
| 841 | statement_dots body, string_mcode rbrace) | |
| 842 | | Ast0.Decl(bef,decl) -> Ast0.Decl(bef,declaration decl) | |
| 843 | | Ast0.Seq(lbrace,body,rbrace) -> | |
| 844 | Ast0.Seq(string_mcode lbrace, statement_dots body, | |
| 845 | string_mcode rbrace) | |
| 846 | | Ast0.ExprStatement(exp,sem) -> | |
| 847 | Ast0.ExprStatement(expression exp, string_mcode sem) | |
| 848 | | Ast0.IfThen(iff,lp,exp,rp,branch1,aft) -> | |
| 849 | Ast0.IfThen(string_mcode iff, string_mcode lp, expression exp, | |
| 850 | string_mcode rp, statement branch1,aft) | |
| 851 | | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) -> | |
| 852 | Ast0.IfThenElse(string_mcode iff,string_mcode lp,expression exp, | |
| 853 | string_mcode rp, statement branch1, string_mcode els, | |
| 854 | statement branch2,aft) | |
| 855 | | Ast0.While(whl,lp,exp,rp,body,aft) -> | |
| 856 | Ast0.While(string_mcode whl, string_mcode lp, expression exp, | |
| 857 | string_mcode rp, statement body, aft) | |
| 858 | | Ast0.Do(d,body,whl,lp,exp,rp,sem) -> | |
| 859 | Ast0.Do(string_mcode d, statement body, string_mcode whl, | |
| 860 | string_mcode lp, expression exp, string_mcode rp, | |
| 861 | string_mcode sem) | |
| 862 | | Ast0.For(fr,lp,e1,sem1,e2,sem2,e3,rp,body,aft) -> | |
| 863 | Ast0.For(string_mcode fr, string_mcode lp, | |
| 864 | get_option expression e1, string_mcode sem1, | |
| 865 | get_option expression e2, string_mcode sem2, | |
| 866 | get_option expression e3, | |
| 867 | string_mcode rp, statement body, aft) | |
| 868 | | Ast0.Iterator(nm,lp,args,rp,body,aft) -> | |
| 869 | Ast0.Iterator(ident nm, string_mcode lp, | |
| 870 | expression_dots args, | |
| 871 | string_mcode rp, statement body, aft) | |
| 872 | | Ast0.Switch(switch,lp,exp,rp,lb,cases,rb) -> | |
| 873 | Ast0.Switch(string_mcode switch,string_mcode lp,expression exp, | |
| 874 | string_mcode rp,string_mcode lb, | |
| 875 | case_line_dots cases, string_mcode rb) | |
| 876 | | Ast0.Break(br,sem) -> | |
| 877 | Ast0.Break(string_mcode br,string_mcode sem) | |
| 878 | | Ast0.Continue(cont,sem) -> | |
| 879 | Ast0.Continue(string_mcode cont,string_mcode sem) | |
| 880 | | Ast0.Label(l,dd) -> Ast0.Label(ident l,string_mcode dd) | |
| 881 | | Ast0.Goto(goto,l,sem) -> | |
| 882 | Ast0.Goto(string_mcode goto,ident l,string_mcode sem) | |
| 883 | | Ast0.Return(ret,sem) -> | |
| 884 | Ast0.Return(string_mcode ret,string_mcode sem) | |
| 885 | | Ast0.ReturnExpr(ret,exp,sem) -> | |
| 886 | Ast0.ReturnExpr(string_mcode ret,expression exp,string_mcode sem) | |
| 887 | | Ast0.MetaStmt(name,pure) -> | |
| 888 | Ast0.MetaStmt(meta_mcode name,pure) | |
| 889 | | Ast0.MetaStmtList(name,pure) -> | |
| 890 | Ast0.MetaStmtList(meta_mcode name,pure) | |
| 891 | | Ast0.Disj(starter,statement_dots_list,mids,ender) -> | |
| 892 | Ast0.Disj(string_mcode starter, | |
| 893 | List.map statement_dots statement_dots_list, | |
| 894 | List.map string_mcode mids, | |
| 895 | string_mcode ender) | |
| 896 | | Ast0.Nest(starter,stmt_dots,ender,whn,multi) -> | |
| 897 | Ast0.Nest(string_mcode starter,statement_dots stmt_dots, | |
| 898 | string_mcode ender, | |
| 899 | List.map (whencode statement_dots statement) whn, | |
| 900 | multi) | |
| 901 | | Ast0.Exp(exp) -> Ast0.Exp(expression exp) | |
| 902 | | Ast0.TopExp(exp) -> Ast0.TopExp(expression exp) | |
| 903 | | Ast0.Ty(ty) -> Ast0.Ty(typeC ty) | |
| 904 | | Ast0.TopInit(init) -> Ast0.TopInit(initialiser init) | |
| 905 | | Ast0.Dots(d,whn) -> | |
| 906 | Ast0.Dots(string_mcode d, | |
| 907 | List.map (whencode statement_dots statement) whn) | |
| 908 | | Ast0.Circles(d,whn) -> | |
| 909 | Ast0.Circles(string_mcode d, | |
| 910 | List.map (whencode statement_dots statement) whn) | |
| 911 | | Ast0.Stars(d,whn) -> | |
| 912 | Ast0.Stars(string_mcode d, | |
| 913 | List.map (whencode statement_dots statement) whn) | |
| 914 | | Ast0.Include(inc,name) -> | |
| 915 | Ast0.Include(string_mcode inc,inc_mcode name) | |
| 916 | | Ast0.Define(def,id,params,body) -> | |
| 917 | Ast0.Define(string_mcode def,ident id, | |
| 918 | define_parameters params, | |
| 919 | statement_dots body) | |
| 920 | | Ast0.OptStm(re) -> Ast0.OptStm(statement re) | |
| 921 | | Ast0.UniqueStm(re) -> Ast0.UniqueStm(statement re)) in | |
| 922 | let s = stmtfn all_functions k s in | |
| 923 | process_bef_aft s | |
| 924 | ||
| 925 | (* not parameterizable for now... *) | |
| 926 | and define_parameters p = | |
| 927 | let k p = | |
| 928 | Ast0.rewrap p | |
| 929 | (match Ast0.unwrap p with | |
| 930 | Ast0.NoParams -> Ast0.NoParams | |
| 931 | | Ast0.DParams(lp,params,rp) -> | |
| 932 | Ast0.DParams(string_mcode lp,define_param_dots params, | |
| 933 | string_mcode rp))in | |
| 934 | k p | |
| 935 | ||
| 936 | and define_param_dots d = | |
| 937 | let k d = | |
| 938 | Ast0.rewrap d | |
| 939 | (match Ast0.unwrap d with | |
| 940 | Ast0.DOTS(l) -> Ast0.DOTS(List.map define_param l) | |
| 941 | | Ast0.CIRCLES(l) -> Ast0.CIRCLES(List.map define_param l) | |
| 942 | | Ast0.STARS(l) -> Ast0.STARS(List.map define_param l)) in | |
| 943 | k d | |
| 944 | ||
| 945 | and define_param p = | |
| 946 | let k p = | |
| 947 | Ast0.rewrap p | |
| 948 | (match Ast0.unwrap p with | |
| 949 | Ast0.DParam(id) -> Ast0.DParam(ident id) | |
| 950 | | Ast0.DPComma(comma) -> Ast0.DPComma(string_mcode comma) | |
| 951 | | Ast0.DPdots(d) -> Ast0.DPdots(string_mcode d) | |
| 952 | | Ast0.DPcircles(c) -> Ast0.DPcircles(string_mcode c) | |
| 953 | | Ast0.OptDParam(dp) -> Ast0.OptDParam(define_param dp) | |
| 954 | | Ast0.UniqueDParam(dp) -> Ast0.UniqueDParam(define_param dp)) in | |
| 955 | k p | |
| 956 | ||
| 957 | and fninfo = function | |
| 958 | Ast0.FStorage(stg) -> Ast0.FStorage(storage_mcode stg) | |
| 959 | | Ast0.FType(ty) -> Ast0.FType(typeC ty) | |
| 960 | | Ast0.FInline(inline) -> Ast0.FInline(string_mcode inline) | |
| 961 | | Ast0.FAttr(init) -> Ast0.FAttr(string_mcode init) | |
| 962 | ||
| 963 | and whencode notfn alwaysfn = function | |
| 964 | Ast0.WhenNot a -> Ast0.WhenNot (notfn a) | |
| 965 | | Ast0.WhenAlways a -> Ast0.WhenAlways (alwaysfn a) | |
| 966 | | Ast0.WhenModifier(x) -> Ast0.WhenModifier(x) | |
| 967 | | Ast0.WhenNotTrue(e) -> Ast0.WhenNotTrue(expression e) | |
| 968 | | Ast0.WhenNotFalse(e) -> Ast0.WhenNotFalse(expression e) | |
| 969 | ||
| 970 | and case_line c = | |
| 971 | let k c = | |
| 972 | Ast0.rewrap c | |
| 973 | (match Ast0.unwrap c with | |
| 974 | Ast0.Default(def,colon,code) -> | |
| 975 | Ast0.Default(string_mcode def,string_mcode colon, | |
| 976 | statement_dots code) | |
| 977 | | Ast0.Case(case,exp,colon,code) -> | |
| 978 | Ast0.Case(string_mcode case,expression exp,string_mcode colon, | |
| 979 | statement_dots code) | |
| 980 | | Ast0.OptCase(case) -> Ast0.OptCase(case_line case)) in | |
| 981 | casefn all_functions k c | |
| 982 | ||
| 983 | and top_level t = | |
| 984 | let k t = | |
| 985 | Ast0.rewrap t | |
| 986 | (match Ast0.unwrap t with | |
| 987 | Ast0.FILEINFO(old_file,new_file) -> | |
| 988 | Ast0.FILEINFO(string_mcode old_file, string_mcode new_file) | |
| 989 | | Ast0.DECL(statement_dots) -> | |
| 990 | Ast0.DECL(statement statement_dots) | |
| 991 | | Ast0.CODE(stmt_dots) -> Ast0.CODE(statement_dots stmt_dots) | |
| 992 | | Ast0.ERRORWORDS(exps) -> Ast0.ERRORWORDS(List.map expression exps) | |
| 993 | | Ast0.OTHER(_) -> failwith "unexpected code") in | |
| 994 | topfn all_functions k t | |
| 995 | ||
| 996 | and anything a = (* for compile_iso, not parameterisable *) | |
| 997 | let k = function | |
| 998 | Ast0.DotsExprTag(exprs) -> Ast0.DotsExprTag(expression_dots exprs) | |
| 999 | | Ast0.DotsInitTag(inits) -> Ast0.DotsInitTag(initialiser_list inits) | |
| 1000 | | Ast0.DotsParamTag(params) -> Ast0.DotsParamTag(parameter_list params) | |
| 1001 | | Ast0.DotsStmtTag(stmts) -> Ast0.DotsStmtTag(statement_dots stmts) | |
| 1002 | | Ast0.DotsDeclTag(decls) -> Ast0.DotsDeclTag(declaration_dots decls) | |
| 1003 | | Ast0.DotsCaseTag(cases) -> Ast0.DotsCaseTag(case_line_dots cases) | |
| 1004 | | Ast0.IdentTag(id) -> Ast0.IdentTag(ident id) | |
| 1005 | | Ast0.ExprTag(exp) -> Ast0.ExprTag(expression exp) | |
| 1006 | | Ast0.ArgExprTag(exp) -> Ast0.ArgExprTag(expression exp) | |
| 1007 | | Ast0.TestExprTag(exp) -> Ast0.TestExprTag(expression exp) | |
| 1008 | | Ast0.TypeCTag(ty) -> Ast0.TypeCTag(typeC ty) | |
| 1009 | | Ast0.ParamTag(param) -> Ast0.ParamTag(parameterTypeDef param) | |
| 1010 | | Ast0.InitTag(init) -> Ast0.InitTag(initialiser init) | |
| 1011 | | Ast0.DeclTag(decl) -> Ast0.DeclTag(declaration decl) | |
| 1012 | | Ast0.StmtTag(stmt) -> Ast0.StmtTag(statement stmt) | |
| 1013 | | Ast0.CaseLineTag(c) -> Ast0.CaseLineTag(case_line c) | |
| 1014 | | Ast0.TopTag(top) -> Ast0.TopTag(top_level top) | |
| 1015 | | Ast0.IsoWhenTag(x) -> Ast0.IsoWhenTag(x) | |
| 1016 | | Ast0.IsoWhenTTag(e) -> Ast0.IsoWhenTTag(expression e) | |
| 1017 | | Ast0.IsoWhenFTag(e) -> Ast0.IsoWhenFTag(expression e) | |
| 1018 | | Ast0.MetaPosTag(var) -> failwith "not supported" in | |
| 1019 | k a | |
| 1020 | ||
| 1021 | (* not done for combiner, because the statement is assumed to be already | |
| 1022 | represented elsewhere in the code *) | |
| 1023 | ||
| 1024 | and all_functions = | |
| 1025 | {rebuilder_ident = ident; | |
| 1026 | rebuilder_expression = expression; | |
| 1027 | rebuilder_typeC = typeC; | |
| 1028 | rebuilder_declaration = declaration; | |
| 1029 | rebuilder_initialiser = initialiser; | |
| 1030 | rebuilder_initialiser_list = initialiser_list; | |
| 1031 | rebuilder_parameter = parameterTypeDef; | |
| 1032 | rebuilder_parameter_list = parameter_list; | |
| 1033 | rebuilder_statement = statement; | |
| 1034 | rebuilder_case_line = case_line; | |
| 1035 | rebuilder_top_level = top_level; | |
| 1036 | rebuilder_expression_dots = expression_dots; | |
| 1037 | rebuilder_statement_dots = statement_dots; | |
| 1038 | rebuilder_declaration_dots = declaration_dots; | |
| 1039 | rebuilder_case_line_dots = case_line_dots; | |
| 1040 | rebuilder_anything = anything} in | |
| 1041 | all_functions |