parsing_cocci/visitor_ast0.ml

   1 (*
   2 * Copyright 2005-2008, 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 base_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,sign) ->
 210           bind (get_option sign_mcode sign) (base_mcode ty)
 211       | Ast0.ImplicitInt(sign) -> (sign_mcode sign)
 212       | Ast0.Pointer(ty,star) -> bind (typeC ty) (string_mcode star)
 213       | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 214           function_pointer (ty,lp1,star,rp1,lp2,params,rp2) []
 215       | Ast0.FunctionType(ty,lp1,params,rp1) ->
 216           function_type (ty,lp1,params,rp1) []
 217       | Ast0.Array(ty,lb,size,rb) ->
 218           array_type (ty,lb,size,rb) []
 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.Dots(d,whn) | Ast0.Circles(d,whn) | Ast0.Stars(d,whn) ->
 423           bind (string_mcode d)
 424             (multibind (List.map (whencode statement_dots statement) whn))
 425       | Ast0.Include(inc,name) -> bind (string_mcode inc) (inc_mcode name)
 426       | Ast0.Define(def,id,params,body) ->
 427           multibind [string_mcode def; ident id; define_parameters params;
 428                       statement_dots body]
 429       | Ast0.OptStm(re) -> statement re
 430       | Ast0.UniqueStm(re) -> statement re in
 431     stmtfn all_functions k s
 432
 433   (* not parameterizable for now... *)
 434   and define_parameters p =
 435     let k p =
 436       match Ast0.unwrap p with
 437         Ast0.NoParams -> option_default
 438       | Ast0.DParams(lp,params,rp) ->
 439           multibind
 440             [string_mcode lp; define_param_dots params; string_mcode rp] in
 441     k p
 442
 443   and define_param_dots d =
 444     let k d =
 445       match Ast0.unwrap d with
 446         Ast0.DOTS(l) | Ast0.CIRCLES(l) | Ast0.STARS(l) ->
 447           multibind (List.map define_param l) in
 448     k d
 449
 450   and define_param p =
 451     let k p =
 452       match Ast0.unwrap p with
 453         Ast0.DParam(id) -> ident id
 454       | Ast0.DPComma(comma) -> string_mcode comma
 455       | Ast0.DPdots(d) -> string_mcode d
 456       | Ast0.DPcircles(c) -> string_mcode c
 457       | Ast0.OptDParam(dp) -> define_param dp
 458       | Ast0.UniqueDParam(dp) -> define_param dp in
 459     k p
 460
 461   and fninfo = function
 462       Ast0.FStorage(stg) -> storage_mcode stg
 463     | Ast0.FType(ty) -> typeC ty
 464     | Ast0.FInline(inline) -> string_mcode inline
 465     | Ast0.FAttr(init) -> string_mcode init
 466
 467   and whencode notfn alwaysfn = function
 468       Ast0.WhenNot a -> notfn a
 469     | Ast0.WhenAlways a -> alwaysfn a
 470     | Ast0.WhenModifier(_) -> option_default
 471
 472   and case_line c =
 473     let k c =
 474       match Ast0.unwrap c with
 475         Ast0.Default(def,colon,code) ->
 476           multibind [string_mcode def;string_mcode colon;statement_dots code]
 477       | Ast0.Case(case,exp,colon,code) ->
 478           multibind [string_mcode case;expression exp;string_mcode colon;
 479                       statement_dots code]
 480       | Ast0.OptCase(case) -> case_line case in
 481     casefn all_functions k c
 482
 483   and anything a = (* for compile_iso, not parameterisable *)
 484     let k = function
 485         Ast0.DotsExprTag(exprs) -> expression_dots exprs
 486       | Ast0.DotsInitTag(inits) -> initialiser_dots inits
 487       | Ast0.DotsParamTag(params) -> parameter_dots params
 488       | Ast0.DotsStmtTag(stmts) -> statement_dots stmts
 489       | Ast0.DotsDeclTag(decls) -> declaration_dots decls
 490       | Ast0.DotsCaseTag(cases) -> case_line_dots cases
 491       | Ast0.IdentTag(id) -> ident id
 492       | Ast0.ExprTag(exp) -> expression exp
 493       | Ast0.ArgExprTag(exp) -> expression exp
 494       | Ast0.TestExprTag(exp) -> expression exp
 495       | Ast0.TypeCTag(ty) -> typeC ty
 496       | Ast0.ParamTag(param) -> parameterTypeDef param
 497       | Ast0.InitTag(init) -> initialiser init
 498       | Ast0.DeclTag(decl) -> declaration decl
 499       | Ast0.StmtTag(stmt) -> statement stmt
 500       | Ast0.CaseLineTag(c) -> case_line c
 501       | Ast0.TopTag(top) -> top_level top
 502       | Ast0.IsoWhenTag(_) -> option_default
 503       | Ast0.MetaPosTag(var) -> failwith "not supported" in
 504     k a
 505
 506   and top_level t =
 507     let k t =
 508       match Ast0.unwrap t with
 509         Ast0.FILEINFO(old_file,new_file) ->
 510           bind (string_mcode old_file) (string_mcode new_file)
 511       | Ast0.DECL(stmt_dots) -> statement stmt_dots
 512       | Ast0.CODE(stmt_dots) -> statement_dots stmt_dots
 513       | Ast0.ERRORWORDS(exps) -> multibind (List.map expression exps)
 514       | Ast0.OTHER(_) -> failwith "unexpected code" in
 515     topfn all_functions k t
 516   and all_functions =
 517     {combiner_ident = ident;
 518       combiner_expression = expression;
 519       combiner_typeC = typeC;
 520       combiner_declaration = declaration;
 521       combiner_initialiser = initialiser;
 522       combiner_initialiser_list = initialiser_dots;
 523       combiner_parameter = parameterTypeDef;
 524       combiner_parameter_list = parameter_dots;
 525       combiner_statement = statement;
 526       combiner_case_line = case_line;
 527       combiner_top_level = top_level;
 528       combiner_expression_dots = expression_dots;
 529       combiner_statement_dots = statement_dots;
 530       combiner_declaration_dots = declaration_dots;
 531       combiner_case_line_dots = case_line_dots;
 532       combiner_anything = anything} in
 533   all_functions
 534
 535 (* --------------------------------------------------------------------- *)
 536 (* Generic traversal: rebuilder *)
 537
 538 type 'a inout = 'a -> 'a (* for specifying the type of rebuilder *)
 539
 540 type rebuilder =
 541     {rebuilder_ident : Ast0.ident inout;
 542       rebuilder_expression : Ast0.expression inout;
 543       rebuilder_typeC : Ast0.typeC inout;
 544       rebuilder_declaration : Ast0.declaration inout;
 545       rebuilder_initialiser : Ast0.initialiser inout;
 546       rebuilder_initialiser_list : Ast0.initialiser_list inout;
 547       rebuilder_parameter : Ast0.parameterTypeDef inout;
 548       rebuilder_parameter_list : Ast0.parameter_list inout;
 549       rebuilder_statement : Ast0.statement inout;
 550       rebuilder_case_line : Ast0.case_line inout;
 551       rebuilder_top_level : Ast0.top_level inout;
 552       rebuilder_expression_dots :
 553         Ast0.expression Ast0.dots ->
 554           Ast0.expression Ast0.dots;
 555           rebuilder_statement_dots :
 556             Ast0.statement Ast0.dots ->
 557               Ast0.statement Ast0.dots;
 558           rebuilder_declaration_dots :
 559             Ast0.declaration Ast0.dots ->
 560               Ast0.declaration Ast0.dots;
 561           rebuilder_case_line_dots :
 562             Ast0.case_line Ast0.dots ->
 563               Ast0.case_line Ast0.dots;
 564           rebuilder_anything :
 565             Ast0.anything -> Ast0.anything}
 566
 567 type 'mc rmcode = 'mc Ast0.mcode inout
 568 type 'cd rcode = rebuilder -> ('cd inout) -> 'cd inout
 569
 570 let rebuilder = fun
 571     meta_mcode string_mcode const_mcode assign_mcode fix_mcode unary_mcode
 572     binary_mcode cv_mcode base_mcode sign_mcode struct_mcode storage_mcode
 573     inc_mcode
 574     dotsexprfn dotsinitfn dotsparamfn dotsstmtfn dotsdeclfn dotscasefn
 575     identfn exprfn tyfn initfn paramfn declfn stmtfn casefn topfn ->
 576   let get_option f = function
 577       Some x -> Some (f x)
 578     | None -> None in
 579   let rec expression_dots d =
 580     let k d =
 581       Ast0.rewrap d
 582         (match Ast0.unwrap d with
 583           Ast0.DOTS(l) -> Ast0.DOTS(List.map expression l)
 584         | Ast0.CIRCLES(l) -> Ast0.CIRCLES(List.map expression l)
 585         | Ast0.STARS(l) -> Ast0.STARS(List.map expression l)) in
 586     dotsexprfn all_functions k d
 587   and initialiser_list i =
 588     let k i =
 589       Ast0.rewrap i
 590         (match Ast0.unwrap i with
 591           Ast0.DOTS(l) -> Ast0.DOTS(List.map initialiser l)
 592         | Ast0.CIRCLES(l) -> Ast0.CIRCLES(List.map initialiser l)
 593         | Ast0.STARS(l) -> Ast0.STARS(List.map initialiser l)) in
 594     dotsinitfn all_functions k i
 595   and parameter_list d =
 596     let k d =
 597       Ast0.rewrap d
 598         (match Ast0.unwrap d with
 599           Ast0.DOTS(l) -> Ast0.DOTS(List.map parameterTypeDef l)
 600         | Ast0.CIRCLES(l) -> Ast0.CIRCLES(List.map parameterTypeDef l)
 601         | Ast0.STARS(l) -> Ast0.STARS(List.map parameterTypeDef l)) in
 602     dotsparamfn all_functions k d
 603   and statement_dots d =
 604     let k d =
 605       Ast0.rewrap d
 606         (match Ast0.unwrap d with
 607           Ast0.DOTS(l) -> Ast0.DOTS(List.map statement l)
 608         | Ast0.CIRCLES(l) -> Ast0.CIRCLES(List.map statement l)
 609         | Ast0.STARS(l) -> Ast0.STARS(List.map statement l)) in
 610     dotsstmtfn all_functions k d
 611   and declaration_dots d =
 612     let k d =
 613       Ast0.rewrap d
 614         (match Ast0.unwrap d with
 615           Ast0.DOTS(l) -> Ast0.DOTS(List.map declaration l)
 616         | Ast0.CIRCLES(l) -> Ast0.CIRCLES(List.map declaration l)
 617         | Ast0.STARS(l) -> Ast0.STARS(List.map declaration l)) in
 618     dotsdeclfn all_functions k d
 619   and case_line_dots d =
 620     let k d =
 621       Ast0.rewrap d
 622         (match Ast0.unwrap d with
 623           Ast0.DOTS(l) -> Ast0.DOTS(List.map case_line l)
 624         | Ast0.CIRCLES(l) -> Ast0.CIRCLES(List.map case_line l)
 625         | Ast0.STARS(l) -> Ast0.STARS(List.map case_line l)) in
 626     dotscasefn all_functions k d
 627   and ident i =
 628     let k i =
 629       Ast0.rewrap i
 630         (match Ast0.unwrap i with
 631           Ast0.Id(name) -> Ast0.Id(string_mcode name)
 632         | Ast0.MetaId(name,constraints,pure) ->
 633             Ast0.MetaId(meta_mcode name,constraints,pure)
 634         | Ast0.MetaFunc(name,constraints,pure) ->
 635             Ast0.MetaFunc(meta_mcode name,constraints,pure)
 636         | Ast0.MetaLocalFunc(name,constraints,pure) ->
 637             Ast0.MetaLocalFunc(meta_mcode name,constraints,pure)
 638         | Ast0.OptIdent(id) -> Ast0.OptIdent(ident id)
 639         | Ast0.UniqueIdent(id) -> Ast0.UniqueIdent(ident id)) in
 640     identfn all_functions k i
 641   and expression e =
 642     let k e =
 643       Ast0.rewrap e
 644         (match Ast0.unwrap e with
 645           Ast0.Ident(id) -> Ast0.Ident(ident id)
 646         | Ast0.Constant(const) -> Ast0.Constant(const_mcode const)
 647         | Ast0.FunCall(fn,lp,args,rp) ->
 648             Ast0.FunCall(expression fn,string_mcode lp,expression_dots args,
 649                          string_mcode rp)
 650         | Ast0.Assignment(left,op,right,simple) ->
 651             Ast0.Assignment(expression left,assign_mcode op,expression right,
 652                             simple)
 653         | Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
 654             Ast0.CondExpr(expression exp1, string_mcode why,
 655                           get_option expression exp2, string_mcode colon,
 656                           expression exp3)
 657         | Ast0.Postfix(exp,op) -> Ast0.Postfix(expression exp, fix_mcode op)
 658         | Ast0.Infix(exp,op) -> Ast0.Infix(expression exp, fix_mcode op)
 659         | Ast0.Unary(exp,op) -> Ast0.Unary(expression exp, unary_mcode op)
 660         | Ast0.Binary(left,op,right) ->
 661             Ast0.Binary(expression left, binary_mcode op, expression right)
 662         | Ast0.Nested(left,op,right) ->
 663             Ast0.Nested(expression left, binary_mcode op, expression right)
 664         | Ast0.Paren(lp,exp,rp) ->
 665             Ast0.Paren(string_mcode lp, expression exp, string_mcode rp)
 666         | Ast0.ArrayAccess(exp1,lb,exp2,rb) ->
 667             Ast0.ArrayAccess(expression exp1,string_mcode lb,expression exp2,
 668                              string_mcode rb)
 669         | Ast0.RecordAccess(exp,pt,field) ->
 670             Ast0.RecordAccess(expression exp, string_mcode pt, ident field)
 671         | Ast0.RecordPtAccess(exp,ar,field) ->
 672             Ast0.RecordPtAccess(expression exp, string_mcode ar, ident field)
 673         | Ast0.Cast(lp,ty,rp,exp) ->
 674             Ast0.Cast(string_mcode lp, typeC ty, string_mcode rp,
 675                       expression exp)
 676         | Ast0.SizeOfExpr(szf,exp) ->
 677             Ast0.SizeOfExpr(string_mcode szf, expression exp)
 678         | Ast0.SizeOfType(szf,lp,ty,rp) ->
 679             Ast0.SizeOfType(string_mcode szf,string_mcode lp, typeC ty,
 680                             string_mcode rp)
 681         | Ast0.TypeExp(ty) -> Ast0.TypeExp(typeC ty)
 682         | Ast0.MetaErr(name,constraints,pure) ->
 683             Ast0.MetaErr(meta_mcode name,constraints,pure)
 684         | Ast0.MetaExpr(name,constraints,ty,form,pure) ->
 685             Ast0.MetaExpr(meta_mcode name,constraints,ty,form,pure)
 686         | Ast0.MetaExprList(name,lenname,pure) ->
 687             Ast0.MetaExprList(meta_mcode name,lenname,pure)
 688         | Ast0.EComma(cm) -> Ast0.EComma(string_mcode cm)
 689         | Ast0.DisjExpr(starter,expr_list,mids,ender) ->
 690             Ast0.DisjExpr(string_mcode starter,List.map expression expr_list,
 691                           List.map string_mcode mids,string_mcode ender)
 692         | Ast0.NestExpr(starter,expr_dots,ender,whencode,multi) ->
 693             Ast0.NestExpr(string_mcode starter,expression_dots expr_dots,
 694                           string_mcode ender, get_option expression whencode,
 695                           multi)
 696         | Ast0.Edots(dots,whencode) ->
 697             Ast0.Edots(string_mcode dots, get_option expression whencode)
 698         | Ast0.Ecircles(dots,whencode) ->
 699             Ast0.Ecircles(string_mcode dots, get_option expression whencode)
 700         | Ast0.Estars(dots,whencode) ->
 701             Ast0.Estars(string_mcode dots, get_option expression whencode)
 702         | Ast0.OptExp(exp) -> Ast0.OptExp(expression exp)
 703         | Ast0.UniqueExp(exp) -> Ast0.UniqueExp(expression exp)) in
 704     exprfn all_functions k e
 705   and typeC t =
 706     let k t =
 707       Ast0.rewrap t
 708         (match Ast0.unwrap t with
 709           Ast0.ConstVol(cv,ty) -> Ast0.ConstVol(cv_mcode cv,typeC ty)
 710         | Ast0.BaseType(ty,sign) ->
 711             Ast0.BaseType(base_mcode ty, get_option sign_mcode sign)
 712         | Ast0.ImplicitInt(sign) -> Ast0.ImplicitInt(sign_mcode sign)
 713         | Ast0.Pointer(ty,star) ->
 714             Ast0.Pointer(typeC ty, string_mcode star)
 715         | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 716             Ast0.FunctionPointer(typeC ty,string_mcode lp1,string_mcode star,
 717                                  string_mcode rp1,string_mcode lp2,
 718                                  parameter_list params,
 719                                  string_mcode rp2)
 720         | Ast0.FunctionType(ty,lp1,params,rp1) ->
 721             Ast0.FunctionType(get_option typeC ty,
 722                               string_mcode lp1,parameter_list params,
 723                               string_mcode rp1)
 724         | Ast0.Array(ty,lb,size,rb) ->
 725             Ast0.Array(typeC ty, string_mcode lb,
 726                        get_option expression size, string_mcode rb)
 727         | Ast0.StructUnionName(kind,name) ->
 728             Ast0.StructUnionName (struct_mcode kind, get_option ident name)
 729         | Ast0.StructUnionDef(ty,lb,decls,rb) ->
 730             Ast0.StructUnionDef (typeC ty,
 731                                  string_mcode lb, declaration_dots decls,
 732                                  string_mcode rb)
 733         | Ast0.TypeName(name) -> Ast0.TypeName(string_mcode name)
 734         | Ast0.MetaType(name,pure) ->
 735             Ast0.MetaType(meta_mcode name,pure)
 736         | Ast0.DisjType(starter,types,mids,ender) ->
 737             Ast0.DisjType(string_mcode starter,List.map typeC types,
 738                           List.map string_mcode mids,string_mcode ender)
 739         | Ast0.OptType(ty) -> Ast0.OptType(typeC ty)
 740         | Ast0.UniqueType(ty) -> Ast0.UniqueType(typeC ty)) in
 741     tyfn all_functions k t
 742   and declaration d =
 743     let k d =
 744       Ast0.rewrap d
 745         (match Ast0.unwrap d with
 746           Ast0.Init(stg,ty,id,eq,ini,sem) ->
 747             Ast0.Init(get_option storage_mcode stg,
 748                       typeC ty, ident id, string_mcode eq, initialiser ini,
 749                       string_mcode sem)
 750         | Ast0.UnInit(stg,ty,id,sem) ->
 751             Ast0.UnInit(get_option storage_mcode stg,
 752                         typeC ty, ident id, string_mcode sem)
 753         | Ast0.MacroDecl(name,lp,args,rp,sem) ->
 754             Ast0.MacroDecl(ident name,string_mcode lp,
 755                            expression_dots args,
 756                            string_mcode rp,string_mcode sem)
 757         | Ast0.TyDecl(ty,sem) -> Ast0.TyDecl(typeC ty, string_mcode sem)
 758         | Ast0.Typedef(stg,ty,id,sem) ->
 759             Ast0.Typedef(string_mcode stg, typeC ty, typeC id,
 760                          string_mcode sem)
 761         | Ast0.DisjDecl(starter,decls,mids,ender) ->
 762             Ast0.DisjDecl(string_mcode starter,List.map declaration decls,
 763                           List.map string_mcode mids,string_mcode ender)
 764         | Ast0.Ddots(dots,whencode) ->
 765             Ast0.Ddots(string_mcode dots, get_option declaration whencode)
 766         | Ast0.OptDecl(decl) -> Ast0.OptDecl(declaration decl)
 767         | Ast0.UniqueDecl(decl) -> Ast0.UniqueDecl(declaration decl)) in
 768     declfn all_functions k d
 769   and initialiser i =
 770     let k i =
 771       Ast0.rewrap i
 772         (match Ast0.unwrap i with
 773           Ast0.InitExpr(exp) -> Ast0.InitExpr(expression exp)
 774         | Ast0.InitList(lb,initlist,rb) ->
 775             Ast0.InitList(string_mcode lb, initialiser_list initlist,
 776                           string_mcode rb)
 777         | Ast0.InitGccDotName(dot,name,eq,ini) ->
 778             Ast0.InitGccDotName
 779               (string_mcode dot, ident name, string_mcode eq, initialiser ini)
 780         | Ast0.InitGccName(name,eq,ini) ->
 781             Ast0.InitGccName(ident name, string_mcode eq, initialiser ini)
 782         | Ast0.InitGccIndex(lb,exp,rb,eq,ini) ->
 783             Ast0.InitGccIndex
 784               (string_mcode lb, expression exp, string_mcode rb,
 785                string_mcode eq, initialiser ini)
 786         | Ast0.InitGccRange(lb,exp1,dots,exp2,rb,eq,ini) ->
 787             Ast0.InitGccRange
 788               (string_mcode lb, expression exp1, string_mcode dots,
 789                expression exp2, string_mcode rb, string_mcode eq,
 790                initialiser ini)
 791         | Ast0.IComma(cm) -> Ast0.IComma(string_mcode cm)
 792         | Ast0.Idots(d,whencode) ->
 793             Ast0.Idots(string_mcode d, get_option initialiser whencode)
 794         | Ast0.OptIni(i) -> Ast0.OptIni(initialiser i)
 795         | Ast0.UniqueIni(i) -> Ast0.UniqueIni(initialiser i)) in
 796     initfn all_functions k i
 797   and parameterTypeDef p =
 798     let k p =
 799       Ast0.rewrap p
 800         (match Ast0.unwrap p with
 801           Ast0.VoidParam(ty) -> Ast0.VoidParam(typeC ty)
 802         | Ast0.Param(ty,id) -> Ast0.Param(typeC ty, get_option ident id)
 803         | Ast0.MetaParam(name,pure) ->
 804             Ast0.MetaParam(meta_mcode name,pure)
 805         | Ast0.MetaParamList(name,lenname,pure) ->
 806             Ast0.MetaParamList(meta_mcode name,lenname,pure)
 807         | Ast0.PComma(cm) -> Ast0.PComma(string_mcode cm)
 808         | Ast0.Pdots(dots) -> Ast0.Pdots(string_mcode dots)
 809         | Ast0.Pcircles(dots) -> Ast0.Pcircles(string_mcode dots)
 810         | Ast0.OptParam(param) -> Ast0.OptParam(parameterTypeDef param)
 811         | Ast0.UniqueParam(param) ->
 812             Ast0.UniqueParam(parameterTypeDef param)) in
 813     paramfn all_functions k p
 814   (* not done for combiner, because the statement is assumed to be already
 815      represented elsewhere in the code *)
 816   and process_bef_aft s =
 817     Ast0.set_dots_bef_aft s
 818       (match Ast0.get_dots_bef_aft s with
 819         Ast0.NoDots -> Ast0.NoDots
 820       | Ast0.DroppingBetweenDots(stm) ->
 821           Ast0.DroppingBetweenDots(statement stm)
 822       | Ast0.AddingBetweenDots(stm) ->
 823           Ast0.AddingBetweenDots(statement stm))
 824
 825   and statement s =
 826     let k s =
 827       Ast0.rewrap s
 828         (match Ast0.unwrap s with
 829           Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace) ->
 830             Ast0.FunDecl(bef,List.map fninfo fi, ident name,
 831                          string_mcode lp, parameter_list params,
 832                          string_mcode rp, string_mcode lbrace,
 833                          statement_dots body, string_mcode rbrace)
 834         | Ast0.Decl(bef,decl) -> Ast0.Decl(bef,declaration decl)
 835         | Ast0.Seq(lbrace,body,rbrace) ->
 836             Ast0.Seq(string_mcode lbrace, statement_dots body,
 837                      string_mcode rbrace)
 838         | Ast0.ExprStatement(exp,sem) ->
 839             Ast0.ExprStatement(expression exp, string_mcode sem)
 840         | Ast0.IfThen(iff,lp,exp,rp,branch1,aft) ->
 841             Ast0.IfThen(string_mcode iff, string_mcode lp, expression exp,
 842               string_mcode rp, statement branch1,aft)
 843         | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) ->
 844             Ast0.IfThenElse(string_mcode iff,string_mcode lp,expression exp,
 845               string_mcode rp, statement branch1, string_mcode els,
 846               statement branch2,aft)
 847         | Ast0.While(whl,lp,exp,rp,body,aft) ->
 848             Ast0.While(string_mcode whl, string_mcode lp, expression exp,
 849                        string_mcode rp, statement body, aft)
 850         | Ast0.Do(d,body,whl,lp,exp,rp,sem) ->
 851             Ast0.Do(string_mcode d, statement body, string_mcode whl,
 852                     string_mcode lp, expression exp, string_mcode rp,
 853                     string_mcode sem)
 854         | Ast0.For(fr,lp,e1,sem1,e2,sem2,e3,rp,body,aft) ->
 855             Ast0.For(string_mcode fr, string_mcode lp,
 856                      get_option expression e1, string_mcode sem1,
 857                      get_option expression e2, string_mcode sem2,
 858                      get_option expression e3,
 859                      string_mcode rp, statement body, aft)
 860         | Ast0.Iterator(nm,lp,args,rp,body,aft) ->
 861             Ast0.Iterator(ident nm, string_mcode lp,
 862                           expression_dots args,
 863                           string_mcode rp, statement body, aft)
 864         | Ast0.Switch(switch,lp,exp,rp,lb,cases,rb) ->
 865             Ast0.Switch(string_mcode switch,string_mcode lp,expression exp,
 866                         string_mcode rp,string_mcode lb,
 867                         case_line_dots cases, string_mcode rb)
 868         | Ast0.Break(br,sem) ->
 869             Ast0.Break(string_mcode br,string_mcode sem)
 870         | Ast0.Continue(cont,sem) ->
 871             Ast0.Continue(string_mcode cont,string_mcode sem)
 872         | Ast0.Label(l,dd) -> Ast0.Label(ident l,string_mcode dd)
 873         | Ast0.Goto(goto,l,sem) ->
 874             Ast0.Goto(string_mcode goto,ident l,string_mcode sem)
 875         | Ast0.Return(ret,sem) ->
 876             Ast0.Return(string_mcode ret,string_mcode sem)
 877         | Ast0.ReturnExpr(ret,exp,sem) ->
 878             Ast0.ReturnExpr(string_mcode ret,expression exp,string_mcode sem)
 879         | Ast0.MetaStmt(name,pure) ->
 880             Ast0.MetaStmt(meta_mcode name,pure)
 881         | Ast0.MetaStmtList(name,pure) ->
 882             Ast0.MetaStmtList(meta_mcode name,pure)
 883         | Ast0.Disj(starter,statement_dots_list,mids,ender) ->
 884             Ast0.Disj(string_mcode starter,
 885                       List.map statement_dots statement_dots_list,
 886                       List.map string_mcode mids,
 887                       string_mcode ender)
 888         | Ast0.Nest(starter,stmt_dots,ender,whn,multi) ->
 889             Ast0.Nest(string_mcode starter,statement_dots stmt_dots,
 890                       string_mcode ender,
 891                       List.map (whencode statement_dots statement) whn,
 892                       multi)
 893         | Ast0.Exp(exp) -> Ast0.Exp(expression exp)
 894         | Ast0.TopExp(exp) -> Ast0.TopExp(expression exp)
 895         | Ast0.Ty(ty) -> Ast0.Ty(typeC ty)
 896         | Ast0.Dots(d,whn) ->
 897             Ast0.Dots(string_mcode d,
 898                       List.map (whencode statement_dots statement) whn)
 899         | Ast0.Circles(d,whn) ->
 900             Ast0.Circles(string_mcode d,
 901                          List.map (whencode statement_dots statement) whn)
 902         | Ast0.Stars(d,whn) ->
 903             Ast0.Stars(string_mcode d,
 904                        List.map (whencode statement_dots statement) whn)
 905         | Ast0.Include(inc,name) ->
 906             Ast0.Include(string_mcode inc,inc_mcode name)
 907         | Ast0.Define(def,id,params,body) ->
 908             Ast0.Define(string_mcode def,ident id,
 909                         define_parameters params,
 910                         statement_dots body)
 911         | Ast0.OptStm(re) -> Ast0.OptStm(statement re)
 912         | Ast0.UniqueStm(re) -> Ast0.UniqueStm(statement re)) in
 913     let s = stmtfn all_functions k s in
 914     process_bef_aft s
 915
 916   (* not parameterizable for now... *)
 917   and define_parameters p =
 918     let k p =
 919       Ast0.rewrap p
 920         (match Ast0.unwrap p with
 921           Ast0.NoParams -> Ast0.NoParams
 922         | Ast0.DParams(lp,params,rp) ->
 923             Ast0.DParams(string_mcode lp,define_param_dots params,
 924                          string_mcode rp))in
 925     k p
 926
 927   and define_param_dots d =
 928     let k d =
 929       Ast0.rewrap d
 930         (match Ast0.unwrap d with
 931           Ast0.DOTS(l) -> Ast0.DOTS(List.map define_param l)
 932         | Ast0.CIRCLES(l) -> Ast0.CIRCLES(List.map define_param l)
 933         | Ast0.STARS(l) -> Ast0.STARS(List.map define_param l)) in
 934     k d
 935
 936   and define_param p =
 937     let k p =
 938       Ast0.rewrap p
 939         (match Ast0.unwrap p with
 940           Ast0.DParam(id) -> Ast0.DParam(ident id)
 941         | Ast0.DPComma(comma) -> Ast0.DPComma(string_mcode comma)
 942         | Ast0.DPdots(d) -> Ast0.DPdots(string_mcode d)
 943         | Ast0.DPcircles(c) -> Ast0.DPcircles(string_mcode c)
 944         | Ast0.OptDParam(dp) -> Ast0.OptDParam(define_param dp)
 945         | Ast0.UniqueDParam(dp) -> Ast0.UniqueDParam(define_param dp)) in
 946     k p
 947
 948   and fninfo = function
 949       Ast0.FStorage(stg) -> Ast0.FStorage(storage_mcode stg)
 950     | Ast0.FType(ty) -> Ast0.FType(typeC ty)
 951     | Ast0.FInline(inline) -> Ast0.FInline(string_mcode inline)
 952     | Ast0.FAttr(init) -> Ast0.FAttr(string_mcode init)
 953
 954   and whencode notfn alwaysfn = function
 955       Ast0.WhenNot a -> Ast0.WhenNot (notfn a)
 956     | Ast0.WhenAlways a -> Ast0.WhenAlways (alwaysfn a)
 957     | Ast0.WhenModifier(x)    -> Ast0.WhenModifier(x)
 958
 959   and case_line c =
 960     let k c =
 961       Ast0.rewrap c
 962         (match Ast0.unwrap c with
 963           Ast0.Default(def,colon,code) ->
 964             Ast0.Default(string_mcode def,string_mcode colon,
 965                          statement_dots code)
 966         | Ast0.Case(case,exp,colon,code) ->
 967             Ast0.Case(string_mcode case,expression exp,string_mcode colon,
 968                       statement_dots code)
 969         | Ast0.OptCase(case) -> Ast0.OptCase(case_line case)) in
 970     casefn all_functions k c
 971
 972   and top_level t =
 973     let k t =
 974       Ast0.rewrap t
 975         (match Ast0.unwrap t with
 976           Ast0.FILEINFO(old_file,new_file) ->
 977             Ast0.FILEINFO(string_mcode old_file, string_mcode new_file)
 978         | Ast0.DECL(statement_dots) ->
 979             Ast0.DECL(statement statement_dots)
 980         | Ast0.CODE(stmt_dots) -> Ast0.CODE(statement_dots stmt_dots)
 981         | Ast0.ERRORWORDS(exps) -> Ast0.ERRORWORDS(List.map expression exps)
 982         | Ast0.OTHER(_) -> failwith "unexpected code") in
 983     topfn all_functions k t
 984
 985   and anything a = (* for compile_iso, not parameterisable *)
 986     let k = function
 987         Ast0.DotsExprTag(exprs) -> Ast0.DotsExprTag(expression_dots exprs)
 988       | Ast0.DotsInitTag(inits) -> Ast0.DotsInitTag(initialiser_list inits)
 989       | Ast0.DotsParamTag(params) -> Ast0.DotsParamTag(parameter_list params)
 990       | Ast0.DotsStmtTag(stmts) -> Ast0.DotsStmtTag(statement_dots stmts)
 991       | Ast0.DotsDeclTag(decls) -> Ast0.DotsDeclTag(declaration_dots decls)
 992       | Ast0.DotsCaseTag(cases) -> Ast0.DotsCaseTag(case_line_dots cases)
 993       | Ast0.IdentTag(id) -> Ast0.IdentTag(ident id)
 994       | Ast0.ExprTag(exp) -> Ast0.ExprTag(expression exp)
 995       | Ast0.ArgExprTag(exp) -> Ast0.ArgExprTag(expression exp)
 996       | Ast0.TestExprTag(exp) -> Ast0.TestExprTag(expression exp)
 997       | Ast0.TypeCTag(ty) -> Ast0.TypeCTag(typeC ty)
 998       | Ast0.ParamTag(param) -> Ast0.ParamTag(parameterTypeDef param)
 999       | Ast0.InitTag(init) -> Ast0.InitTag(initialiser init)
