parsing_cocci/.#arity.ml.1.88

   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 (* Arities matter for the minus slice, but not for the plus slice. *)
  24
  25 (* ? only allowed on rule_elems, and on subterms if the context is ? also. *)
  26
  27 module Ast0 = Ast0_cocci
  28 module Ast = Ast_cocci
  29
  30 (* --------------------------------------------------------------------- *)
  31
  32 let warning s = Printf.printf "warning: %s\n" s
  33
  34 let fail w str =
  35   failwith
  36     (Printf.sprintf "cocci line %d: %s" ((Ast0.get_info w).Ast0.line_start)
  37        str)
  38
  39 let make_opt_unique optfn uniquefn info tgt arity term =
  40   let term = Ast0.rewrap info term in
  41   if tgt = arity
  42   then term
  43   else (* tgt must be NONE *)
  44     match arity with
  45       Ast0.OPT -> Ast0.copywrap info (optfn term)
  46     | Ast0.UNIQUE -> Ast0.copywrap info (uniquefn term)
  47     | Ast0.NONE -> failwith "tgt must be NONE"
  48
  49 let all_same opt_allowed tgt line arities =
  50   let tgt =
  51     match tgt with
  52       Ast0.NONE ->
  53         (match List.hd arities with
  54           Ast0.OPT when not opt_allowed ->
  55             failwith "opt only allowed for the elements of a statement list"
  56         | x -> x)
  57     | _ -> tgt in
  58   if not(List.for_all (function x -> x = tgt) arities)
  59   then warning (Printf.sprintf "incompatible arity found on line %d" line);
  60   tgt
  61
  62 let get_option fn = function
  63     None -> None
  64   | Some x -> Some (fn x)
  65
  66 let anyopt l fn = List.exists (function w -> fn(Ast0.unwrap w)) l
  67
  68 let allopt l fn =
  69   let rec loop = function
  70       [] -> []
  71     | x::xs ->
  72         match fn (Ast0.unwrap x) with
  73           Some x -> x :: (loop xs)
  74         | None -> [] in
  75   let res = loop l in
  76   if List.length res = List.length l then Some res else None
  77
  78 (* --------------------------------------------------------------------- *)
  79 (* --------------------------------------------------------------------- *)
  80 (* Mcode *)
  81
  82 let mcode2line (_,_,info,_,_) = info.Ast0.line_start
  83 let mcode2arity (_,arity,_,_,_) = arity
  84
  85 let mcode x = x (* nothing to do ... *)
  86
  87 (* --------------------------------------------------------------------- *)
  88 (* Dots *)
  89
  90 let dots fn d =
  91   Ast0.rewrap d
  92     (match Ast0.unwrap d with
  93       Ast0.DOTS(x) -> Ast0.DOTS(List.map fn x)
  94     | Ast0.CIRCLES(x) -> Ast0.CIRCLES(List.map fn x)
  95     | Ast0.STARS(x) -> Ast0.STARS(List.map fn x))
  96
  97 let only_dots l =
  98   not
  99     (List.exists
 100        (function x ->
 101           match Ast0.unwrap x with
 102            Ast0.Circles(_,_) | Ast0.Stars(_,_) -> true
 103          | _ -> false)
 104        l)
 105
 106 let only_circles l =
 107   not (List.exists
 108         (function x ->
 109           match Ast0.unwrap x with
 110             Ast0.Dots(_,_) | Ast0.Stars(_,_) -> true
 111           | _ -> false)
 112          l)
 113
 114 let only_stars l =
 115   not (List.exists
 116         (function x ->
 117           match Ast0.unwrap x with
 118             Ast0.Dots(_,_) | Ast0.Circles(_,_) -> true
 119           | _ -> false)
 120          l)
 121
 122 let concat_dots fn d =
 123   Ast0.rewrap d
 124     (match Ast0.unwrap d with
 125       Ast0.DOTS(x) ->
 126         let l = List.map fn x in
 127         if only_dots l
 128         then Ast0.DOTS(l)
 129         else fail d "inconsistent dots usage"
 130     | Ast0.CIRCLES(x) ->
 131         let l = List.map fn x in
 132         if only_circles l
 133         then Ast0.CIRCLES(l)
 134         else fail d "inconsistent dots usage"
 135     | Ast0.STARS(x) ->
 136         let l = List.map fn x in
 137         if only_stars l
 138         then Ast0.STARS(l)
 139         else fail d "inconsistent dots usage")
 140
 141 let flat_concat_dots fn d =
 142   match Ast0.unwrap d with
 143     Ast0.DOTS(x) -> List.map fn x
 144   | Ast0.CIRCLES(x) -> List.map fn x
 145   | Ast0.STARS(x) -> List.map fn x
 146
 147 (* --------------------------------------------------------------------- *)
 148 (* Identifier *)
 149
 150 let make_id =
 151   make_opt_unique
 152     (function x -> Ast0.OptIdent x)
 153     (function x -> Ast0.UniqueIdent x)
 154
 155 let ident opt_allowed tgt i =
 156   match Ast0.unwrap i with
 157     Ast0.Id(name) ->
 158       let arity =
 159         all_same opt_allowed tgt (mcode2line name)
 160           [mcode2arity name] in
 161       let name = mcode name in
 162       make_id i tgt arity (Ast0.Id(name))
 163   | Ast0.MetaId(name,constraints,pure) ->
 164       let arity =
 165         all_same opt_allowed tgt (mcode2line name)
 166           [mcode2arity name] in
 167       let name = mcode name in
 168       make_id i tgt arity (Ast0.MetaId(name,constraints,pure))
 169   | Ast0.MetaFunc(name,constraints,pure) ->
 170       let arity =
 171         all_same opt_allowed tgt (mcode2line name)
 172           [mcode2arity name] in
 173       let name = mcode name in
 174       make_id i tgt arity (Ast0.MetaFunc(name,constraints,pure))
 175   | Ast0.MetaLocalFunc(name,constraints,pure) ->
 176       let arity =
 177         all_same opt_allowed tgt (mcode2line name)
 178           [mcode2arity name] in
 179       let name = mcode name in
 180       make_id i tgt arity (Ast0.MetaLocalFunc(name,constraints,pure))
 181   | Ast0.OptIdent(_) | Ast0.UniqueIdent(_) ->
 182       failwith "unexpected code"
 183
 184 (* --------------------------------------------------------------------- *)
 185 (* Expression *)
 186
 187 let make_exp =
 188   make_opt_unique
 189     (function x -> Ast0.OptExp x)
 190     (function x -> Ast0.UniqueExp x)
 191
 192 let rec top_expression opt_allowed tgt expr =
 193   let exp_same = all_same opt_allowed tgt in
 194   match Ast0.unwrap expr with
 195     Ast0.Ident(id) ->
 196       let new_id = ident opt_allowed tgt id in
 197       Ast0.rewrap expr
 198         (match Ast0.unwrap new_id with
 199           Ast0.OptIdent(id) ->
 200             Ast0.OptExp(Ast0.rewrap expr (Ast0.Ident(id)))
 201         | Ast0.UniqueIdent(id) ->
 202             Ast0.UniqueExp(Ast0.rewrap expr (Ast0.Ident(id)))
 203         | _ -> Ast0.Ident(new_id))
 204   | Ast0.Constant(const) ->
 205       let arity = exp_same (mcode2line const) [mcode2arity const] in
 206       let const = mcode const in
 207       make_exp expr tgt arity (Ast0.Constant(const))
 208   | Ast0.FunCall(fn,lp,args,rp) ->
 209       let arity = exp_same (mcode2line lp) [mcode2arity lp;mcode2arity rp] in
 210       let fn = expression arity fn in
 211       let lp = mcode lp in
 212       let args = dots (expression arity) args in
 213       let rp = mcode rp in
 214       make_exp expr tgt arity (Ast0.FunCall(fn,lp,args,rp))
 215   | Ast0.Assignment(left,op,right,simple) ->
 216       let arity = exp_same (mcode2line op) [mcode2arity op] in
 217       let left = expression arity left in
 218       let op = mcode op in
 219       let right = expression arity right in
 220       make_exp expr tgt arity (Ast0.Assignment(left,op,right,simple))
 221   | Ast0.CondExpr(exp1,why,exp2,colon,exp3) ->
 222       let arity =
 223         exp_same (mcode2line why) [mcode2arity why; mcode2arity colon] in
 224       let exp1 = expression arity exp1 in
 225       let why = mcode why in
 226       let exp2 = get_option (expression arity) exp2 in
 227       let colon = mcode colon in
 228       let exp3 = expression arity exp3 in
 229       make_exp expr tgt arity (Ast0.CondExpr(exp1,why,exp2,colon,exp3))
 230   | Ast0.Postfix(exp,op) ->
 231       let arity = exp_same (mcode2line op) [mcode2arity op] in
 232       let exp = expression arity exp in
 233       let op = mcode op in
 234       make_exp expr tgt arity (Ast0.Postfix(exp,op))
 235   | Ast0.Infix(exp,op) ->
 236       let arity = exp_same (mcode2line op) [mcode2arity op] in
 237       let exp = expression arity exp in
 238       let op = mcode op in
 239       make_exp expr tgt arity (Ast0.Infix(exp,op))
 240   | Ast0.Unary(exp,op) ->
 241       let arity = exp_same (mcode2line op) [mcode2arity op] in
 242       let exp = expression arity exp in
 243       let op = mcode op in
 244       make_exp expr tgt arity (Ast0.Unary(exp,op))
 245   | Ast0.Binary(left,op,right) ->
 246       let arity = exp_same (mcode2line op) [mcode2arity op] in
 247       let left = expression arity left in
 248       let op = mcode op in
 249       let right = expression arity right in
 250       make_exp expr tgt arity (Ast0.Binary(left,op,right))
 251   | Ast0.Nested(left,op,right) -> failwith "nested in arity not possible"
 252   | Ast0.Paren(lp,exp,rp) ->
 253       let arity = exp_same (mcode2line lp) [mcode2arity lp;mcode2arity rp] in
 254       let lp = mcode lp in
 255       let exp = expression arity exp in
 256       let rp = mcode rp in
 257       make_exp expr tgt arity (Ast0.Paren(lp,exp,rp))
 258   | Ast0.ArrayAccess(exp1,lb,exp2,rb) ->
 259       let arity = exp_same (mcode2line lb) [mcode2arity lb; mcode2arity rb] in
 260       let exp1 = expression arity exp1 in
 261       let lb = mcode lb in
 262       let exp2 = expression arity exp2 in
 263       let rb = mcode rb in
 264       make_exp expr tgt arity (Ast0.ArrayAccess(exp1,lb,exp2,rb))
 265   | Ast0.RecordAccess(exp,pt,field) ->
 266       let arity = exp_same (mcode2line pt) [mcode2arity pt] in
 267       let exp = expression arity exp in
 268       let pt = mcode pt in
 269       let field = ident false arity field in
 270       make_exp expr tgt arity (Ast0.RecordAccess(exp,pt,field))
 271   | Ast0.RecordPtAccess(exp,ar,field) ->
 272       let arity = exp_same (mcode2line ar) [mcode2arity ar] in
 273       let exp = expression arity exp in
 274       let ar = mcode ar in
 275       let field = ident false arity field in
 276       make_exp expr tgt arity (Ast0.RecordPtAccess(exp,ar,field))
 277   | Ast0.Cast(lp,ty,rp,exp) ->
 278       let arity = exp_same (mcode2line lp) [mcode2arity lp;mcode2arity rp] in
 279       let lp = mcode lp in
 280       let ty = typeC arity ty in
 281       let rp = mcode rp in
 282       let exp = expression arity exp in
 283       make_exp expr tgt arity (Ast0.Cast(lp,ty,rp,exp))
 284   | Ast0.SizeOfExpr(szf,exp) ->
 285       let arity = exp_same (mcode2line szf) [mcode2arity szf] in
 286       let szf = mcode szf in
 287       let exp = expression arity exp in
 288       make_exp expr tgt arity (Ast0.SizeOfExpr(szf,exp))
 289   | Ast0.SizeOfType(szf,lp,ty,rp) ->
 290       let arity =
 291         exp_same (mcode2line szf) (List.map mcode2arity [szf;lp;rp]) in
 292       let szf = mcode szf in
 293       let lp = mcode lp in
 294       let ty = typeC arity ty in
 295       let rp = mcode rp in
 296       make_exp expr tgt arity (Ast0.SizeOfType(szf,lp,ty,rp))
 297   | Ast0.TypeExp(ty) -> Ast0.rewrap expr (Ast0.TypeExp(typeC tgt ty))
 298   | Ast0.MetaErr(name,constraints,pure)  ->
 299       let arity = exp_same (mcode2line name) [mcode2arity name] in
 300       let name = mcode name in
 301       make_exp expr tgt arity (Ast0.MetaErr(name,constraints,pure))
 302   | Ast0.MetaExpr(name,constraints,ty,form,pure)  ->
 303       let arity = exp_same (mcode2line name) [mcode2arity name] in
 304       let name = mcode name in
 305       make_exp expr tgt arity (Ast0.MetaExpr(name,constraints,ty,form,pure))
 306   | Ast0.MetaExprList(name,lenname,pure) ->
 307       let arity = exp_same (mcode2line name) [mcode2arity name] in
 308       let name = mcode name in
 309       make_exp expr tgt arity (Ast0.MetaExprList(name,lenname,pure))
 310   | Ast0.EComma(cm)         ->
 311       let arity = exp_same (mcode2line cm) [mcode2arity cm] in
 312       let cm = mcode cm in
 313       make_exp expr tgt arity (Ast0.EComma(cm))
 314   | Ast0.DisjExpr(starter,exps,mids,ender) ->
 315       let exps = List.map (top_expression opt_allowed tgt) exps in
 316       (match List.rev exps with
 317         _::xs ->
 318           if anyopt xs (function Ast0.OptExp(_) -> true | _ -> false)
 319           then fail expr "opt only allowed in the last disjunct"
 320       | _ -> ());
 321       Ast0.rewrap expr (Ast0.DisjExpr(starter,exps,mids,ender))
 322   | Ast0.NestExpr(starter,exp_dots,ender,whencode,multi) ->
 323       let res =
 324         Ast0.NestExpr(starter,
 325                       dots (top_expression true Ast0.NONE) exp_dots,
 326                       ender,whencode,multi) in
 327       Ast0.rewrap expr res
 328   | Ast0.Edots(dots,whencode) ->
 329       let arity = exp_same (mcode2line dots) [mcode2arity dots] in
 330       let dots = mcode dots in
 331       let whencode = get_option (expression Ast0.NONE) whencode in
 332       make_exp expr tgt arity (Ast0.Edots(dots,whencode))
 333   | Ast0.Ecircles(dots,whencode) ->
 334       let arity = exp_same (mcode2line dots) [mcode2arity dots] in
 335       let dots = mcode dots in
 336       let whencode = get_option (expression Ast0.NONE) whencode in
 337       make_exp expr tgt arity (Ast0.Ecircles(dots,whencode))
 338   | Ast0.Estars(dots,whencode) ->
 339       let arity = exp_same (mcode2line dots) [mcode2arity dots] in
 340       let dots = mcode dots in
 341       let whencode = get_option (expression Ast0.NONE) whencode in
 342       make_exp expr tgt arity (Ast0.Estars(dots,whencode))
 343   | Ast0.OptExp(_) | Ast0.UniqueExp(_) ->
 344       failwith "unexpected code"
 345
 346 and expression tgt exp = top_expression false tgt exp
 347
 348 (* --------------------------------------------------------------------- *)
 349 (* Types *)
 350
 351 and make_typeC =
 352   make_opt_unique
 353     (function x -> Ast0.OptType x)
 354     (function x -> Ast0.UniqueType x)
 355
 356 and top_typeC tgt opt_allowed typ =
 357   match Ast0.unwrap typ with
 358     Ast0.ConstVol(cv,ty) ->
 359       let arity = all_same opt_allowed tgt (mcode2line cv)
 360           [mcode2arity cv] in
 361       let cv = mcode cv in
 362       let ty = typeC arity ty in
 363       make_typeC typ tgt arity (Ast0.ConstVol(cv,ty))
 364   | Ast0.BaseType(ty,strings) ->
 365       let arity =
 366         all_same opt_allowed tgt (mcode2line (List.hd strings))
 367           (List.map mcode2arity strings) in
 368       let strings = List.map mcode strings in
 369       make_typeC typ tgt arity (Ast0.BaseType(ty,strings))
 370   | Ast0.Signed(sign,ty) ->
 371       let arity =
 372         all_same opt_allowed tgt (mcode2line sign) [mcode2arity sign] in
 373       let sign = mcode sign in
 374       let ty = get_option (typeC arity) ty in
 375       make_typeC typ tgt arity (Ast0.Signed(sign,ty))
 376   | Ast0.Pointer(ty,star) ->
 377       let arity =
 378         all_same opt_allowed tgt (mcode2line star) [mcode2arity star] in
 379       let ty = typeC arity ty in
 380       let star = mcode star in
 381       make_typeC typ tgt arity (Ast0.Pointer(ty,star))
 382   | Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2) ->
 383       let arity =
 384         all_same opt_allowed tgt (mcode2line lp1)
 385           (List.map mcode2arity [lp1;star;rp1;lp2;rp2]) in
 386       let ty = typeC arity ty in
 387       let params = parameter_list tgt params in
 388       make_typeC typ tgt arity
 389         (Ast0.FunctionPointer(ty,lp1,star,rp1,lp2,params,rp2))
 390   | Ast0.FunctionType(ty,lp1,params,rp1) ->
 391       let arity =
 392         all_same opt_allowed tgt (mcode2line lp1)
 393           (List.map mcode2arity [lp1;rp1]) in
 394       let ty = get_option (typeC arity) ty in
 395       let params = parameter_list tgt params in
 396       make_typeC typ tgt arity (Ast0.FunctionType(ty,lp1,params,rp1))
 397   | Ast0.Array(ty,lb,size,rb) ->
 398       let arity =
 399         all_same opt_allowed tgt (mcode2line lb)
 400           [mcode2arity lb;mcode2arity rb] in
 401       let ty = typeC arity ty in
 402       let lb = mcode lb in
 403       let size = get_option (expression arity) size in
 404       let rb = mcode rb in
 405       make_typeC typ tgt arity (Ast0.Array(ty,lb,size,rb))
 406   | Ast0.EnumName(kind,name) ->
 407       let arity =
 408         all_same opt_allowed tgt (mcode2line kind) [mcode2arity kind] in
 409       let kind = mcode kind in
 410       let name = ident false arity name in
 411       make_typeC typ tgt arity (Ast0.EnumName(kind,name))
 412   | Ast0.StructUnionName(kind,name) ->
 413       let arity =
 414         all_same opt_allowed tgt (mcode2line kind)
 415           [mcode2arity kind] in
 416       let kind = mcode kind in
 417       let name = get_option (ident false arity) name in
 418       make_typeC typ tgt arity (Ast0.StructUnionName(kind,name))
 419   | Ast0.StructUnionDef(ty,lb,decls,rb) ->
 420       let arity =
 421         all_same opt_allowed tgt (mcode2line lb)
 422           (List.map mcode2arity [lb;rb]) in
 423       let ty = typeC arity ty in
 424       let lb = mcode lb in
 425       let decls = dots (declaration tgt) decls in
 426       let rb = mcode rb in
 427       make_typeC typ tgt arity (Ast0.StructUnionDef(ty,lb,decls,rb))
 428   | Ast0.TypeName(name) ->
 429       let arity =
 430         all_same opt_allowed tgt (mcode2line name) [mcode2arity name] in
 431       let name = mcode name in
 432       make_typeC typ tgt arity (Ast0.TypeName(name))
 433   | Ast0.MetaType(name,pure) ->
 434       let arity =
 435         all_same opt_allowed tgt (mcode2line name) [mcode2arity name] in
 436       let name = mcode name in
 437       make_typeC typ tgt arity (Ast0.MetaType(name,pure))
 438   | Ast0.DisjType(starter,types,mids,ender) ->
 439       let types = List.map (typeC tgt) types in
 440       (match List.rev types with
 441         _::xs ->
 442           if anyopt xs (function Ast0.OptType(_) -> true | _ -> false)
 443           then fail typ "opt only allowed in the last disjunct"
 444       | _ -> ());
 445       let res = Ast0.DisjType(starter,types,mids,ender) in
 446       Ast0.rewrap typ res
 447   | Ast0.OptType(_) | Ast0.UniqueType(_) ->
 448       failwith "unexpected code"
 449
 450 and typeC tgt ty = top_typeC tgt false ty
 451
 452 (* --------------------------------------------------------------------- *)
 453 (* Variable declaration *)
 454 (* Even if the Cocci program specifies a list of declarations, they are
 455    split out into multiple declarations of a single variable each. *)
 456
 457 and make_decl =
 458   make_opt_unique
 459     (function x -> Ast0.OptDecl x)
 460     (function x -> Ast0.UniqueDecl x)
 461
 462 and declaration tgt decl =
 463   match Ast0.unwrap decl with
 464     Ast0.Init(stg,ty,id,eq,exp,sem) ->
 465       let arity =
 466         all_same true tgt (mcode2line eq)
 467           ((match stg with None -> [] | Some x -> [mcode2arity x]) @
 468            (List.map mcode2arity [eq;sem])) in
 469       let stg = get_option mcode stg in
 470       let ty = typeC arity ty in
 471       let id = ident false arity id in
 472       let eq = mcode eq in
 473       let exp = initialiser arity exp in
 474       let sem = mcode sem in
 475       make_decl decl tgt arity (Ast0.Init(stg,ty,id,eq,exp,sem))
 476   | Ast0.UnInit(stg,ty,id,sem) ->
 477       let arity =
 478         all_same true tgt (mcode2line sem)
 479           ((match stg with None -> [] | Some x -> [mcode2arity x]) @
 480            [mcode2arity sem]) in
 481       let stg = get_option mcode stg in
 482       let ty = typeC arity ty in
 483       let id = ident false arity id in
 484       let sem = mcode sem in
 485       make_decl decl tgt arity (Ast0.UnInit(stg,ty,id,sem))
 486   | Ast0.MacroDecl(name,lp,args,rp,sem) ->
 487       let arity =
 488         all_same true tgt (mcode2line lp) (List.map mcode2arity [lp;rp;sem]) in
 489       let name = ident false arity name in
 490       let lp = mcode lp in
 491       let args = dots (expression arity) args in
 492       let rp = mcode rp in
 493       let sem = mcode sem in
 494       make_decl decl tgt arity (Ast0.MacroDecl(name,lp,args,rp,sem))
 495   | Ast0.TyDecl(ty,sem) ->
 496       let arity =
 497         all_same true tgt (mcode2line sem) [mcode2arity sem] in
 498       let ty = typeC arity ty in
 499       let sem = mcode sem in
 500       make_decl decl tgt arity (Ast0.TyDecl(ty,sem))
 501   | Ast0.Typedef(stg,ty,id,sem) ->
 502       let arity =
 503         all_same true tgt (mcode2line sem)
 504           [mcode2arity stg;mcode2arity sem] in
 505       let stg = mcode stg in
 506       let ty = typeC arity ty in
 507       let id = typeC arity id in
 508       let sem = mcode sem in
 509       make_decl decl tgt arity (Ast0.Typedef(stg,ty,id,sem))
 510   | Ast0.DisjDecl(starter,decls,mids,ender) ->
 511       let decls = List.map (declaration tgt) decls in
 512       (match List.rev decls with
 513         _::xs ->
 514           if anyopt xs (function Ast0.OptDecl(_) -> true | _ -> false)
 515           then fail decl "opt only allowed in the last disjunct"
 516       | _ -> ());
 517       let res = Ast0.DisjDecl(starter,decls,mids,ender) in
 518       Ast0.rewrap decl res
 519   | Ast0.Ddots(dots,whencode) ->
 520       let arity = all_same true tgt (mcode2line dots) [mcode2arity dots] in
 521       let dots = mcode dots in
 522       let whencode = get_option (declaration Ast0.NONE) whencode in
 523       make_decl decl tgt arity (Ast0.Ddots(dots,whencode))
 524   | Ast0.OptDecl(_) | Ast0.UniqueDecl(_) ->
 525       failwith "unexpected code"
 526
 527 (* --------------------------------------------------------------------- *)
 528 (* Initializer *)
 529
 530 and make_init =
 531   make_opt_unique
 532     (function x -> Ast0.OptIni x)
 533     (function x -> Ast0.UniqueIni x)
 534
 535 and initialiser tgt i =
 536   let init_same = all_same true tgt in
 537   match Ast0.unwrap i with
 538     Ast0.MetaInit(name,pure) ->
 539       let arity = init_same (mcode2line name) [mcode2arity name] in
 540       let name = mcode name in
 541       make_init i tgt arity (Ast0.MetaInit(name,pure))
 542   | Ast0.InitExpr(exp) ->
 543       Ast0.rewrap i (Ast0.InitExpr(expression tgt exp))
 544   | Ast0.InitList(lb,initlist,rb) ->
 545       let arity = init_same (mcode2line lb) [mcode2arity lb; mcode2arity rb] in
 546       let lb = mcode lb in
 547       let initlist = dots (initialiser arity) initlist in
 548       let rb = mcode rb in
 549       make_init i tgt arity (Ast0.InitList(lb,initlist,rb))
 550   | Ast0.InitGccExt(designators,eq,ini) ->
 551       let arity = init_same (mcode2line eq) [mcode2arity eq] in
 552       let designators = List.map (designator arity) designators in
 553       let eq = mcode eq in
 554       let ini = initialiser arity ini in
 555       make_init i tgt arity (Ast0.InitGccExt(designators,eq,ini))
 556   | Ast0.InitGccName(name,eq,ini) ->
 557       let arity = init_same (mcode2line eq) [mcode2arity eq] in
 558       let name = ident true arity name in
 559       let eq = mcode eq in
 560       let ini = initialiser arity ini in
 561       make_init i tgt arity (Ast0.InitGccName(name,eq,ini))
 562   | Ast0.IComma(cm) ->
 563       let arity = init_same (mcode2line cm) [mcode2arity cm] in
 564       let cm = mcode cm in
 565       make_init i tgt arity (Ast0.IComma(cm))
 566   | Ast0.Idots(dots,whencode) ->
 567       let arity = init_same (mcode2line dots) [mcode2arity dots] in
 568       let dots = mcode dots in
 569       let whencode = get_option (initialiser Ast0.NONE) whencode in
 570       make_init i tgt arity (Ast0.Idots(dots,whencode))
 571   | Ast0.OptIni(_) | Ast0.UniqueIni(_) ->
 572       failwith "unexpected code"
 573
 574 and designator tgt d =
 575   let dsame = all_same false tgt in
 576   match d with
 577     Ast0.DesignatorField(dot,id) ->
 578       let arity = dsame (mcode2line dot) [mcode2arity dot] in
 579       let dot = mcode dot in
 580       let id = ident false arity id in
 581       Ast0.DesignatorField(dot,id)
 582   | Ast0.DesignatorIndex(lb,exp,rb) ->
 583       let arity = dsame (mcode2line lb) [mcode2arity lb;mcode2arity rb] in
 584       let lb = mcode lb in
 585       let exp = top_expression false arity exp in
 586       let rb = mcode rb in
 587       Ast0.DesignatorIndex(lb,exp,rb)
 588   | Ast0.DesignatorRange(lb,min,dots,max,rb) ->
 589       let arity =
 590         dsame (mcode2line lb)
 591           [mcode2arity lb;mcode2arity dots;mcode2arity rb] in
 592       let lb = mcode lb in
 593       let min = top_expression false arity min in
 594       let dots = mcode dots in
 595       let max = top_expression false arity max in
 596       let rb = mcode rb in
 597       Ast0.DesignatorRange(lb,min,dots,max,rb)
 598
 599 (* --------------------------------------------------------------------- *)
 600 (* Parameter *)
 601
 602 and make_param =
 603   make_opt_unique
 604     (function x -> Ast0.OptParam x)
 605     (function x -> Ast0.UniqueParam x)
 606
 607 and parameterTypeDef tgt param =
 608   let param_same = all_same true tgt in
 609   match Ast0.unwrap param with
 610     Ast0.VoidParam(ty) -> Ast0.rewrap param (Ast0.VoidParam(typeC tgt ty))
 611   | Ast0.Param(ty,Some id) ->
 612       let ty = top_typeC tgt true ty in
 613       let id = ident true tgt id in
 614       Ast0.rewrap param
 615         (match (Ast0.unwrap ty,Ast0.unwrap id) with
 616           (Ast0.OptType(ty),Ast0.OptIdent(id)) ->
 617             Ast0.OptParam(Ast0.rewrap param (Ast0.Param(ty,Some id)))
 618         | (Ast0.UniqueType(ty),Ast0.UniqueIdent(id)) ->
 619             Ast0.UniqueParam(Ast0.rewrap param (Ast0.Param(ty,Some id)))
 620         | (Ast0.OptType(ty),_) ->
 621             fail param "arity mismatch in param declaration"
 622         | (_,Ast0.OptIdent(id)) ->
 623             fail param "arity mismatch in param declaration"
 624         | _ -> Ast0.Param(ty,Some id))
 625   | Ast0.Param(ty,None) ->
 626       let ty = top_typeC tgt true ty in
 627       Ast0.rewrap param
 628         (match Ast0.unwrap ty with
 629           Ast0.OptType(ty) ->
 630             Ast0.OptParam(Ast0.rewrap param (Ast0.Param(ty,None)))
 631         | Ast0.UniqueType(ty) ->
 632             Ast0.UniqueParam(Ast0.rewrap param (Ast0.Param(ty,None)))
 633         | _ -> Ast0.Param(ty,None))
 634   | Ast0.MetaParam(name,pure) ->
 635       let arity = param_same (mcode2line name) [mcode2arity name] in
 636       let name = mcode name in
 637       make_param param tgt arity (Ast0.MetaParam(name,pure))
 638   | Ast0.MetaParamList(name,lenname,pure) ->
 639       let arity = param_same (mcode2line name) [mcode2arity name] in
 640       let name = mcode name in
 641       make_param param tgt arity (Ast0.MetaParamList(name,lenname,pure))
 642   | Ast0.PComma(cm) ->
 643       let arity = param_same (mcode2line cm) [mcode2arity cm] in
 644       let cm = mcode cm in
 645       make_param param tgt arity (Ast0.PComma(cm))
 646   | Ast0.Pdots(dots) ->
 647       let arity = param_same (mcode2line dots) [mcode2arity dots] in
 648       let dots = mcode dots in
 649       make_param param tgt arity (Ast0.Pdots(dots))
 650   | Ast0.Pcircles(dots) ->
 651       let arity = param_same (mcode2line dots) [mcode2arity dots] in
 652       let dots = mcode dots in
 653       make_param param tgt arity (Ast0.Pcircles(dots))
 654   | Ast0.OptParam(_) | Ast0.UniqueParam(_) ->
 655       failwith "unexpected code"
 656
 657 and parameter_list tgt = dots (parameterTypeDef tgt)
 658
 659 (* --------------------------------------------------------------------- *)
 660 (* Top-level code *)
 661
 662 and make_rule_elem x =
 663   make_opt_unique
 664     (function x -> Ast0.OptStm x)
 665     (function x -> Ast0.UniqueStm x)
 666     x
 667
 668 and statement tgt stm =
 669   let stm_same = all_same true tgt in
 670   match Ast0.unwrap stm with
 671     Ast0.Decl(bef,decl) ->
 672       let new_decl = declaration tgt decl in
 673       Ast0.rewrap stm
 674         (match Ast0.unwrap new_decl with
 675           Ast0.OptDecl(decl) ->
 676             Ast0.OptStm(Ast0.rewrap stm (Ast0.Decl(bef,decl)))
 677         | Ast0.UniqueDecl(decl) ->
 678             Ast0.UniqueStm(Ast0.rewrap stm (Ast0.Decl(bef,decl)))
 679         | _ -> Ast0.Decl(bef,new_decl))
 680   | Ast0.Seq(lbrace,body,rbrace) ->
 681       let arity =
 682         stm_same (mcode2line lbrace)
 683           [mcode2arity lbrace; mcode2arity rbrace] in
 684       let lbrace = mcode lbrace in
 685       let body = dots (statement arity) body in
 686       let rbrace = mcode rbrace in
 687       make_rule_elem stm tgt arity (Ast0.Seq(lbrace,body,rbrace))
 688   | Ast0.ExprStatement(exp,sem) ->
 689       let arity = stm_same (mcode2line sem) [mcode2arity sem] in
 690       let exp = expression arity exp in
 691       let sem = mcode sem in
 692       make_rule_elem stm tgt arity (Ast0.ExprStatement(exp,sem))
 693   | Ast0.IfThen(iff,lp,exp,rp,branch,aft) ->
 694       let arity =
 695         stm_same (mcode2line iff) (List.map mcode2arity [iff;lp;rp]) in
 696       let iff = mcode iff in
 697       let lp = mcode lp in
 698       let exp = expression arity exp in
 699       let rp = mcode rp in
 700       let branch = statement arity branch in
 701       make_rule_elem stm tgt arity (Ast0.IfThen(iff,lp,exp,rp,branch,aft))
 702   | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) ->
 703       let arity =
 704         stm_same (mcode2line iff) (List.map mcode2arity [iff;lp;rp;els]) in
 705       let iff = mcode iff in
 706       let lp = mcode lp in
 707       let exp = expression arity exp in
 708       let rp = mcode rp in
 709       let branch1 = statement arity branch1 in
 710       let els = mcode els in
 711       let branch2 = statement arity branch2 in
 712       make_rule_elem stm tgt arity
 713         (Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft))
 714   | Ast0.While(wh,lp,exp,rp,body,aft) ->
 715       let arity =
 716         stm_same (mcode2line wh)
 717           (List.map mcode2arity [wh;lp;rp]) in
 718       let wh = mcode wh in
 719       let lp = mcode lp in
 720       let exp = expression arity exp in
 721       let rp = mcode rp in
 722       let body = statement arity body in
 723       make_rule_elem stm tgt arity (Ast0.While(wh,lp,exp,rp,body,aft))
 724   | Ast0.Do(d,body,wh,lp,exp,rp,sem) ->
 725       let arity =
 726         stm_same (mcode2line wh) (List.map mcode2arity [d;wh;lp;rp;sem]) in
 727       let d = mcode d in
 728       let body = statement arity body in
 729       let wh = mcode wh in
 730       let lp = mcode lp in
 731       let exp = expression arity exp in
 732       let rp = mcode rp in
 733       let sem = mcode sem in
 734       make_rule_elem stm tgt arity (Ast0.Do(d,body,wh,lp,exp,rp,sem))
 735   | Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,aft) ->
 736       let arity =
 737         stm_same (mcode2line fr) (List.map mcode2arity [fr;lp;sem1;sem2;rp]) in
 738       let fr = mcode fr in
 739       let lp = mcode lp in
 740       let exp1 = get_option (expression arity) exp1 in
 741       let sem1 = mcode sem1 in
 742       let exp2 = get_option (expression arity) exp2 in
 743       let sem2= mcode sem2 in
 744       let exp3 = get_option (expression arity) exp3 in
 745       let rp = mcode rp in
 746       let body = statement arity body in
 747       make_rule_elem stm tgt arity
 748         (Ast0.For(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,aft))
 749   | Ast0.Iterator(nm,lp,args,rp,body,aft) ->
 750       let arity = stm_same (mcode2line lp) (List.map mcode2arity [lp;rp]) in
 751       let nm = ident false arity nm in
 752       let lp = mcode lp in
 753       let args = dots (expression arity) args in
 754       let rp = mcode rp in
 755       let body = statement arity body in
 756       make_rule_elem stm tgt arity (Ast0.Iterator(nm,lp,args,rp,body,aft))
 757   | Ast0.Switch(switch,lp,exp,rp,lb,cases,rb) ->
 758       let arity =
 759         stm_same (mcode2line switch)
 760           (List.map mcode2arity [switch;lp;rp;lb;rb]) in
 761       let switch = mcode switch in
 762       let lp = mcode lp in
 763       let exp = expression arity exp in
 764       let rp = mcode rp in
 765       let lb = mcode lb in
 766       let cases = dots (case_line arity) cases in
 767       let rb = mcode rb in
 768       make_rule_elem stm tgt arity
 769         (Ast0.Switch(switch,lp,exp,rp,lb,cases,rb))
 770   | Ast0.Break(br,sem) ->
 771       let arity = stm_same (mcode2line br) (List.map mcode2arity [br;sem]) in
 772       let br = mcode br in
 773       let sem = mcode sem in
 774       make_rule_elem stm tgt arity (Ast0.Break(br,sem))
 775   | Ast0.Continue(cont,sem) ->
 776       let arity =
 777         stm_same (mcode2line cont) (List.map mcode2arity [cont;sem]) in
 778       let cont = mcode cont in
 779       let sem = mcode sem in
 780       make_rule_elem stm tgt arity (Ast0.Continue(cont,sem))
 781   | Ast0.Label(l,dd) ->
 782       let arity = mcode2arity dd in
 783       let l = ident false tgt l in
 784       let dd = mcode dd in
 785       make_rule_elem stm tgt arity (Ast0.Label(l,dd))
 786   | Ast0.Goto(goto,l,sem) ->
 787       let arity =
 788         stm_same (mcode2line goto) (List.map mcode2arity [goto;sem]) in
 789       let goto = mcode goto in
 790       let l = ident false tgt l in
 791       let sem = mcode sem in
 792       make_rule_elem stm tgt arity (Ast0.Goto(goto,l,sem))
 793   | Ast0.Return(ret,sem) ->
 794       let arity = stm_same (mcode2line ret) (List.map mcode2arity [ret;sem]) in
 795       let ret = mcode ret in
 796       let sem = mcode sem in
 797       make_rule_elem stm tgt arity (Ast0.Return(ret,sem))
 798   | Ast0.ReturnExpr(ret,exp,sem) ->
 799       let arity = stm_same (mcode2line ret) (List.map mcode2arity [ret;sem]) in
 800       let ret = mcode ret in
 801       let exp = expression arity exp in
 802       let sem = mcode sem in
 803       make_rule_elem stm tgt arity (Ast0.ReturnExpr(ret,exp,sem))
 804   | Ast0.MetaStmt(name,pure) ->
 805       let arity = stm_same (mcode2line name) [mcode2arity name] in
 806       let name = mcode name in
 807       make_rule_elem stm tgt arity (Ast0.MetaStmt(name,pure))
 808   | Ast0.MetaStmtList(name,pure) ->
 809       let arity = stm_same (mcode2line name) [mcode2arity name] in
 810       let name = mcode name in
 811       make_rule_elem stm tgt arity (Ast0.MetaStmtList(name,pure))
 812   | Ast0.Exp(exp) ->
 813       let new_exp = top_expression true tgt exp in
 814       Ast0.rewrap stm
 815         (match Ast0.unwrap new_exp with
 816           Ast0.OptExp(exp) ->
 817             Ast0.OptStm(Ast0.rewrap stm (Ast0.Exp(exp)))
 818         | Ast0.UniqueExp(exp) ->
 819             Ast0.UniqueStm(Ast0.rewrap stm (Ast0.Exp(exp)))
 820         | _ -> Ast0.Exp(new_exp))
 821   | Ast0.TopExp(exp) ->
 822       let new_exp = top_expression true tgt exp in
 823       Ast0.rewrap stm
 824         (match Ast0.unwrap new_exp with
 825           Ast0.OptExp(exp) ->
 826             Ast0.OptStm(Ast0.rewrap stm (Ast0.TopExp(exp)))
 827         | Ast0.UniqueExp(exp) ->
 828             Ast0.UniqueStm(Ast0.rewrap stm (Ast0.TopExp(exp)))
 829         | _ -> Ast0.TopExp(new_exp))
 830   | Ast0.Ty(ty) ->
 831       let new_ty = typeC tgt ty in (* opt makes no sense alone at top level *)
 832       Ast0.rewrap stm
 833         (match Ast0.unwrap new_ty with
 834           Ast0.OptType(ty) ->
 835             Ast0.OptStm(Ast0.rewrap stm (Ast0.Ty(ty)))
 836         | Ast0.UniqueType(ty) ->
 837             Ast0.UniqueStm(Ast0.rewrap stm (Ast0.Ty(ty)))
 838         | _ -> Ast0.Ty(new_ty))
 839   | Ast0.TopInit(init) ->
 840       let new_init = initialiser tgt init in
 841       Ast0.rewrap stm
 842         (match Ast0.unwrap new_init with
 843           Ast0.OptIni(init) ->
 844             Ast0.OptStm(Ast0.rewrap stm (Ast0.TopInit(init)))
 845         | Ast0.UniqueIni(init) ->
 846             Ast0.UniqueStm(Ast0.rewrap stm (Ast0.TopInit(init)))
 847         | _ -> Ast0.TopInit(new_init))
 848   | Ast0.Disj(starter,rule_elem_dots_list,mids,ender) ->
 849       let stms =
 850         List.map (function x -> concat_dots (statement tgt) x)
 851           rule_elem_dots_list in
 852       let (found_opt,unopt) =
 853         List.fold_left
 854           (function (found_opt,lines) ->
 855             function x ->
 856               let rebuild l =
 857                 (* previously just checked the last thing in the list,
 858                    but everything should be optional for the whole thing to
 859                    be optional *)
 860                 let is_opt x =
 861                   match Ast0.unwrap x with
 862                     Ast0.OptStm(x) -> true
 863                   | _ -> false in
 864                 let unopt x =
 865                   match Ast0.unwrap x with
 866                     Ast0.OptStm(x) -> x
 867                   | _ -> x in
 868                 if List.for_all is_opt l
 869                 then (true,List.map unopt l)
 870                 else (false, l) in
 871               let (l,k) =
 872                 match Ast0.unwrap x with
 873                   Ast0.DOTS(l) ->
 874                     (l,function l -> Ast0.rewrap x (Ast0.DOTS l))
 875                 | Ast0.CIRCLES(l) ->
 876                     (l,function l -> Ast0.rewrap x (Ast0.CIRCLES l))
 877                 | Ast0.STARS(l) ->
 878                     (l,function l -> Ast0.rewrap x (Ast0.STARS l)) in
 879               let (found_opt,l) = rebuild l in
 880               (found_opt,(k l)::lines))
 881           (false,[]) stms in
 882       let unopt = List.rev unopt in
 883       if found_opt
 884       then
 885         make_rule_elem stm tgt Ast0.OPT (Ast0.Disj(starter,unopt,mids,ender))
 886       else Ast0.rewrap stm (Ast0.Disj(starter,stms,mids,ender))
 887   | Ast0.Nest(starter,rule_elem_dots,ender,whn,multi) ->
 888       let new_rule_elem_dots =
 889         concat_dots (statement Ast0.NONE) rule_elem_dots in
 890       let whn =
 891         List.map
 892           (whencode (concat_dots (statement Ast0.NONE)) (statement Ast0.NONE)
 893              (expression Ast0.NONE))
 894           whn in
 895       Ast0.rewrap stm
 896         (Ast0.Nest(starter,new_rule_elem_dots,ender,whn,multi))
 897   | Ast0.Dots(dots,whn)    ->
 898       let arity = stm_same (mcode2line dots) [mcode2arity dots] in
 899       let dots = mcode dots in
 900       let whn =
 901         List.map
 902           (whencode (concat_dots (statement Ast0.NONE)) (statement Ast0.NONE)
 903              (expression Ast0.NONE))
 904           whn in
 905       make_rule_elem stm tgt arity (Ast0.Dots(dots,whn))
 906   | Ast0.Circles(dots,whn) ->
 907       let arity = stm_same (mcode2line dots) [mcode2arity dots] in
 908       let dots = mcode dots in
 909       let whn =
 910         List.map
 911           (whencode (concat_dots (statement Ast0.NONE)) (statement Ast0.NONE)
 912              (expression Ast0.NONE))
 913           whn in
 914       make_rule_elem stm tgt arity (Ast0.Circles(dots,whn))
 915   | Ast0.Stars(dots,whn)   ->
 916       let arity = stm_same (mcode2line dots) [mcode2arity dots] in
 917       let dots = mcode dots in
 918       let whn =
 919         List.map
 920           (whencode (concat_dots (statement Ast0.NONE)) (statement Ast0.NONE)
 921              (expression Ast0.NONE))
 922           whn in
 923       make_rule_elem stm tgt arity (Ast0.Stars(dots,whn))
 924   | Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace) ->
 925       let arity =
 926         all_same true tgt (mcode2line lp)
 927           ((List.map mcode2arity [lp;rp;lbrace;rbrace]) @ (fninfo2arity fi)) in
 928       let fi = List.map (fninfo arity) fi in
 929       let name = ident false arity name in
 930       let lp = mcode lp in
 931       let params = parameter_list arity params in
 932       let rp = mcode rp in
 933       let lbrace = mcode lbrace in
 934       let body = dots (statement arity) body in
 935       let rbrace = mcode rbrace in
 936       make_rule_elem stm tgt arity
 937         (Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace))
 938   | Ast0.Include(inc,s) ->
 939       let arity =
 940         all_same true tgt (mcode2line inc) [mcode2arity inc; mcode2arity s] in
 941       let inc = mcode inc in
 942       let s = mcode s in
 943       make_rule_elem stm tgt arity (Ast0.Include(inc,s))
 944   | Ast0.Define(def,id,params,body) ->
 945       let arity = all_same true tgt (mcode2line def) [mcode2arity def] in
 946       let def = mcode def in
 947       let id = ident false arity id in
 948       let params = define_parameters arity params in
 949       let body = dots (statement arity) body in
 950       make_rule_elem stm tgt arity (Ast0.Define(def,id,params,body))
 951   | Ast0.OptStm(_) | Ast0.UniqueStm(_) ->
 952       failwith "unexpected code"
 953
 954 and define_parameters tgt params =
 955   match Ast0.unwrap params with
 956     Ast0.NoParams -> params
 957   | Ast0.DParams(lp,params,rp) ->
 958       let arity =
 959         all_same true tgt (mcode2line lp) [mcode2arity lp;mcode2arity rp] in
 960       let lp = mcode lp in
 961       let params = dots (define_param arity) params in
 962       let rp = mcode rp in
 963       Ast0.rewrap params (Ast0.DParams(lp,params,rp))
 964
 965 and make_define_param x =
 966   make_opt_unique
 967     (function x -> Ast0.OptDParam x)
 968     (function x -> Ast0.UniqueDParam x)
 969     x
 970
 971 and define_param tgt param =
 972   match Ast0.unwrap param with
 973     Ast0.DParam(id) ->
 974       let new_id = ident true tgt id in
 975       Ast0.rewrap param
 976         (match Ast0.unwrap new_id with
 977           Ast0.OptIdent(id) ->
 978             Ast0.OptDParam(Ast0.rewrap param (Ast0.DParam(id)))
 979         | Ast0.UniqueIdent(decl) ->
 980             Ast0.UniqueDParam(Ast0.rewrap param (Ast0.DParam(id)))
 981         | _ -> Ast0.DParam(new_id))
 982   | Ast0.DPComma(cm) ->
 983       let arity =
 984         all_same true tgt (mcode2line cm) [mcode2arity cm] in
 985       let cm = mcode cm in
 986       make_define_param param tgt arity (Ast0.DPComma(cm))
 987   | Ast0.DPdots(dots) ->
 988       let arity =
 989         all_same true tgt (mcode2line dots) [mcode2arity dots] in
 990       let dots = mcode dots in
 991       make_define_param param tgt arity (Ast0.DPdots(dots))
 992   | Ast0.DPcircles(circles) ->
 993       let arity =
 994         all_same true tgt (mcode2line circles) [mcode2arity circles] in
 995       let circles = mcode circles in
 996       make_define_param param tgt arity (Ast0.DPcircles(circles))
 997   | Ast0.OptDParam(dp) | Ast0.UniqueDParam(dp) ->
 998       failwith "unexpected code"
 999
