parsing_cocci/arity.ml

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