1000       | Ast0.DeclTag(decl) -> Ast0.DeclTag(declaration decl)
1001       | Ast0.StmtTag(stmt) -> Ast0.StmtTag(statement stmt)
1002       | Ast0.CaseLineTag(c) -> Ast0.CaseLineTag(case_line c)
1003       | Ast0.TopTag(top) -> Ast0.TopTag(top_level top)
1004       | Ast0.IsoWhenTag(x) -> Ast0.IsoWhenTag(x)
1005       | Ast0.MetaPosTag(var) -> failwith "not supported" in
1006     k a
1007
1008   (* not done for combiner, because the statement is assumed to be already
1009      represented elsewhere in the code *)
1010
1011   and all_functions =
1012     {rebuilder_ident = ident;
1013       rebuilder_expression = expression;
1014       rebuilder_typeC = typeC;
1015       rebuilder_declaration = declaration;
1016       rebuilder_initialiser = initialiser;
1017       rebuilder_initialiser_list = initialiser_list;
1018       rebuilder_parameter = parameterTypeDef;
1019       rebuilder_parameter_list = parameter_list;
1020       rebuilder_statement = statement;
1021       rebuilder_case_line = case_line;
1022       rebuilder_top_level = top_level;
1023       rebuilder_expression_dots = expression_dots;
1024       rebuilder_statement_dots = statement_dots;
1025       rebuilder_declaration_dots = declaration_dots;
1026       rebuilder_case_line_dots = case_line_dots;
1027       rebuilder_anything = anything} in
1028   all_functions