1000 and fninfo arity = function
1001     Ast0.FStorage(stg) -> Ast0.FStorage(mcode stg)
1002   | Ast0.FType(ty) -> Ast0.FType(typeC arity ty)
1003   | Ast0.FInline(inline) -> Ast0.FInline(mcode inline)
1004   | Ast0.FAttr(attr) -> Ast0.FAttr(mcode attr)
1005
1006 and fninfo2arity fninfo =
1007   List.concat
1008     (List.map
1009        (function
1010            Ast0.FStorage(stg) -> [mcode2arity stg]
1011          | Ast0.FType(ty) -> []
1012          | Ast0.FInline(inline) -> [mcode2arity inline]
1013          | Ast0.FAttr(attr) -> [mcode2arity attr])
1014        fninfo)
1015
1016 and whencode notfn alwaysfn expression = function
1017     Ast0.WhenNot a -> Ast0.WhenNot (notfn a)
1018   | Ast0.WhenAlways a -> Ast0.WhenAlways (alwaysfn a)
1019   | Ast0.WhenModifier(x) -> Ast0.WhenModifier(x)
1020   | Ast0.WhenNotTrue a -> Ast0.WhenNotTrue (expression a)
1021   | Ast0.WhenNotFalse a -> Ast0.WhenNotFalse (expression a)
1022
1023 and make_case_line =
1024   make_opt_unique
1025     (function x -> Ast0.OptCase x)
1026     (function x -> failwith "unique not allowed for case_line")
1027
1028 and case_line tgt c =
1029   match Ast0.unwrap c with
1030     Ast0.Default(def,colon,code) ->
1031       let arity =
1032         all_same true tgt (mcode2line def)
1033           [mcode2arity def; mcode2arity colon] in
1034       let def = mcode def in
1035       let colon = mcode colon in
1036       let code = dots (statement arity) code in
1037       make_case_line c tgt arity (Ast0.Default(def,colon,code))
1038   | Ast0.Case(case,exp,colon,code) ->
1039       let arity =
1040         all_same true tgt (mcode2line case)
1041           [mcode2arity case; mcode2arity colon] in
1042       let case = mcode case in
1043       let exp = expression arity exp in
1044       let colon = mcode colon in
1045       let code = dots (statement arity) code in
1046       make_case_line c tgt arity (Ast0.Case(case,exp,colon,code))
1047   | Ast0.OptCase(_) -> failwith "unexpected OptCase"
1048
1049 (* --------------------------------------------------------------------- *)
1050 (* Function declaration *)
1051 (* Haven't thought much about arity here... *)
1052
1053 let top_level tgt t =
1054   Ast0.rewrap t
1055     (match Ast0.unwrap t with
1056       Ast0.FILEINFO(old_file,new_file) ->
1057         if mcode2arity old_file = Ast0.NONE && mcode2arity new_file = Ast0.NONE
1058         then Ast0.FILEINFO(mcode old_file,mcode new_file)
1059         else fail t "unexpected arity for file info"
1060     | Ast0.DECL(stmt) ->
1061         Ast0.DECL(statement tgt stmt)
1062     | Ast0.CODE(rule_elem_dots) ->
1063         Ast0.CODE(concat_dots (statement tgt) rule_elem_dots)
1064     | Ast0.ERRORWORDS(exps) ->
1065         Ast0.ERRORWORDS(List.map (top_expression false Ast0.NONE) exps)
1066     | Ast0.OTHER(_) -> fail t "eliminated by top_level")
1067
1068 let rule tgt = List.map (top_level tgt)
1069
1070 (* --------------------------------------------------------------------- *)
1071 (* Entry points *)
1072
1073 let minus_arity code =
1074   rule Ast0.NONE code