2 * Copyright 2012, INRIA
3 * Julia Lawall, Gilles Muller
4 * Copyright 2010-2011, INRIA, University of Copenhagen
5 * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
6 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
7 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
8 * This file is part of Coccinelle.
10 * Coccinelle is free software: you can redistribute it and/or modify
11 * it under the terms of the GNU General Public License as published by
12 * the Free Software Foundation, according to version 2 of the License.
14 * Coccinelle is distributed in the hope that it will be useful,
15 * but WITHOUT ANY WARRANTY; without even the implied warranty of
16 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 * GNU General Public License for more details.
19 * You should have received a copy of the GNU General Public License
20 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
22 * The authors reserve the right to distribute this or future versions of
23 * Coccinelle under other licenses.
28 (* Arities matter for the minus slice, but not for the plus slice. *)
30 (* ? only allowed on rule_elems, and on subterms if the context is ? also. *)
32 module Ast0
= Ast0_cocci
33 module Ast
= Ast_cocci
35 (* --------------------------------------------------------------------- *)
37 let warning s
= Printf.printf
"warning: %s\n" s
41 (Printf.sprintf
"cocci line %d: %s"
42 ((Ast0.get_info w
).Ast0.pos_info
.Ast0.line_start
)
45 let make_opt_unique optfn uniquefn info tgt arity term
=
46 let term = Ast0.rewrap info
term in
49 else (* tgt must be NONE *)
51 Ast0.OPT
-> Ast0.copywrap info
(optfn
term)
52 | Ast0.UNIQUE
-> Ast0.copywrap info
(uniquefn
term)
53 | Ast0.NONE
-> failwith
"tgt must be NONE"
55 let all_same opt_allowed tgt line arities
=
59 (match List.hd arities
with
60 Ast0.OPT
when not opt_allowed
->
61 failwith
"opt only allowed for the elements of a statement list"
64 if not
(List.for_all
(function x
-> x
= tgt) arities
)
65 then warning (Printf.sprintf
"incompatible arity found on line %d" line
);
68 let get_option fn
= function
70 | Some x
-> Some
(fn x
)
72 let anyopt l fn
= List.exists
(function w
-> fn
(Ast0.unwrap w
)) l
75 let rec loop = function
78 match fn
(Ast0.unwrap x
) with
79 Some x
-> x
:: (loop xs
)
82 if List.length
res = List.length l
then Some
res else None
84 (* --------------------------------------------------------------------- *)
85 (* --------------------------------------------------------------------- *)
88 let mcode2line (_
,_
,info
,_
,_
,_
) = info
.Ast0.pos_info
.Ast0.line_start
89 let mcode2arity (_
,arity
,_
,_
,_
,_
) = arity
91 let mcode x
= x
(* nothing to do ... *)
93 (* --------------------------------------------------------------------- *)
98 (match Ast0.unwrap d
with
99 Ast0.DOTS
(x
) -> Ast0.DOTS
(List.map fn x
)
100 | Ast0.CIRCLES
(x
) -> Ast0.CIRCLES
(List.map fn x
)
101 | Ast0.STARS
(x
) -> Ast0.STARS
(List.map fn x
))
107 match Ast0.unwrap x
with
108 Ast0.Circles
(_
,_
) | Ast0.Stars
(_
,_
) -> true
115 match Ast0.unwrap x
with
116 Ast0.Dots
(_
,_
) | Ast0.Stars
(_
,_
) -> true
123 match Ast0.unwrap x
with
124 Ast0.Dots
(_
,_
) | Ast0.Circles
(_
,_
) -> true
128 let concat_dots fn d
=
130 (match Ast0.unwrap d
with
132 let l = List.map fn x
in
135 else fail d
"inconsistent dots usage"
137 let l = List.map fn x
in
140 else fail d
"inconsistent dots usage"
142 let l = List.map fn x
in
145 else fail d
"inconsistent dots usage")
147 let flat_concat_dots fn d
=
148 match Ast0.unwrap d
with
149 Ast0.DOTS
(x
) -> List.map fn x
150 | Ast0.CIRCLES
(x
) -> List.map fn x
151 | Ast0.STARS
(x
) -> List.map fn x
153 (* --------------------------------------------------------------------- *)
158 (function x
-> Ast0.OptIdent x
)
159 (function x
-> Ast0.UniqueIdent x
)
161 let rec ident opt_allowed
tgt i
=
162 match Ast0.unwrap i
with
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.Id
(name))
169 | Ast0.MetaId
(name,constraints
,seed
,pure
) ->
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.MetaId
(name,constraints
,seed
,pure
))
175 | Ast0.MetaFunc
(name,constraints
,pure
) ->
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.MetaFunc
(name,constraints
,pure
))
181 | Ast0.MetaLocalFunc
(name,constraints
,pure
) ->
183 all_same opt_allowed
tgt (mcode2line name)
184 [mcode2arity name] in
185 let name = mcode name in
186 make_id i
tgt arity (Ast0.MetaLocalFunc
(name,constraints
,pure
))
187 | Ast0.DisjId
(starter
,id_list
,mids
,ender
) ->
188 let id_list = List.map
(ident opt_allowed
tgt) id_list in
189 (match List.rev
id_list with
191 if anyopt xs
(function Ast0.OptIdent
(_
) -> true | _
-> false)
192 then fail i
"opt only allowed in the last disjunct"
194 Ast0.rewrap i
(Ast0.DisjId
(starter
,id_list,mids
,ender
))
195 | Ast0.OptIdent
(_
) | Ast0.UniqueIdent
(_
) | Ast0.AsIdent _
->
196 failwith
"unexpected code"
198 (* --------------------------------------------------------------------- *)
203 (function x
-> Ast0.OptExp x
)
204 (function x
-> Ast0.UniqueExp x
)
206 let rec top_expression opt_allowed
tgt expr
=
207 let exp_same = all_same opt_allowed
tgt in
208 match Ast0.unwrap expr
with
210 let new_id = ident opt_allowed
tgt id
in
212 (match Ast0.unwrap
new_id with
214 Ast0.OptExp
(Ast0.rewrap expr
(Ast0.Ident
(id
)))
215 | Ast0.UniqueIdent
(id
) ->
216 Ast0.UniqueExp
(Ast0.rewrap expr
(Ast0.Ident
(id
)))
217 | _
-> Ast0.Ident
(new_id))
218 | Ast0.Constant
(const
) ->
219 let arity = exp_same (mcode2line const
) [mcode2arity const
] in
220 let const = mcode const in
221 make_exp expr
tgt arity (Ast0.Constant
(const))
222 | Ast0.FunCall
(fn
,lp
,args
,rp
) ->
223 let arity = exp_same (mcode2line lp
) [mcode2arity lp
;mcode2arity rp
] in
224 let fn = expression
arity fn in
226 let args = dots (expression
arity) args in
228 make_exp expr
tgt arity (Ast0.FunCall
(fn,lp,args,rp))
229 | Ast0.Assignment
(left
,op
,right
,simple
) ->
230 let arity = exp_same (mcode2line op
) [mcode2arity op
] in
231 let left = expression
arity left in
233 let right = expression
arity right in
234 make_exp expr
tgt arity (Ast0.Assignment
(left,op,right,simple
))
235 | Ast0.Sequence
(left,op,right) ->
236 let arity = exp_same (mcode2line op) [mcode2arity op] in
237 let left = expression
arity left in
239 let right = expression
arity right in
240 make_exp expr
tgt arity (Ast0.Sequence
(left,op,right))
241 | Ast0.CondExpr
(exp1
,why
,exp2
,colon
,exp3
) ->
243 exp_same (mcode2line why
) [mcode2arity why
; mcode2arity colon
] in
244 let exp1 = expression
arity exp1 in
245 let why = mcode why in
246 let exp2 = get_option (expression
arity) exp2 in
247 let colon = mcode colon in
248 let exp3 = expression
arity exp3 in
249 make_exp expr
tgt arity (Ast0.CondExpr
(exp1,why,exp2,colon,exp3))
250 | Ast0.Postfix
(exp
,op) ->
251 let arity = exp_same (mcode2line op) [mcode2arity op] in
252 let exp = expression
arity exp in
254 make_exp expr
tgt arity (Ast0.Postfix
(exp,op))
255 | Ast0.Infix
(exp,op) ->
256 let arity = exp_same (mcode2line op) [mcode2arity op] in
257 let exp = expression
arity exp in
259 make_exp expr
tgt arity (Ast0.Infix
(exp,op))
260 | Ast0.Unary
(exp,op) ->
261 let arity = exp_same (mcode2line op) [mcode2arity op] in
262 let exp = expression
arity exp in
264 make_exp expr
tgt arity (Ast0.Unary
(exp,op))
265 | Ast0.Binary
(left,op,right) ->
266 let arity = exp_same (mcode2line op) [mcode2arity op] in
267 let left = expression
arity left in
269 let right = expression
arity right in
270 make_exp expr
tgt arity (Ast0.Binary
(left,op,right))
271 | Ast0.Nested
(left,op,right) -> failwith
"nested in arity not possible"
272 | Ast0.Paren
(lp,exp,rp) ->
273 let arity = exp_same (mcode2line lp) [mcode2arity lp;mcode2arity rp] in
275 let exp = expression
arity exp in
277 make_exp expr
tgt arity (Ast0.Paren
(lp,exp,rp))
278 | Ast0.ArrayAccess
(exp1,lb
,exp2,rb
) ->
279 let arity = exp_same (mcode2line lb
) [mcode2arity lb
; mcode2arity rb
] in
280 let exp1 = expression
arity exp1 in
282 let exp2 = expression
arity exp2 in
284 make_exp expr
tgt arity (Ast0.ArrayAccess
(exp1,lb,exp2,rb))
285 | Ast0.RecordAccess
(exp,pt
,field
) ->
286 let arity = exp_same (mcode2line pt
) [mcode2arity pt
] in
287 let exp = expression
arity exp in
289 let field = ident false arity field in
290 make_exp expr
tgt arity (Ast0.RecordAccess
(exp,pt,field))
291 | Ast0.RecordPtAccess
(exp,ar
,field) ->
292 let arity = exp_same (mcode2line ar
) [mcode2arity ar
] in
293 let exp = expression
arity exp in
295 let field = ident false arity field in
296 make_exp expr
tgt arity (Ast0.RecordPtAccess
(exp,ar,field))
297 | Ast0.Cast
(lp,ty
,rp,exp) ->
298 let arity = exp_same (mcode2line lp) [mcode2arity lp;mcode2arity rp] in
300 let ty = typeC
arity ty in
302 let exp = expression
arity exp in
303 make_exp expr
tgt arity (Ast0.Cast
(lp,ty,rp,exp))
304 | Ast0.SizeOfExpr
(szf
,exp) ->
305 let arity = exp_same (mcode2line szf
) [mcode2arity szf
] in
306 let szf = mcode szf in
307 let exp = expression
arity exp in
308 make_exp expr
tgt arity (Ast0.SizeOfExpr
(szf,exp))
309 | Ast0.SizeOfType
(szf,lp,ty,rp) ->
311 exp_same (mcode2line szf) (List.map
mcode2arity [szf;lp;rp]) in
312 let szf = mcode szf in
314 let ty = typeC
arity ty in
316 make_exp expr
tgt arity (Ast0.SizeOfType
(szf,lp,ty,rp))
317 | Ast0.TypeExp
(ty) -> Ast0.rewrap expr
(Ast0.TypeExp
(typeC
tgt ty))
318 | Ast0.MetaErr
(name,constraints
,pure
) ->
319 let arity = exp_same (mcode2line name) [mcode2arity name] in
320 let name = mcode name in
321 make_exp expr
tgt arity (Ast0.MetaErr
(name,constraints
,pure
))
322 | Ast0.MetaExpr
(name,constraints
,ty,form
,pure
) ->
323 let arity = exp_same (mcode2line name) [mcode2arity name] in
324 let name = mcode name in
325 make_exp expr
tgt arity (Ast0.MetaExpr
(name,constraints
,ty,form
,pure
))
326 | Ast0.MetaExprList
(name,lenname
,pure
) ->
327 let arity = exp_same (mcode2line name) [mcode2arity name] in
328 let name = mcode name in
329 make_exp expr
tgt arity (Ast0.MetaExprList
(name,lenname
,pure
))
331 let arity = exp_same (mcode2line cm
) [mcode2arity cm
] in
333 make_exp expr
tgt arity (Ast0.EComma
(cm))
334 | Ast0.DisjExpr
(starter
,exps
,mids
,ender
) ->
335 let exps = List.map
(top_expression opt_allowed
tgt) exps in
336 (match List.rev
exps with
338 if anyopt xs
(function Ast0.OptExp
(_
) -> true | _
-> false)
339 then fail expr
"opt only allowed in the last disjunct"
341 Ast0.rewrap expr
(Ast0.DisjExpr
(starter
,exps,mids
,ender
))
342 | Ast0.NestExpr
(starter
,exp_dots
,ender
,whencode
,multi
) ->
344 Ast0.NestExpr
(starter
,
345 dots (top_expression true Ast0.NONE
) exp_dots
,
346 ender
,whencode
,multi
) in
348 | Ast0.Edots
(dots,whencode
) ->
349 let arity = exp_same (mcode2line dots) [mcode2arity dots] in
350 let dots = mcode dots in
351 let whencode = get_option (expression
Ast0.NONE
) whencode in
352 make_exp expr
tgt arity (Ast0.Edots
(dots,whencode))
353 | Ast0.Ecircles
(dots,whencode) ->
354 let arity = exp_same (mcode2line dots) [mcode2arity dots] in
355 let dots = mcode dots in
356 let whencode = get_option (expression
Ast0.NONE
) whencode in
357 make_exp expr
tgt arity (Ast0.Ecircles
(dots,whencode))
358 | Ast0.Estars
(dots,whencode) ->
359 let arity = exp_same (mcode2line dots) [mcode2arity dots] in
360 let dots = mcode dots in
361 let whencode = get_option (expression
Ast0.NONE
) whencode in
362 make_exp expr
tgt arity (Ast0.Estars
(dots,whencode))
363 | Ast0.Constructor
(lp,ty,rp,init
) ->
364 let arity = exp_same (mcode2line lp) [mcode2arity lp;mcode2arity rp] in
366 let ty = typeC
arity ty in
368 let init = initialiser
arity init in
369 make_exp expr
tgt arity (Ast0.Constructor
(lp,ty,rp,init))
370 (* why does optexp exist???? *)
371 | Ast0.OptExp
(_
) | Ast0.UniqueExp
(_
) | Ast0.AsExpr _
->
372 failwith
"unexpected code"
374 and expression
tgt exp = top_expression false tgt exp
376 (* --------------------------------------------------------------------- *)
381 (function x
-> Ast0.OptType x
)
382 (function x
-> Ast0.UniqueType x
)
384 and top_typeC
tgt opt_allowed typ
=
385 match Ast0.unwrap typ
with
386 Ast0.ConstVol
(cv
,ty) ->
387 let arity = all_same opt_allowed
tgt (mcode2line cv
)
390 let ty = typeC
arity ty in
391 make_typeC typ
tgt arity (Ast0.ConstVol
(cv,ty))
392 | Ast0.BaseType
(ty,strings
) ->
394 all_same opt_allowed
tgt (mcode2line (List.hd strings
))
395 (List.map
mcode2arity strings
) in
396 let strings = List.map
mcode strings in
397 make_typeC typ
tgt arity (Ast0.BaseType
(ty,strings))
398 | Ast0.Signed
(sign
,ty) ->
400 all_same opt_allowed
tgt (mcode2line sign
) [mcode2arity sign
] in
401 let sign = mcode sign in
402 let ty = get_option (typeC
arity) ty in
403 make_typeC typ
tgt arity (Ast0.Signed
(sign,ty))
404 | Ast0.Pointer
(ty,star
) ->
406 all_same opt_allowed
tgt (mcode2line star
) [mcode2arity star
] in
407 let ty = typeC
arity ty in
408 let star = mcode star in
409 make_typeC typ
tgt arity (Ast0.Pointer
(ty,star))
410 | Ast0.FunctionPointer
(ty,lp1
,star,rp1
,lp2
,params
,rp2
) ->
412 all_same opt_allowed
tgt (mcode2line lp1
)
413 (List.map
mcode2arity [lp1
;star;rp1
;lp2
;rp2
]) in
414 let ty = typeC
arity ty in
415 let params = parameter_list
tgt params in
416 make_typeC typ
tgt arity
417 (Ast0.FunctionPointer
(ty,lp1
,star,rp1
,lp2
,params,rp2
))
418 | Ast0.FunctionType
(ty,lp1
,params,rp1
) ->
420 all_same opt_allowed
tgt (mcode2line lp1
)
421 (List.map
mcode2arity [lp1
;rp1
]) in
422 let ty = get_option (typeC
arity) ty in
423 let params = parameter_list
tgt params in
424 make_typeC typ
tgt arity (Ast0.FunctionType
(ty,lp1
,params,rp1
))
425 | Ast0.Array
(ty,lb,size
,rb) ->
427 all_same opt_allowed
tgt (mcode2line lb)
428 [mcode2arity lb;mcode2arity rb] in
429 let ty = typeC
arity ty in
431 let size = get_option (expression
arity) size in
433 make_typeC typ
tgt arity (Ast0.Array
(ty,lb,size,rb))
434 | Ast0.EnumName
(kind
,name) ->
436 all_same opt_allowed
tgt (mcode2line kind
) [mcode2arity kind
] in
437 let kind = mcode kind in
438 let name = get_option (ident false arity) name in
439 make_typeC typ
tgt arity (Ast0.EnumName
(kind,name))
440 | Ast0.EnumDef
(ty,lb,decls
,rb) ->
442 all_same opt_allowed
tgt (mcode2line lb)
443 (List.map
mcode2arity [lb;rb]) in
444 let ty = typeC
arity ty in
446 let ids = dots (expression
tgt) decls
in
448 make_typeC typ
tgt arity (Ast0.EnumDef
(ty,lb,ids,rb))
449 | Ast0.StructUnionName
(kind,name) ->
451 all_same opt_allowed
tgt (mcode2line kind)
452 [mcode2arity kind] in
453 let kind = mcode kind in
454 let name = get_option (ident false arity) name in
455 make_typeC typ
tgt arity (Ast0.StructUnionName
(kind,name))
456 | Ast0.StructUnionDef
(ty,lb,decls
,rb) ->
458 all_same opt_allowed
tgt (mcode2line lb)
459 (List.map
mcode2arity [lb;rb]) in
460 let ty = typeC
arity ty in
462 let decls = dots (declaration
tgt) decls in
464 make_typeC typ
tgt arity (Ast0.StructUnionDef
(ty,lb,decls,rb))
465 | Ast0.TypeName
(name) ->
467 all_same opt_allowed
tgt (mcode2line name) [mcode2arity name] in
468 let name = mcode name in
469 make_typeC typ
tgt arity (Ast0.TypeName
(name))
470 | Ast0.MetaType
(name,pure
) ->
472 all_same opt_allowed
tgt (mcode2line name) [mcode2arity name] in
473 let name = mcode name in
474 make_typeC typ
tgt arity (Ast0.MetaType
(name,pure
))
475 | Ast0.DisjType
(starter
,types
,mids
,ender
) ->
476 let types = List.map
(typeC
tgt) types in
477 (match List.rev
types with
479 if anyopt xs
(function Ast0.OptType
(_
) -> true | _
-> false)
480 then fail typ
"opt only allowed in the last disjunct"
482 let res = Ast0.DisjType
(starter
,types,mids
,ender
) in
484 | Ast0.OptType
(_
) | Ast0.UniqueType
(_
) | Ast0.AsType _
->
485 failwith
"unexpected code"
487 and typeC
tgt ty = top_typeC
tgt false ty
489 (* --------------------------------------------------------------------- *)
490 (* Variable declaration *)
491 (* Even if the Cocci program specifies a list of declarations, they are
492 split out into multiple declarations of a single variable each. *)
496 (function x
-> Ast0.OptDecl x
)
497 (function x
-> Ast0.UniqueDecl x
)
499 and declaration
tgt decl
=
500 match Ast0.unwrap decl
with
501 Ast0.MetaDecl
(name,pure
) ->
502 let arity = all_same true tgt (mcode2line name) [mcode2arity name] in
503 let name = mcode name in
504 make_decl decl
tgt arity (Ast0.MetaDecl
(name,pure
))
505 | Ast0.MetaField
(name,pure
) ->
506 let arity = all_same true tgt (mcode2line name) [mcode2arity name] in
507 let name = mcode name in
508 make_decl decl
tgt arity (Ast0.MetaField
(name,pure
))
509 | Ast0.MetaFieldList
(name,lenname
,pure
) ->
510 let arity = all_same true tgt (mcode2line name) [mcode2arity name] in
511 let name = mcode name in
512 make_decl decl
tgt arity (Ast0.MetaFieldList
(name,lenname
,pure
))
513 | Ast0.Init
(stg
,ty,id
,eq
,exp,sem
) ->
515 all_same true tgt (mcode2line eq
)
516 ((match stg
with None
-> [] | Some x
-> [mcode2arity x
]) @
517 (List.map
mcode2arity [eq
;sem
])) in
518 let stg = get_option mcode stg in
519 let ty = typeC
arity ty in
520 let id = ident false arity id in
522 let exp = initialiser
arity exp in
523 let sem = mcode sem in
524 make_decl decl
tgt arity (Ast0.Init
(stg,ty,id,eq,exp,sem))
525 | Ast0.UnInit
(stg,ty,id,sem) ->
527 all_same true tgt (mcode2line sem)
528 ((match stg with None
-> [] | Some x
-> [mcode2arity x
]) @
529 [mcode2arity sem]) in
530 let stg = get_option mcode stg in
531 let ty = typeC
arity ty in
532 let id = ident false arity id in
533 let sem = mcode sem in
534 make_decl decl
tgt arity (Ast0.UnInit
(stg,ty,id,sem))
535 | Ast0.MacroDecl
(name,lp,args,rp,sem) ->
537 all_same true tgt (mcode2line lp)
538 (List.map
mcode2arity [lp;rp;sem]) in
539 let name = ident false arity name in
541 let args = dots (expression
arity) args in
543 let sem = mcode sem in
544 make_decl decl
tgt arity (Ast0.MacroDecl
(name,lp,args,rp,sem))
545 | Ast0.MacroDeclInit
(name,lp,args,rp,eq,ini
,sem) ->
547 all_same true tgt (mcode2line lp)
548 (List.map
mcode2arity [lp;rp;eq;sem]) in
549 let name = ident false arity name in
551 let args = dots (expression
arity) args in
553 let ini = initialiser
arity ini in
554 let sem = mcode sem in
555 make_decl decl
tgt arity
556 (Ast0.MacroDeclInit
(name,lp,args,rp,eq,ini,sem))
557 | Ast0.TyDecl
(ty,sem) ->
559 all_same true tgt (mcode2line sem) [mcode2arity sem] in
560 let ty = typeC
arity ty in
561 let sem = mcode sem in
562 make_decl decl
tgt arity (Ast0.TyDecl
(ty,sem))
563 | Ast0.Typedef
(stg,ty,id,sem) ->
565 all_same true tgt (mcode2line sem)
566 [mcode2arity stg;mcode2arity sem] in
567 let stg = mcode stg in
568 let ty = typeC
arity ty in
569 let id = typeC
arity id in
570 let sem = mcode sem in
571 make_decl decl
tgt arity (Ast0.Typedef
(stg,ty,id,sem))
572 | Ast0.DisjDecl
(starter
,decls,mids
,ender
) ->
573 let decls = List.map
(declaration
tgt) decls in
574 (match List.rev
decls with
576 if anyopt xs
(function Ast0.OptDecl
(_
) -> true | _
-> false)
577 then fail decl
"opt only allowed in the last disjunct"
579 let res = Ast0.DisjDecl
(starter
,decls,mids
,ender
) in
581 | Ast0.Ddots
(dots,whencode) ->
582 let arity = all_same true tgt (mcode2line dots) [mcode2arity dots] in
583 let dots = mcode dots in
584 let whencode = get_option (declaration
Ast0.NONE
) whencode in
585 make_decl decl
tgt arity (Ast0.Ddots
(dots,whencode))
586 | Ast0.OptDecl
(_
) | Ast0.UniqueDecl
(_
) | Ast0.AsDecl _
->
587 failwith
"unexpected code"
589 (* --------------------------------------------------------------------- *)
594 (function x
-> Ast0.OptIni x
)
595 (function x
-> Ast0.UniqueIni x
)
597 and initialiser
tgt i
=
598 let init_same = all_same true tgt in
599 match Ast0.unwrap i
with
600 Ast0.MetaInit
(name,pure
) ->
601 let arity = init_same (mcode2line name) [mcode2arity name] in
602 let name = mcode name in
603 make_init i
tgt arity (Ast0.MetaInit
(name,pure
))
604 | Ast0.MetaInitList
(name,lenname
,pure
) ->
605 let arity = init_same (mcode2line name) [mcode2arity name] in
606 let name = mcode name in
607 make_init i
tgt arity (Ast0.MetaInitList
(name,lenname
,pure
))
608 | Ast0.InitExpr
(exp) ->
609 Ast0.rewrap i
(Ast0.InitExpr
(expression
tgt exp))
610 | Ast0.InitList
(lb,initlist
,rb,ordered
) ->
611 let arity = init_same (mcode2line lb) [mcode2arity lb; mcode2arity rb] in
613 let initlist = dots (initialiser
arity) initlist in
615 make_init i
tgt arity (Ast0.InitList
(lb,initlist,rb,ordered
))
616 | Ast0.InitGccExt
(designators
,eq,ini) ->
617 let arity = init_same (mcode2line eq) [mcode2arity eq] in
618 let designators = List.map
(designator
arity) designators in
620 let ini = initialiser
arity ini in
621 make_init i
tgt arity (Ast0.InitGccExt
(designators,eq,ini))
622 | Ast0.InitGccName
(name,eq,ini) ->
623 let arity = init_same (mcode2line eq) [mcode2arity eq] in
624 let name = ident true arity name in
626 let ini = initialiser
arity ini in
627 make_init i
tgt arity (Ast0.InitGccName
(name,eq,ini))
629 let arity = init_same (mcode2line cm) [mcode2arity cm] in
631 make_init i
tgt arity (Ast0.IComma
(cm))
632 | Ast0.Idots
(dots,whencode) ->
633 let arity = init_same (mcode2line dots) [mcode2arity dots] in
634 let dots = mcode dots in
635 let whencode = get_option (initialiser
Ast0.NONE
) whencode in
636 make_init i
tgt arity (Ast0.Idots
(dots,whencode))
637 | Ast0.OptIni
(_
) | Ast0.UniqueIni
(_
) | Ast0.AsInit _
->
638 failwith
"unexpected code"
640 and designator
tgt d
=
641 let dsame = all_same false tgt in
643 Ast0.DesignatorField
(dot
,id) ->
644 let arity = dsame (mcode2line dot
) [mcode2arity dot
] in
645 let dot = mcode dot in
646 let id = ident false arity id in
647 Ast0.DesignatorField
(dot,id)
648 | Ast0.DesignatorIndex
(lb,exp,rb) ->
649 let arity = dsame (mcode2line lb) [mcode2arity lb;mcode2arity rb] in
651 let exp = top_expression false arity exp in
653 Ast0.DesignatorIndex
(lb,exp,rb)
654 | Ast0.DesignatorRange
(lb,min
,dots,max
,rb) ->
656 dsame (mcode2line lb)
657 [mcode2arity lb;mcode2arity dots;mcode2arity rb] in
659 let min = top_expression false arity min in
660 let dots = mcode dots in
661 let max = top_expression false arity max in
663 Ast0.DesignatorRange
(lb,min,dots,max,rb)
665 (* --------------------------------------------------------------------- *)
670 (function x
-> Ast0.OptParam x
)
671 (function x
-> Ast0.UniqueParam x
)
673 and parameterTypeDef
tgt param
=
674 let param_same = all_same true tgt in
675 match Ast0.unwrap param
with
676 Ast0.VoidParam
(ty) -> Ast0.rewrap param
(Ast0.VoidParam
(typeC
tgt ty))
677 | Ast0.Param
(ty,Some
id) ->
678 let ty = top_typeC
tgt true ty in
679 let id = ident true tgt id in
681 (match (Ast0.unwrap
ty,Ast0.unwrap
id) with
682 (Ast0.OptType
(ty),Ast0.OptIdent
(id)) ->
683 Ast0.OptParam
(Ast0.rewrap param
(Ast0.Param
(ty,Some
id)))
684 | (Ast0.UniqueType
(ty),Ast0.UniqueIdent
(id)) ->
685 Ast0.UniqueParam
(Ast0.rewrap param
(Ast0.Param
(ty,Some
id)))
686 | (Ast0.OptType
(ty),_
) ->
687 fail param
"arity mismatch in param declaration"
688 | (_
,Ast0.OptIdent
(id)) ->
689 fail param
"arity mismatch in param declaration"
690 | _
-> Ast0.Param
(ty,Some
id))
691 | Ast0.Param
(ty,None
) ->
692 let ty = top_typeC
tgt true ty in
694 (match Ast0.unwrap
ty with
696 Ast0.OptParam
(Ast0.rewrap param
(Ast0.Param
(ty,None
)))
697 | Ast0.UniqueType
(ty) ->
698 Ast0.UniqueParam
(Ast0.rewrap param
(Ast0.Param
(ty,None
)))
699 | _
-> Ast0.Param
(ty,None
))
700 | Ast0.MetaParam
(name,pure
) ->
701 let arity = param_same (mcode2line name) [mcode2arity name] in
702 let name = mcode name in
703 make_param param
tgt arity (Ast0.MetaParam
(name,pure
))
704 | Ast0.MetaParamList
(name,lenname
,pure
) ->
705 let arity = param_same (mcode2line name) [mcode2arity name] in
706 let name = mcode name in
707 make_param param
tgt arity (Ast0.MetaParamList
(name,lenname
,pure
))
709 let arity = param_same (mcode2line cm) [mcode2arity cm] in
711 make_param param
tgt arity (Ast0.PComma
(cm))
712 | Ast0.Pdots
(dots) ->
713 let arity = param_same (mcode2line dots) [mcode2arity dots] in
714 let dots = mcode dots in
715 make_param param
tgt arity (Ast0.Pdots
(dots))
716 | Ast0.Pcircles
(dots) ->
717 let arity = param_same (mcode2line dots) [mcode2arity dots] in
718 let dots = mcode dots in
719 make_param param
tgt arity (Ast0.Pcircles
(dots))
720 | Ast0.OptParam
(_
) | Ast0.UniqueParam
(_
) ->
721 failwith
"unexpected code"
723 and parameter_list
tgt = dots (parameterTypeDef
tgt)
725 (* --------------------------------------------------------------------- *)
728 and make_rule_elem x
=
730 (function x
-> Ast0.OptStm x
)
731 (function x
-> Ast0.UniqueStm x
)
734 and statement
tgt stm
=
735 let stm_same = all_same true tgt in
736 match Ast0.unwrap stm
with
737 Ast0.Decl
(bef
,decl
) ->
738 let new_decl = declaration
tgt decl
in
740 (match Ast0.unwrap
new_decl with
741 Ast0.OptDecl
(decl
) ->
742 Ast0.OptStm
(Ast0.rewrap stm
(Ast0.Decl
(bef
,decl
)))
743 | Ast0.UniqueDecl
(decl
) ->
744 Ast0.UniqueStm
(Ast0.rewrap stm
(Ast0.Decl
(bef
,decl
)))
745 | _
-> Ast0.Decl
(bef
,new_decl))
746 | Ast0.Seq
(lbrace
,body
,rbrace
) ->
748 stm_same (mcode2line lbrace
)
749 [mcode2arity lbrace
; mcode2arity rbrace
] in
750 let lbrace = mcode lbrace in
751 let body = dots (statement
arity) body in
752 let rbrace = mcode rbrace in
753 make_rule_elem stm
tgt arity (Ast0.Seq
(lbrace,body,rbrace))
754 | Ast0.ExprStatement
(exp,sem) ->
755 let arity = stm_same (mcode2line sem) [mcode2arity sem] in
756 let exp = get_option (expression
arity) exp in
757 let sem = mcode sem in
758 make_rule_elem stm
tgt arity (Ast0.ExprStatement
(exp,sem))
759 | Ast0.IfThen
(iff
,lp,exp,rp,branch
,aft
) ->
761 stm_same (mcode2line iff
) (List.map
mcode2arity [iff
;lp;rp]) in
762 let iff = mcode iff in
764 let exp = expression
arity exp in
766 let branch = statement
arity branch in
767 make_rule_elem stm
tgt arity (Ast0.IfThen
(iff,lp,exp,rp,branch,aft
))
768 | Ast0.IfThenElse
(iff,lp,exp,rp,branch1
,els
,branch2
,aft
) ->
770 stm_same (mcode2line iff) (List.map
mcode2arity [iff;lp;rp;els
]) in
771 let iff = mcode iff in
773 let exp = expression
arity exp in
775 let branch1 = statement
arity branch1 in
776 let els = mcode els in
777 let branch2 = statement
arity branch2 in
778 make_rule_elem stm
tgt arity
779 (Ast0.IfThenElse
(iff,lp,exp,rp,branch1,els,branch2,aft
))
780 | Ast0.While
(wh
,lp,exp,rp,body,aft
) ->
782 stm_same (mcode2line wh
)
783 (List.map
mcode2arity [wh
;lp;rp]) in
786 let exp = expression
arity exp in
788 let body = statement
arity body in
789 make_rule_elem stm
tgt arity (Ast0.While
(wh,lp,exp,rp,body,aft
))
790 | Ast0.Do
(d
,body,wh,lp,exp,rp,sem) ->
792 stm_same (mcode2line wh) (List.map
mcode2arity [d
;wh;lp;rp;sem]) in
794 let body = statement
arity body in
797 let exp = expression
arity exp in
799 let sem = mcode sem in
800 make_rule_elem stm
tgt arity (Ast0.Do
(d,body,wh,lp,exp,rp,sem))
801 | Ast0.For
(fr
,lp,exp1,sem1
,exp2,sem2
,exp3,rp,body,aft
) ->
803 stm_same (mcode2line fr
) (List.map
mcode2arity [fr
;lp;sem1
;sem2
;rp]) in
806 let exp1 = get_option (expression
arity) exp1 in
807 let sem1 = mcode sem1 in
808 let exp2 = get_option (expression
arity) exp2 in
809 let sem2= mcode sem2 in
810 let exp3 = get_option (expression
arity) exp3 in
812 let body = statement
arity body in
813 make_rule_elem stm
tgt arity
814 (Ast0.For
(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,aft
))
815 | Ast0.Iterator
(nm
,lp,args,rp,body,aft
) ->
816 let arity = stm_same (mcode2line lp) (List.map
mcode2arity [lp;rp]) in
817 let nm = ident false arity nm in
819 let args = dots (expression
arity) args in
821 let body = statement
arity body in
822 make_rule_elem stm
tgt arity (Ast0.Iterator
(nm,lp,args,rp,body,aft
))
823 | Ast0.Switch
(switch
,lp,exp,rp,lb,decls,cases
,rb) ->
825 stm_same (mcode2line switch
)
826 (List.map
mcode2arity [switch
;lp;rp;lb;rb]) in
827 let switch = mcode switch in
829 let exp = expression
arity exp in
832 let decls = dots (statement
arity) decls in
833 let cases = dots (case_line
arity) cases in
835 make_rule_elem stm
tgt arity
836 (Ast0.Switch
(switch,lp,exp,rp,lb,decls,cases,rb))
837 | Ast0.Break
(br
,sem) ->
838 let arity = stm_same (mcode2line br
) (List.map
mcode2arity [br
;sem]) in
840 let sem = mcode sem in
841 make_rule_elem stm
tgt arity (Ast0.Break
(br,sem))
842 | Ast0.Continue
(cont
,sem) ->
844 stm_same (mcode2line cont
) (List.map
mcode2arity [cont
;sem]) in
845 let cont = mcode cont in
846 let sem = mcode sem in
847 make_rule_elem stm
tgt arity (Ast0.Continue
(cont,sem))
848 | Ast0.Label
(l,dd
) ->
849 let arity = mcode2arity dd
in
850 let l = ident false tgt l in
852 make_rule_elem stm
tgt arity (Ast0.Label
(l,dd))
853 | Ast0.Goto
(goto
,l,sem) ->
855 stm_same (mcode2line goto
) (List.map
mcode2arity [goto
;sem]) in
856 let goto = mcode goto in
857 let l = ident false arity l in
858 let sem = mcode sem in
859 make_rule_elem stm
tgt arity (Ast0.Goto
(goto,l,sem))
860 | Ast0.Return
(ret
,sem) ->
861 let arity = stm_same (mcode2line ret
) (List.map
mcode2arity [ret
;sem]) in
862 let ret = mcode ret in
863 let sem = mcode sem in
864 make_rule_elem stm
tgt arity (Ast0.Return
(ret,sem))
865 | Ast0.ReturnExpr
(ret,exp,sem) ->
866 let arity = stm_same (mcode2line ret) (List.map
mcode2arity [ret;sem]) in
867 let ret = mcode ret in
868 let exp = expression
arity exp in
869 let sem = mcode sem in
870 make_rule_elem stm
tgt arity (Ast0.ReturnExpr
(ret,exp,sem))
871 | Ast0.MetaStmt
(name,pure
) ->
872 let arity = stm_same (mcode2line name) [mcode2arity name] in
873 let name = mcode name in
874 make_rule_elem stm
tgt arity (Ast0.MetaStmt
(name,pure
))
875 | Ast0.MetaStmtList
(name,pure
) ->
876 let arity = stm_same (mcode2line name) [mcode2arity name] in
877 let name = mcode name in
878 make_rule_elem stm
tgt arity (Ast0.MetaStmtList
(name,pure
))
880 let new_exp = top_expression true tgt exp in
882 (match Ast0.unwrap
new_exp with
884 Ast0.OptStm
(Ast0.rewrap stm
(Ast0.Exp
(exp)))
885 | Ast0.UniqueExp
(exp) ->
886 Ast0.UniqueStm
(Ast0.rewrap stm
(Ast0.Exp
(exp)))
887 | _
-> Ast0.Exp
(new_exp))
888 | Ast0.TopExp
(exp) ->
889 let new_exp = top_expression true tgt exp in
891 (match Ast0.unwrap
new_exp with
893 Ast0.OptStm
(Ast0.rewrap stm
(Ast0.TopExp
(exp)))
894 | Ast0.UniqueExp
(exp) ->
895 Ast0.UniqueStm
(Ast0.rewrap stm
(Ast0.TopExp
(exp)))
896 | _
-> Ast0.TopExp
(new_exp))
898 let new_ty = typeC
tgt ty in (* opt makes no sense alone at top level *)
900 (match Ast0.unwrap
new_ty with
902 Ast0.OptStm
(Ast0.rewrap stm
(Ast0.Ty
(ty)))
903 | Ast0.UniqueType
(ty) ->
904 Ast0.UniqueStm
(Ast0.rewrap stm
(Ast0.Ty
(ty)))
905 | _
-> Ast0.Ty
(new_ty))
906 | Ast0.TopInit
(init) ->
907 let new_init = initialiser
tgt init in
909 (match Ast0.unwrap
new_init with
911 Ast0.OptStm
(Ast0.rewrap stm
(Ast0.TopInit
(init)))
912 | Ast0.UniqueIni
(init) ->
913 Ast0.UniqueStm
(Ast0.rewrap stm
(Ast0.TopInit
(init)))
914 | _
-> Ast0.TopInit
(new_init))
915 | Ast0.Disj
(starter
,rule_elem_dots_list
,mids
,ender
) ->
917 List.map
(function x
-> concat_dots (statement
tgt) x
)
918 rule_elem_dots_list
in
919 let (found_opt
,unopt
) =
921 (function (found_opt
,lines
) ->
924 (* previously just checked the last thing in the list,
925 but everything should be optional for the whole thing to
928 match Ast0.unwrap x
with
929 Ast0.OptStm
(x
) -> true
932 match Ast0.unwrap x
with
935 if List.for_all
is_opt l
936 then (true,List.map
unopt l)
939 match Ast0.unwrap x
with
941 (l,function l -> Ast0.rewrap x
(Ast0.DOTS
l))
943 (l,function l -> Ast0.rewrap x
(Ast0.CIRCLES
l))
945 (l,function l -> Ast0.rewrap x
(Ast0.STARS
l)) in
946 let (found_opt
,l) = rebuild l in
947 (found_opt
,(k
l)::lines
))
949 let unopt = List.rev
unopt in
952 make_rule_elem stm
tgt Ast0.OPT
(Ast0.Disj
(starter
,unopt,mids
,ender
))
953 else Ast0.rewrap stm
(Ast0.Disj
(starter
,stms,mids
,ender
))
954 | Ast0.Nest
(starter
,rule_elem_dots
,ender
,whn
,multi
) ->
955 let new_rule_elem_dots =
956 concat_dots (statement
Ast0.NONE
) rule_elem_dots
in
959 (whencode (concat_dots (statement
Ast0.NONE
)) (statement
Ast0.NONE
)
960 (expression
Ast0.NONE
))
963 (Ast0.Nest
(starter
,new_rule_elem_dots,ender
,whn,multi
))
964 | Ast0.Dots
(dots,whn) ->
965 let arity = stm_same (mcode2line dots) [mcode2arity dots] in
966 let dots = mcode dots in
969 (whencode (concat_dots (statement
Ast0.NONE
)) (statement
Ast0.NONE
)
970 (expression
Ast0.NONE
))
972 make_rule_elem stm
tgt arity (Ast0.Dots
(dots,whn))
973 | Ast0.Circles
(dots,whn) ->
974 let arity = stm_same (mcode2line dots) [mcode2arity dots] in
975 let dots = mcode dots in
978 (whencode (concat_dots (statement
Ast0.NONE
)) (statement
Ast0.NONE
)
979 (expression
Ast0.NONE
))
981 make_rule_elem stm
tgt arity (Ast0.Circles
(dots,whn))
982 | Ast0.Stars
(dots,whn) ->
983 let arity = stm_same (mcode2line dots) [mcode2arity dots] in
984 let dots = mcode dots in
987 (whencode (concat_dots (statement
Ast0.NONE
)) (statement
Ast0.NONE
)
988 (expression
Ast0.NONE
))
990 make_rule_elem stm
tgt arity (Ast0.Stars
(dots,whn))
991 | Ast0.FunDecl
(bef
,fi
,name,lp,params,rp,lbrace,body,rbrace) ->
993 all_same true tgt (mcode2line lp)
994 ((List.map
mcode2arity [lp;rp;lbrace;rbrace]) @ (fninfo2arity fi
)) in
995 let fi = List.map
(fninfo
arity) fi in
996 let name = ident false arity name in
998 let params = parameter_list
arity params in
1000 let lbrace = mcode lbrace in
1001 let body = dots (statement
arity) body in
1002 let rbrace = mcode rbrace in
1003 make_rule_elem stm
tgt arity
1004 (Ast0.FunDecl
(bef
,fi,name,lp,params,rp,lbrace,body,rbrace))
1005 | Ast0.Include
(inc
,s
) ->
1007 all_same true tgt (mcode2line inc
) [mcode2arity inc
; mcode2arity s
] in
1008 let inc = mcode inc in
1010 make_rule_elem stm
tgt arity (Ast0.Include
(inc,s))
1011 | Ast0.Undef
(def
,id) ->
1012 let arity = all_same true tgt (mcode2line def
) [mcode2arity def
] in
1013 let def = mcode def in
1014 let id = ident false arity id in
1015 make_rule_elem stm
tgt arity (Ast0.Undef
(def,id))
1016 | Ast0.Define
(def,id,params,body) ->
1017 let arity = all_same true tgt (mcode2line def) [mcode2arity def] in
1018 let def = mcode def in
1019 let id = ident false arity id in
1020 let params = define_parameters
arity params in
1021 let body = dots (statement
arity) body in
1022 make_rule_elem stm
tgt arity (Ast0.Define
(def,id,params,body))
1023 | Ast0.OptStm
(_
) | Ast0.UniqueStm
(_
) | Ast0.AsStmt _
->
1024 failwith
"unexpected code"
1026 and define_parameters
tgt params =
1027 match Ast0.unwrap
params with
1028 Ast0.NoParams
-> params
1029 | Ast0.DParams
(lp,params,rp) ->
1031 all_same true tgt (mcode2line lp) [mcode2arity lp;mcode2arity rp] in
1032 let lp = mcode lp in
1033 let params = dots (define_param
arity) params in
1034 let rp = mcode rp in
1035 Ast0.rewrap
params (Ast0.DParams
(lp,params,rp))
1037 and make_define_param x
=
1039 (function x
-> Ast0.OptDParam x
)
1040 (function x
-> Ast0.UniqueDParam x
)
1043 and define_param
tgt param
=
1044 match Ast0.unwrap param
with
1046 let new_id = ident true tgt id in
1048 (match Ast0.unwrap
new_id with
1049 Ast0.OptIdent
(id) ->
1050 Ast0.OptDParam
(Ast0.rewrap param
(Ast0.DParam
(id)))
1051 | Ast0.UniqueIdent
(decl
) ->
1052 Ast0.UniqueDParam
(Ast0.rewrap param
(Ast0.DParam
(id)))
1053 | _
-> Ast0.DParam
(new_id))
1054 | Ast0.DPComma
(cm) ->
1056 all_same true tgt (mcode2line cm) [mcode2arity cm] in
1057 let cm = mcode cm in
1058 make_define_param param
tgt arity (Ast0.DPComma
(cm))
1059 | Ast0.DPdots
(dots) ->
1061 all_same true tgt (mcode2line dots) [mcode2arity dots] in
1062 let dots = mcode dots in
1063 make_define_param param
tgt arity (Ast0.DPdots
(dots))
1064 | Ast0.DPcircles
(circles
) ->
1066 all_same true tgt (mcode2line circles
) [mcode2arity circles
] in
1067 let circles = mcode circles in
1068 make_define_param param
tgt arity (Ast0.DPcircles
(circles))
1069 | Ast0.OptDParam
(dp
) | Ast0.UniqueDParam
(dp
) ->
1070 failwith
"unexpected code"
1072 and fninfo
arity = function
1073 Ast0.FStorage
(stg) -> Ast0.FStorage
(mcode stg)
1074 | Ast0.FType
(ty) -> Ast0.FType
(typeC
arity ty)
1075 | Ast0.FInline
(inline
) -> Ast0.FInline
(mcode inline
)
1076 | Ast0.FAttr
(attr
) -> Ast0.FAttr
(mcode attr
)
1078 and fninfo2arity fninfo
=
1082 Ast0.FStorage
(stg) -> [mcode2arity stg]
1083 | Ast0.FType
(ty) -> []
1084 | Ast0.FInline
(inline
) -> [mcode2arity inline
]
1085 | Ast0.FAttr
(attr
) -> [mcode2arity attr
])
1088 and whencode notfn alwaysfn expression
= function
1089 Ast0.WhenNot a
-> Ast0.WhenNot
(notfn a
)
1090 | Ast0.WhenAlways a
-> Ast0.WhenAlways
(alwaysfn a
)
1091 | Ast0.WhenModifier
(x
) -> Ast0.WhenModifier
(x
)
1092 | Ast0.WhenNotTrue a
-> Ast0.WhenNotTrue
(expression a
)
1093 | Ast0.WhenNotFalse a
-> Ast0.WhenNotFalse
(expression a
)
1095 and make_case_line
=
1097 (function x
-> Ast0.OptCase x
)
1098 (function x
-> failwith
"unique not allowed for case_line")
1100 and case_line
tgt c
=
1101 match Ast0.unwrap c
with
1102 Ast0.Default
(def,colon,code
) ->
1104 all_same true tgt (mcode2line def)
1105 [mcode2arity def; mcode2arity colon] in
1106 let def = mcode def in
1107 let colon = mcode colon in
1108 let code = dots (statement
arity) code in
1109 make_case_line c
tgt arity (Ast0.Default
(def,colon,code))
1110 | Ast0.Case
(case
,exp,colon,code) ->
1112 all_same true tgt (mcode2line case
)
1113 [mcode2arity case
; mcode2arity colon] in
1114 let case = mcode case in
1115 let exp = expression
arity exp in
1116 let colon = mcode colon in
1117 let code = dots (statement
arity) code in
1118 make_case_line c
tgt arity (Ast0.Case
(case,exp,colon,code))
1119 | Ast0.DisjCase
(starter
,case_lines
,mids
,ender
) ->
1120 let case_lines = List.map
(case_line
tgt) case_lines in
1121 (match List.rev
case_lines with
1123 if anyopt xs
(function Ast0.OptCase
(_
) -> true | _
-> false)
1124 then fail c
"opt only allowed in the last disjunct"
1126 Ast0.rewrap c
(Ast0.DisjCase
(starter
,case_lines,mids
,ender
))
1127 | Ast0.OptCase
(_
) -> failwith
"unexpected OptCase"
1129 (* --------------------------------------------------------------------- *)
1130 (* Function declaration *)
1131 (* Haven't thought much about arity here... *)
1133 let top_level tgt t
=
1135 (match Ast0.unwrap t
with
1136 Ast0.FILEINFO
(old_file
,new_file
) ->
1137 if mcode2arity old_file
= Ast0.NONE
&& mcode2arity new_file
= Ast0.NONE
1138 then Ast0.FILEINFO
(mcode old_file
,mcode new_file
)
1139 else fail t
"unexpected arity for file info"
1140 | Ast0.NONDECL
(stmt
) ->
1141 Ast0.NONDECL
(statement
tgt stmt
)
1142 | Ast0.CODE
(rule_elem_dots
) ->
1143 Ast0.CODE
(concat_dots (statement
tgt) rule_elem_dots
)
1144 | Ast0.TOPCODE
(rule_elem_dots
) -> fail t
"eliminated by top_level"
1145 | Ast0.ERRORWORDS
(exps) ->
1146 Ast0.ERRORWORDS
(List.map
(top_expression false Ast0.NONE
) exps)
1147 | Ast0.OTHER
(_
) -> fail t
"eliminated by top_level")
1149 let rule tgt = List.map
(top_level tgt)
1151 (* --------------------------------------------------------------------- *)
1154 let minus_arity code =