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.
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.
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.
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/>.
20 * The authors reserve the right to distribute this or future versions of
21 * Coccinelle under other licenses.
25 (* Arities matter for the minus slice, but not for the plus slice. *)
27 (* ? only allowed on rule_elems, and on subterms if the context is ? also. *)
29 module Ast0
= Ast0_cocci
30 module Ast
= Ast_cocci
32 (* --------------------------------------------------------------------- *)
34 let warning s
= Printf.printf
"warning: %s\n" s
38 (Printf.sprintf
"cocci line %d: %s"
39 ((Ast0.get_info w
).Ast0.pos_info
.Ast0.line_start
)
42 let make_opt_unique optfn uniquefn info tgt arity term
=
43 let term = Ast0.rewrap info
term in
46 else (* tgt must be NONE *)
48 Ast0.OPT
-> Ast0.copywrap info
(optfn
term)
49 | Ast0.UNIQUE
-> Ast0.copywrap info
(uniquefn
term)
50 | Ast0.NONE
-> failwith
"tgt must be NONE"
52 let all_same opt_allowed tgt line arities
=
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"
61 if not
(List.for_all
(function x
-> x
= tgt) arities
)
62 then warning (Printf.sprintf
"incompatible arity found on line %d" line
);
65 let get_option fn
= function
67 | Some x
-> Some
(fn x
)
69 let anyopt l fn
= List.exists
(function w
-> fn
(Ast0.unwrap w
)) l
72 let rec loop = function
75 match fn
(Ast0.unwrap x
) with
76 Some x
-> x
:: (loop xs
)
79 if List.length
res = List.length l
then Some
res else None
81 (* --------------------------------------------------------------------- *)
82 (* --------------------------------------------------------------------- *)
85 let mcode2line (_
,_
,info
,_
,_
,_
) = info
.Ast0.pos_info
.Ast0.line_start
86 let mcode2arity (_
,arity
,_
,_
,_
,_
) = arity
88 let mcode x
= x
(* nothing to do ... *)
90 (* --------------------------------------------------------------------- *)
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
))
104 match Ast0.unwrap x
with
105 Ast0.Circles
(_
,_
) | Ast0.Stars
(_
,_
) -> true
112 match Ast0.unwrap x
with
113 Ast0.Dots
(_
,_
) | Ast0.Stars
(_
,_
) -> true
120 match Ast0.unwrap x
with
121 Ast0.Dots
(_
,_
) | Ast0.Circles
(_
,_
) -> true
125 let concat_dots fn d
=
127 (match Ast0.unwrap d
with
129 let l = List.map fn x
in
132 else fail d
"inconsistent dots usage"
134 let l = List.map fn x
in
137 else fail d
"inconsistent dots usage"
139 let l = List.map fn x
in
142 else fail d
"inconsistent dots usage")
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
150 (* --------------------------------------------------------------------- *)
155 (function x
-> Ast0.OptIdent x
)
156 (function x
-> Ast0.UniqueIdent x
)
158 let rec ident opt_allowed
tgt i
=
159 match Ast0.unwrap i
with
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
,seed
,pure
) ->
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
,seed
,pure
))
172 | Ast0.MetaFunc
(name,constraints
,pure
) ->
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
) ->
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.DisjId
(starter
,id_list
,mids
,ender
) ->
185 let id_list = List.map
(ident opt_allowed
tgt) id_list in
186 (match List.rev
id_list with
188 if anyopt xs
(function Ast0.OptIdent
(_
) -> true | _
-> false)
189 then fail i
"opt only allowed in the last disjunct"
191 Ast0.rewrap i
(Ast0.DisjId
(starter
,id_list,mids
,ender
))
192 | Ast0.OptIdent
(_
) | Ast0.UniqueIdent
(_
) ->
193 failwith
"unexpected code"
195 (* --------------------------------------------------------------------- *)
200 (function x
-> Ast0.OptExp x
)
201 (function x
-> Ast0.UniqueExp x
)
203 let rec top_expression opt_allowed
tgt expr
=
204 let exp_same = all_same opt_allowed
tgt in
205 match Ast0.unwrap expr
with
207 let new_id = ident opt_allowed
tgt id
in
209 (match Ast0.unwrap
new_id with
211 Ast0.OptExp
(Ast0.rewrap expr
(Ast0.Ident
(id
)))
212 | Ast0.UniqueIdent
(id
) ->
213 Ast0.UniqueExp
(Ast0.rewrap expr
(Ast0.Ident
(id
)))
214 | _
-> Ast0.Ident
(new_id))
215 | Ast0.Constant
(const
) ->
216 let arity = exp_same (mcode2line const
) [mcode2arity const
] in
217 let const = mcode const in
218 make_exp expr
tgt arity (Ast0.Constant
(const))
219 | Ast0.FunCall
(fn
,lp
,args
,rp
) ->
220 let arity = exp_same (mcode2line lp
) [mcode2arity lp
;mcode2arity rp
] in
221 let fn = expression
arity fn in
223 let args = dots (expression
arity) args in
225 make_exp expr
tgt arity (Ast0.FunCall
(fn,lp,args,rp))
226 | Ast0.Assignment
(left
,op
,right
,simple
) ->
227 let arity = exp_same (mcode2line op
) [mcode2arity op
] in
228 let left = expression
arity left in
230 let right = expression
arity right in
231 make_exp expr
tgt arity (Ast0.Assignment
(left,op,right,simple
))
232 | Ast0.CondExpr
(exp1
,why
,exp2
,colon
,exp3
) ->
234 exp_same (mcode2line why
) [mcode2arity why
; mcode2arity colon
] in
235 let exp1 = expression
arity exp1 in
236 let why = mcode why in
237 let exp2 = get_option (expression
arity) exp2 in
238 let colon = mcode colon in
239 let exp3 = expression
arity exp3 in
240 make_exp expr
tgt arity (Ast0.CondExpr
(exp1,why,exp2,colon,exp3))
241 | Ast0.Postfix
(exp
,op) ->
242 let arity = exp_same (mcode2line op) [mcode2arity op] in
243 let exp = expression
arity exp in
245 make_exp expr
tgt arity (Ast0.Postfix
(exp,op))
246 | Ast0.Infix
(exp,op) ->
247 let arity = exp_same (mcode2line op) [mcode2arity op] in
248 let exp = expression
arity exp in
250 make_exp expr
tgt arity (Ast0.Infix
(exp,op))
251 | Ast0.Unary
(exp,op) ->
252 let arity = exp_same (mcode2line op) [mcode2arity op] in
253 let exp = expression
arity exp in
255 make_exp expr
tgt arity (Ast0.Unary
(exp,op))
256 | Ast0.Binary
(left,op,right) ->
257 let arity = exp_same (mcode2line op) [mcode2arity op] in
258 let left = expression
arity left in
260 let right = expression
arity right in
261 make_exp expr
tgt arity (Ast0.Binary
(left,op,right))
262 | Ast0.Nested
(left,op,right) -> failwith
"nested in arity not possible"
263 | Ast0.Paren
(lp,exp,rp) ->
264 let arity = exp_same (mcode2line lp) [mcode2arity lp;mcode2arity rp] in
266 let exp = expression
arity exp in
268 make_exp expr
tgt arity (Ast0.Paren
(lp,exp,rp))
269 | Ast0.ArrayAccess
(exp1,lb
,exp2,rb
) ->
270 let arity = exp_same (mcode2line lb
) [mcode2arity lb
; mcode2arity rb
] in
271 let exp1 = expression
arity exp1 in
273 let exp2 = expression
arity exp2 in
275 make_exp expr
tgt arity (Ast0.ArrayAccess
(exp1,lb,exp2,rb))
276 | Ast0.RecordAccess
(exp,pt
,field
) ->
277 let arity = exp_same (mcode2line pt
) [mcode2arity pt
] in
278 let exp = expression
arity exp in
280 let field = ident false arity field in
281 make_exp expr
tgt arity (Ast0.RecordAccess
(exp,pt,field))
282 | Ast0.RecordPtAccess
(exp,ar
,field) ->
283 let arity = exp_same (mcode2line ar
) [mcode2arity ar
] in
284 let exp = expression
arity exp in
286 let field = ident false arity field in
287 make_exp expr
tgt arity (Ast0.RecordPtAccess
(exp,ar,field))
288 | Ast0.Cast
(lp,ty
,rp,exp) ->
289 let arity = exp_same (mcode2line lp) [mcode2arity lp;mcode2arity rp] in
291 let ty = typeC
arity ty in
293 let exp = expression
arity exp in
294 make_exp expr
tgt arity (Ast0.Cast
(lp,ty,rp,exp))
295 | Ast0.SizeOfExpr
(szf
,exp) ->
296 let arity = exp_same (mcode2line szf
) [mcode2arity szf
] in
297 let szf = mcode szf in
298 let exp = expression
arity exp in
299 make_exp expr
tgt arity (Ast0.SizeOfExpr
(szf,exp))
300 | Ast0.SizeOfType
(szf,lp,ty,rp) ->
302 exp_same (mcode2line szf) (List.map
mcode2arity [szf;lp;rp]) in
303 let szf = mcode szf in
305 let ty = typeC
arity ty in
307 make_exp expr
tgt arity (Ast0.SizeOfType
(szf,lp,ty,rp))
308 | Ast0.TypeExp
(ty) -> Ast0.rewrap expr
(Ast0.TypeExp
(typeC
tgt ty))
309 | Ast0.MetaErr
(name,constraints
,pure
) ->
310 let arity = exp_same (mcode2line name) [mcode2arity name] in
311 let name = mcode name in
312 make_exp expr
tgt arity (Ast0.MetaErr
(name,constraints
,pure
))
313 | Ast0.MetaExpr
(name,constraints
,ty,form
,pure
) ->
314 let arity = exp_same (mcode2line name) [mcode2arity name] in
315 let name = mcode name in
316 make_exp expr
tgt arity (Ast0.MetaExpr
(name,constraints
,ty,form
,pure
))
317 | Ast0.MetaExprList
(name,lenname
,pure
) ->
318 let arity = exp_same (mcode2line name) [mcode2arity name] in
319 let name = mcode name in
320 make_exp expr
tgt arity (Ast0.MetaExprList
(name,lenname
,pure
))
322 let arity = exp_same (mcode2line cm
) [mcode2arity cm
] in
324 make_exp expr
tgt arity (Ast0.EComma
(cm))
325 | Ast0.DisjExpr
(starter
,exps
,mids
,ender
) ->
326 let exps = List.map
(top_expression opt_allowed
tgt) exps in
327 (match List.rev
exps with
329 if anyopt xs
(function Ast0.OptExp
(_
) -> true | _
-> false)
330 then fail expr
"opt only allowed in the last disjunct"
332 Ast0.rewrap expr
(Ast0.DisjExpr
(starter
,exps,mids
,ender
))
333 | Ast0.NestExpr
(starter
,exp_dots
,ender
,whencode
,multi
) ->
335 Ast0.NestExpr
(starter
,
336 dots (top_expression true Ast0.NONE
) exp_dots
,
337 ender
,whencode
,multi
) in
339 | Ast0.Edots
(dots,whencode
) ->
340 let arity = exp_same (mcode2line dots) [mcode2arity dots] in
341 let dots = mcode dots in
342 let whencode = get_option (expression
Ast0.NONE
) whencode in
343 make_exp expr
tgt arity (Ast0.Edots
(dots,whencode))
344 | Ast0.Ecircles
(dots,whencode) ->
345 let arity = exp_same (mcode2line dots) [mcode2arity dots] in
346 let dots = mcode dots in
347 let whencode = get_option (expression
Ast0.NONE
) whencode in
348 make_exp expr
tgt arity (Ast0.Ecircles
(dots,whencode))
349 | Ast0.Estars
(dots,whencode) ->
350 let arity = exp_same (mcode2line dots) [mcode2arity dots] in
351 let dots = mcode dots in
352 let whencode = get_option (expression
Ast0.NONE
) whencode in
353 make_exp expr
tgt arity (Ast0.Estars
(dots,whencode))
354 (* why does optexp exist???? *)
355 | Ast0.OptExp
(_
) | Ast0.UniqueExp
(_
) ->
356 failwith
"unexpected code"
358 and expression
tgt exp = top_expression false tgt exp
360 (* --------------------------------------------------------------------- *)
365 (function x
-> Ast0.OptType x
)
366 (function x
-> Ast0.UniqueType x
)
368 and top_typeC
tgt opt_allowed typ
=
369 match Ast0.unwrap typ
with
370 Ast0.ConstVol
(cv
,ty) ->
371 let arity = all_same opt_allowed
tgt (mcode2line cv
)
374 let ty = typeC
arity ty in
375 make_typeC typ
tgt arity (Ast0.ConstVol
(cv,ty))
376 | Ast0.BaseType
(ty,strings
) ->
378 all_same opt_allowed
tgt (mcode2line (List.hd strings
))
379 (List.map
mcode2arity strings
) in
380 let strings = List.map
mcode strings in
381 make_typeC typ
tgt arity (Ast0.BaseType
(ty,strings))
382 | Ast0.Signed
(sign
,ty) ->
384 all_same opt_allowed
tgt (mcode2line sign
) [mcode2arity sign
] in
385 let sign = mcode sign in
386 let ty = get_option (typeC
arity) ty in
387 make_typeC typ
tgt arity (Ast0.Signed
(sign,ty))
388 | Ast0.Pointer
(ty,star
) ->
390 all_same opt_allowed
tgt (mcode2line star
) [mcode2arity star
] in
391 let ty = typeC
arity ty in
392 let star = mcode star in
393 make_typeC typ
tgt arity (Ast0.Pointer
(ty,star))
394 | Ast0.FunctionPointer
(ty,lp1
,star,rp1
,lp2
,params
,rp2
) ->
396 all_same opt_allowed
tgt (mcode2line lp1
)
397 (List.map
mcode2arity [lp1
;star;rp1
;lp2
;rp2
]) in
398 let ty = typeC
arity ty in
399 let params = parameter_list
tgt params in
400 make_typeC typ
tgt arity
401 (Ast0.FunctionPointer
(ty,lp1
,star,rp1
,lp2
,params,rp2
))
402 | Ast0.FunctionType
(ty,lp1
,params,rp1
) ->
404 all_same opt_allowed
tgt (mcode2line lp1
)
405 (List.map
mcode2arity [lp1
;rp1
]) in
406 let ty = get_option (typeC
arity) ty in
407 let params = parameter_list
tgt params in
408 make_typeC typ
tgt arity (Ast0.FunctionType
(ty,lp1
,params,rp1
))
409 | Ast0.Array
(ty,lb,size
,rb) ->
411 all_same opt_allowed
tgt (mcode2line lb)
412 [mcode2arity lb;mcode2arity rb] in
413 let ty = typeC
arity ty in
415 let size = get_option (expression
arity) size in
417 make_typeC typ
tgt arity (Ast0.Array
(ty,lb,size,rb))
418 | Ast0.EnumName
(kind
,name) ->
420 all_same opt_allowed
tgt (mcode2line kind
) [mcode2arity kind
] in
421 let kind = mcode kind in
422 let name = get_option (ident false arity) name in
423 make_typeC typ
tgt arity (Ast0.EnumName
(kind,name))
424 | Ast0.EnumDef
(ty,lb,decls
,rb) ->
426 all_same opt_allowed
tgt (mcode2line lb)
427 (List.map
mcode2arity [lb;rb]) in
428 let ty = typeC
arity ty in
430 let ids = dots (expression
tgt) decls
in
432 make_typeC typ
tgt arity (Ast0.EnumDef
(ty,lb,ids,rb))
433 | Ast0.StructUnionName
(kind,name) ->
435 all_same opt_allowed
tgt (mcode2line kind)
436 [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.StructUnionName
(kind,name))
440 | Ast0.StructUnionDef
(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 decls = dots (declaration
tgt) decls in
448 make_typeC typ
tgt arity (Ast0.StructUnionDef
(ty,lb,decls,rb))
449 | Ast0.TypeName
(name) ->
451 all_same opt_allowed
tgt (mcode2line name) [mcode2arity name] in
452 let name = mcode name in
453 make_typeC typ
tgt arity (Ast0.TypeName
(name))
454 | Ast0.MetaType
(name,pure
) ->
456 all_same opt_allowed
tgt (mcode2line name) [mcode2arity name] in
457 let name = mcode name in
458 make_typeC typ
tgt arity (Ast0.MetaType
(name,pure
))
459 | Ast0.DisjType
(starter
,types
,mids
,ender
) ->
460 let types = List.map
(typeC
tgt) types in
461 (match List.rev
types with
463 if anyopt xs
(function Ast0.OptType
(_
) -> true | _
-> false)
464 then fail typ
"opt only allowed in the last disjunct"
466 let res = Ast0.DisjType
(starter
,types,mids
,ender
) in
468 | Ast0.OptType
(_
) | Ast0.UniqueType
(_
) ->
469 failwith
"unexpected code"
471 and typeC
tgt ty = top_typeC
tgt false ty
473 (* --------------------------------------------------------------------- *)
474 (* Variable declaration *)
475 (* Even if the Cocci program specifies a list of declarations, they are
476 split out into multiple declarations of a single variable each. *)
480 (function x
-> Ast0.OptDecl x
)
481 (function x
-> Ast0.UniqueDecl x
)
483 and declaration
tgt decl
=
484 match Ast0.unwrap decl
with
485 Ast0.MetaDecl
(name,pure
) ->
486 let arity = all_same true tgt (mcode2line name) [mcode2arity name] in
487 let name = mcode name in
488 make_decl decl
tgt arity (Ast0.MetaDecl
(name,pure
))
489 | Ast0.MetaField
(name,pure
) ->
490 let arity = all_same true tgt (mcode2line name) [mcode2arity name] in
491 let name = mcode name in
492 make_decl decl
tgt arity (Ast0.MetaField
(name,pure
))
493 | Ast0.MetaFieldList
(name,lenname
,pure
) ->
494 let arity = all_same true tgt (mcode2line name) [mcode2arity name] in
495 let name = mcode name in
496 make_decl decl
tgt arity (Ast0.MetaFieldList
(name,lenname
,pure
))
497 | Ast0.Init
(stg
,ty,id
,eq
,exp,sem
) ->
499 all_same true tgt (mcode2line eq
)
500 ((match stg
with None
-> [] | Some x
-> [mcode2arity x
]) @
501 (List.map
mcode2arity [eq
;sem
])) in
502 let stg = get_option mcode stg in
503 let ty = typeC
arity ty in
504 let id = ident false arity id in
506 let exp = initialiser
arity exp in
507 let sem = mcode sem in
508 make_decl decl
tgt arity (Ast0.Init
(stg,ty,id,eq,exp,sem))
509 | Ast0.UnInit
(stg,ty,id,sem) ->
511 all_same true tgt (mcode2line sem)
512 ((match stg with None
-> [] | Some x
-> [mcode2arity x
]) @
513 [mcode2arity sem]) in
514 let stg = get_option mcode stg in
515 let ty = typeC
arity ty in
516 let id = ident false arity id in
517 let sem = mcode sem in
518 make_decl decl
tgt arity (Ast0.UnInit
(stg,ty,id,sem))
519 | Ast0.MacroDecl
(name,lp,args,rp,sem) ->
521 all_same true tgt (mcode2line lp) (List.map
mcode2arity [lp;rp;sem]) in
522 let name = ident false arity name in
524 let args = dots (expression
arity) args in
526 let sem = mcode sem in
527 make_decl decl
tgt arity (Ast0.MacroDecl
(name,lp,args,rp,sem))
528 | Ast0.TyDecl
(ty,sem) ->
530 all_same true tgt (mcode2line sem) [mcode2arity sem] in
531 let ty = typeC
arity ty in
532 let sem = mcode sem in
533 make_decl decl
tgt arity (Ast0.TyDecl
(ty,sem))
534 | Ast0.Typedef
(stg,ty,id,sem) ->
536 all_same true tgt (mcode2line sem)
537 [mcode2arity stg;mcode2arity sem] in
538 let stg = mcode stg in
539 let ty = typeC
arity ty in
540 let id = typeC
arity id in
541 let sem = mcode sem in
542 make_decl decl
tgt arity (Ast0.Typedef
(stg,ty,id,sem))
543 | Ast0.DisjDecl
(starter
,decls,mids
,ender
) ->
544 let decls = List.map
(declaration
tgt) decls in
545 (match List.rev
decls with
547 if anyopt xs
(function Ast0.OptDecl
(_
) -> true | _
-> false)
548 then fail decl
"opt only allowed in the last disjunct"
550 let res = Ast0.DisjDecl
(starter
,decls,mids
,ender
) in
552 | Ast0.Ddots
(dots,whencode) ->
553 let arity = all_same true tgt (mcode2line dots) [mcode2arity dots] in
554 let dots = mcode dots in
555 let whencode = get_option (declaration
Ast0.NONE
) whencode in
556 make_decl decl
tgt arity (Ast0.Ddots
(dots,whencode))
557 | Ast0.OptDecl
(_
) | Ast0.UniqueDecl
(_
) ->
558 failwith
"unexpected code"
560 (* --------------------------------------------------------------------- *)
565 (function x
-> Ast0.OptIni x
)
566 (function x
-> Ast0.UniqueIni x
)
568 and initialiser
tgt i
=
569 let init_same = all_same true tgt in
570 match Ast0.unwrap i
with
571 Ast0.MetaInit
(name,pure
) ->
572 let arity = init_same (mcode2line name) [mcode2arity name] in
573 let name = mcode name in
574 make_init i
tgt arity (Ast0.MetaInit
(name,pure
))
575 | Ast0.MetaInitList
(name,lenname
,pure
) ->
576 let arity = init_same (mcode2line name) [mcode2arity name] in
577 let name = mcode name in
578 make_init i
tgt arity (Ast0.MetaInitList
(name,lenname
,pure
))
579 | Ast0.InitExpr
(exp) ->
580 Ast0.rewrap i
(Ast0.InitExpr
(expression
tgt exp))
581 | Ast0.InitList
(lb,initlist
,rb,ordered
) ->
582 let arity = init_same (mcode2line lb) [mcode2arity lb; mcode2arity rb] in
584 let initlist = dots (initialiser
arity) initlist in
586 make_init i
tgt arity (Ast0.InitList
(lb,initlist,rb,ordered
))
587 | Ast0.InitGccExt
(designators
,eq,ini
) ->
588 let arity = init_same (mcode2line eq) [mcode2arity eq] in
589 let designators = List.map
(designator
arity) designators in
591 let ini = initialiser
arity ini in
592 make_init i
tgt arity (Ast0.InitGccExt
(designators,eq,ini))
593 | Ast0.InitGccName
(name,eq,ini) ->
594 let arity = init_same (mcode2line eq) [mcode2arity eq] in
595 let name = ident true arity name in
597 let ini = initialiser
arity ini in
598 make_init i
tgt arity (Ast0.InitGccName
(name,eq,ini))
600 let arity = init_same (mcode2line cm) [mcode2arity cm] in
602 make_init i
tgt arity (Ast0.IComma
(cm))
603 | Ast0.Idots
(dots,whencode) ->
604 let arity = init_same (mcode2line dots) [mcode2arity dots] in
605 let dots = mcode dots in
606 let whencode = get_option (initialiser
Ast0.NONE
) whencode in
607 make_init i
tgt arity (Ast0.Idots
(dots,whencode))
608 | Ast0.OptIni
(_
) | Ast0.UniqueIni
(_
) ->
609 failwith
"unexpected code"
611 and designator
tgt d
=
612 let dsame = all_same false tgt in
614 Ast0.DesignatorField
(dot
,id) ->
615 let arity = dsame (mcode2line dot
) [mcode2arity dot
] in
616 let dot = mcode dot in
617 let id = ident false arity id in
618 Ast0.DesignatorField
(dot,id)
619 | Ast0.DesignatorIndex
(lb,exp,rb) ->
620 let arity = dsame (mcode2line lb) [mcode2arity lb;mcode2arity rb] in
622 let exp = top_expression false arity exp in
624 Ast0.DesignatorIndex
(lb,exp,rb)
625 | Ast0.DesignatorRange
(lb,min
,dots,max
,rb) ->
627 dsame (mcode2line lb)
628 [mcode2arity lb;mcode2arity dots;mcode2arity rb] in
630 let min = top_expression false arity min in
631 let dots = mcode dots in
632 let max = top_expression false arity max in
634 Ast0.DesignatorRange
(lb,min,dots,max,rb)
636 (* --------------------------------------------------------------------- *)
641 (function x
-> Ast0.OptParam x
)
642 (function x
-> Ast0.UniqueParam x
)
644 and parameterTypeDef
tgt param
=
645 let param_same = all_same true tgt in
646 match Ast0.unwrap param
with
647 Ast0.VoidParam
(ty) -> Ast0.rewrap param
(Ast0.VoidParam
(typeC
tgt ty))
648 | Ast0.Param
(ty,Some
id) ->
649 let ty = top_typeC
tgt true ty in
650 let id = ident true tgt id in
652 (match (Ast0.unwrap
ty,Ast0.unwrap
id) with
653 (Ast0.OptType
(ty),Ast0.OptIdent
(id)) ->
654 Ast0.OptParam
(Ast0.rewrap param
(Ast0.Param
(ty,Some
id)))
655 | (Ast0.UniqueType
(ty),Ast0.UniqueIdent
(id)) ->
656 Ast0.UniqueParam
(Ast0.rewrap param
(Ast0.Param
(ty,Some
id)))
657 | (Ast0.OptType
(ty),_
) ->
658 fail param
"arity mismatch in param declaration"
659 | (_
,Ast0.OptIdent
(id)) ->
660 fail param
"arity mismatch in param declaration"
661 | _
-> Ast0.Param
(ty,Some
id))
662 | Ast0.Param
(ty,None
) ->
663 let ty = top_typeC
tgt true ty in
665 (match Ast0.unwrap
ty with
667 Ast0.OptParam
(Ast0.rewrap param
(Ast0.Param
(ty,None
)))
668 | Ast0.UniqueType
(ty) ->
669 Ast0.UniqueParam
(Ast0.rewrap param
(Ast0.Param
(ty,None
)))
670 | _
-> Ast0.Param
(ty,None
))
671 | Ast0.MetaParam
(name,pure
) ->
672 let arity = param_same (mcode2line name) [mcode2arity name] in
673 let name = mcode name in
674 make_param param
tgt arity (Ast0.MetaParam
(name,pure
))
675 | Ast0.MetaParamList
(name,lenname
,pure
) ->
676 let arity = param_same (mcode2line name) [mcode2arity name] in
677 let name = mcode name in
678 make_param param
tgt arity (Ast0.MetaParamList
(name,lenname
,pure
))
680 let arity = param_same (mcode2line cm) [mcode2arity cm] in
682 make_param param
tgt arity (Ast0.PComma
(cm))
683 | Ast0.Pdots
(dots) ->
684 let arity = param_same (mcode2line dots) [mcode2arity dots] in
685 let dots = mcode dots in
686 make_param param
tgt arity (Ast0.Pdots
(dots))
687 | Ast0.Pcircles
(dots) ->
688 let arity = param_same (mcode2line dots) [mcode2arity dots] in
689 let dots = mcode dots in
690 make_param param
tgt arity (Ast0.Pcircles
(dots))
691 | Ast0.OptParam
(_
) | Ast0.UniqueParam
(_
) ->
692 failwith
"unexpected code"
694 and parameter_list
tgt = dots (parameterTypeDef
tgt)
696 (* --------------------------------------------------------------------- *)
699 and make_rule_elem x
=
701 (function x
-> Ast0.OptStm x
)
702 (function x
-> Ast0.UniqueStm x
)
705 and statement
tgt stm
=
706 let stm_same = all_same true tgt in
707 match Ast0.unwrap stm
with
708 Ast0.Decl
(bef
,decl
) ->
709 let new_decl = declaration
tgt decl
in
711 (match Ast0.unwrap
new_decl with
712 Ast0.OptDecl
(decl
) ->
713 Ast0.OptStm
(Ast0.rewrap stm
(Ast0.Decl
(bef
,decl
)))
714 | Ast0.UniqueDecl
(decl
) ->
715 Ast0.UniqueStm
(Ast0.rewrap stm
(Ast0.Decl
(bef
,decl
)))
716 | _
-> Ast0.Decl
(bef
,new_decl))
717 | Ast0.Seq
(lbrace
,body
,rbrace
) ->
719 stm_same (mcode2line lbrace
)
720 [mcode2arity lbrace
; mcode2arity rbrace
] in
721 let lbrace = mcode lbrace in
722 let body = dots (statement
arity) body in
723 let rbrace = mcode rbrace in
724 make_rule_elem stm
tgt arity (Ast0.Seq
(lbrace,body,rbrace))
725 | Ast0.ExprStatement
(exp,sem) ->
726 let arity = stm_same (mcode2line sem) [mcode2arity sem] in
727 let exp = get_option (expression
arity) exp in
728 let sem = mcode sem in
729 make_rule_elem stm
tgt arity (Ast0.ExprStatement
(exp,sem))
730 | Ast0.IfThen
(iff
,lp,exp,rp,branch
,aft
) ->
732 stm_same (mcode2line iff
) (List.map
mcode2arity [iff
;lp;rp]) in
733 let iff = mcode iff in
735 let exp = expression
arity exp in
737 let branch = statement
arity branch in
738 make_rule_elem stm
tgt arity (Ast0.IfThen
(iff,lp,exp,rp,branch,aft
))
739 | Ast0.IfThenElse
(iff,lp,exp,rp,branch1
,els
,branch2
,aft
) ->
741 stm_same (mcode2line iff) (List.map
mcode2arity [iff;lp;rp;els
]) in
742 let iff = mcode iff in
744 let exp = expression
arity exp in
746 let branch1 = statement
arity branch1 in
747 let els = mcode els in
748 let branch2 = statement
arity branch2 in
749 make_rule_elem stm
tgt arity
750 (Ast0.IfThenElse
(iff,lp,exp,rp,branch1,els,branch2,aft
))
751 | Ast0.While
(wh
,lp,exp,rp,body,aft
) ->
753 stm_same (mcode2line wh
)
754 (List.map
mcode2arity [wh
;lp;rp]) in
757 let exp = expression
arity exp in
759 let body = statement
arity body in
760 make_rule_elem stm
tgt arity (Ast0.While
(wh,lp,exp,rp,body,aft
))
761 | Ast0.Do
(d
,body,wh,lp,exp,rp,sem) ->
763 stm_same (mcode2line wh) (List.map
mcode2arity [d
;wh;lp;rp;sem]) in
765 let body = statement
arity body in
768 let exp = expression
arity exp in
770 let sem = mcode sem in
771 make_rule_elem stm
tgt arity (Ast0.Do
(d,body,wh,lp,exp,rp,sem))
772 | Ast0.For
(fr
,lp,exp1,sem1
,exp2,sem2
,exp3,rp,body,aft
) ->
774 stm_same (mcode2line fr
) (List.map
mcode2arity [fr
;lp;sem1
;sem2
;rp]) in
777 let exp1 = get_option (expression
arity) exp1 in
778 let sem1 = mcode sem1 in
779 let exp2 = get_option (expression
arity) exp2 in
780 let sem2= mcode sem2 in
781 let exp3 = get_option (expression
arity) exp3 in
783 let body = statement
arity body in
784 make_rule_elem stm
tgt arity
785 (Ast0.For
(fr,lp,exp1,sem1,exp2,sem2,exp3,rp,body,aft
))
786 | Ast0.Iterator
(nm
,lp,args,rp,body,aft
) ->
787 let arity = stm_same (mcode2line lp) (List.map
mcode2arity [lp;rp]) in
788 let nm = ident false arity nm in
790 let args = dots (expression
arity) args in
792 let body = statement
arity body in
793 make_rule_elem stm
tgt arity (Ast0.Iterator
(nm,lp,args,rp,body,aft
))
794 | Ast0.Switch
(switch
,lp,exp,rp,lb,decls,cases
,rb) ->
796 stm_same (mcode2line switch
)
797 (List.map
mcode2arity [switch
;lp;rp;lb;rb]) in
798 let switch = mcode switch in
800 let exp = expression
arity exp in
803 let decls = dots (statement
arity) decls in
804 let cases = dots (case_line
arity) cases in
806 make_rule_elem stm
tgt arity
807 (Ast0.Switch
(switch,lp,exp,rp,lb,decls,cases,rb))
808 | Ast0.Break
(br
,sem) ->
809 let arity = stm_same (mcode2line br
) (List.map
mcode2arity [br
;sem]) in
811 let sem = mcode sem in
812 make_rule_elem stm
tgt arity (Ast0.Break
(br,sem))
813 | Ast0.Continue
(cont
,sem) ->
815 stm_same (mcode2line cont
) (List.map
mcode2arity [cont
;sem]) in
816 let cont = mcode cont in
817 let sem = mcode sem in
818 make_rule_elem stm
tgt arity (Ast0.Continue
(cont,sem))
819 | Ast0.Label
(l,dd
) ->
820 let arity = mcode2arity dd
in
821 let l = ident false tgt l in
823 make_rule_elem stm
tgt arity (Ast0.Label
(l,dd))
824 | Ast0.Goto
(goto
,l,sem) ->
826 stm_same (mcode2line goto
) (List.map
mcode2arity [goto
;sem]) in
827 let goto = mcode goto in
828 let l = ident false arity l in
829 let sem = mcode sem in
830 make_rule_elem stm
tgt arity (Ast0.Goto
(goto,l,sem))
831 | Ast0.Return
(ret
,sem) ->
832 let arity = stm_same (mcode2line ret
) (List.map
mcode2arity [ret
;sem]) in
833 let ret = mcode ret in
834 let sem = mcode sem in
835 make_rule_elem stm
tgt arity (Ast0.Return
(ret,sem))
836 | Ast0.ReturnExpr
(ret,exp,sem) ->
837 let arity = stm_same (mcode2line ret) (List.map
mcode2arity [ret;sem]) in
838 let ret = mcode ret in
839 let exp = expression
arity exp in
840 let sem = mcode sem in
841 make_rule_elem stm
tgt arity (Ast0.ReturnExpr
(ret,exp,sem))
842 | Ast0.MetaStmt
(name,pure
) ->
843 let arity = stm_same (mcode2line name) [mcode2arity name] in
844 let name = mcode name in
845 make_rule_elem stm
tgt arity (Ast0.MetaStmt
(name,pure
))
846 | Ast0.MetaStmtList
(name,pure
) ->
847 let arity = stm_same (mcode2line name) [mcode2arity name] in
848 let name = mcode name in
849 make_rule_elem stm
tgt arity (Ast0.MetaStmtList
(name,pure
))
851 let new_exp = top_expression true tgt exp in
853 (match Ast0.unwrap
new_exp with
855 Ast0.OptStm
(Ast0.rewrap stm
(Ast0.Exp
(exp)))
856 | Ast0.UniqueExp
(exp) ->
857 Ast0.UniqueStm
(Ast0.rewrap stm
(Ast0.Exp
(exp)))
858 | _
-> Ast0.Exp
(new_exp))
859 | Ast0.TopExp
(exp) ->
860 let new_exp = top_expression true tgt exp in
862 (match Ast0.unwrap
new_exp with
864 Ast0.OptStm
(Ast0.rewrap stm
(Ast0.TopExp
(exp)))
865 | Ast0.UniqueExp
(exp) ->
866 Ast0.UniqueStm
(Ast0.rewrap stm
(Ast0.TopExp
(exp)))
867 | _
-> Ast0.TopExp
(new_exp))
869 let new_ty = typeC
tgt ty in (* opt makes no sense alone at top level *)
871 (match Ast0.unwrap
new_ty with
873 Ast0.OptStm
(Ast0.rewrap stm
(Ast0.Ty
(ty)))
874 | Ast0.UniqueType
(ty) ->
875 Ast0.UniqueStm
(Ast0.rewrap stm
(Ast0.Ty
(ty)))
876 | _
-> Ast0.Ty
(new_ty))
877 | Ast0.TopInit
(init
) ->
878 let new_init = initialiser
tgt init
in
880 (match Ast0.unwrap
new_init with
882 Ast0.OptStm
(Ast0.rewrap stm
(Ast0.TopInit
(init
)))
883 | Ast0.UniqueIni
(init
) ->
884 Ast0.UniqueStm
(Ast0.rewrap stm
(Ast0.TopInit
(init
)))
885 | _
-> Ast0.TopInit
(new_init))
886 | Ast0.Disj
(starter
,rule_elem_dots_list
,mids
,ender
) ->
888 List.map
(function x
-> concat_dots (statement
tgt) x
)
889 rule_elem_dots_list
in
890 let (found_opt
,unopt
) =
892 (function (found_opt
,lines
) ->
895 (* previously just checked the last thing in the list,
896 but everything should be optional for the whole thing to
899 match Ast0.unwrap x
with
900 Ast0.OptStm
(x
) -> true
903 match Ast0.unwrap x
with
906 if List.for_all
is_opt l
907 then (true,List.map
unopt l)
910 match Ast0.unwrap x
with
912 (l,function l -> Ast0.rewrap x
(Ast0.DOTS
l))
914 (l,function l -> Ast0.rewrap x
(Ast0.CIRCLES
l))
916 (l,function l -> Ast0.rewrap x
(Ast0.STARS
l)) in
917 let (found_opt
,l) = rebuild l in
918 (found_opt
,(k
l)::lines
))
920 let unopt = List.rev
unopt in
923 make_rule_elem stm
tgt Ast0.OPT
(Ast0.Disj
(starter
,unopt,mids
,ender
))
924 else Ast0.rewrap stm
(Ast0.Disj
(starter
,stms,mids
,ender
))
925 | Ast0.Nest
(starter
,rule_elem_dots
,ender
,whn
,multi
) ->
926 let new_rule_elem_dots =
927 concat_dots (statement
Ast0.NONE
) rule_elem_dots
in
930 (whencode (concat_dots (statement
Ast0.NONE
)) (statement
Ast0.NONE
)
931 (expression
Ast0.NONE
))
934 (Ast0.Nest
(starter
,new_rule_elem_dots,ender
,whn,multi
))
935 | Ast0.Dots
(dots,whn) ->
936 let arity = stm_same (mcode2line dots) [mcode2arity dots] in
937 let dots = mcode dots in
940 (whencode (concat_dots (statement
Ast0.NONE
)) (statement
Ast0.NONE
)
941 (expression
Ast0.NONE
))
943 make_rule_elem stm
tgt arity (Ast0.Dots
(dots,whn))
944 | Ast0.Circles
(dots,whn) ->
945 let arity = stm_same (mcode2line dots) [mcode2arity dots] in
946 let dots = mcode dots in
949 (whencode (concat_dots (statement
Ast0.NONE
)) (statement
Ast0.NONE
)
950 (expression
Ast0.NONE
))
952 make_rule_elem stm
tgt arity (Ast0.Circles
(dots,whn))
953 | Ast0.Stars
(dots,whn) ->
954 let arity = stm_same (mcode2line dots) [mcode2arity dots] in
955 let dots = mcode dots in
958 (whencode (concat_dots (statement
Ast0.NONE
)) (statement
Ast0.NONE
)
959 (expression
Ast0.NONE
))
961 make_rule_elem stm
tgt arity (Ast0.Stars
(dots,whn))
962 | Ast0.FunDecl
(bef
,fi
,name,lp,params,rp,lbrace,body,rbrace) ->
964 all_same true tgt (mcode2line lp)
965 ((List.map
mcode2arity [lp;rp;lbrace;rbrace]) @ (fninfo2arity fi
)) in
966 let fi = List.map
(fninfo
arity) fi in
967 let name = ident false arity name in
969 let params = parameter_list
arity params in
971 let lbrace = mcode lbrace in
972 let body = dots (statement
arity) body in
973 let rbrace = mcode rbrace in
974 make_rule_elem stm
tgt arity
975 (Ast0.FunDecl
(bef
,fi,name,lp,params,rp,lbrace,body,rbrace))
976 | Ast0.Include
(inc
,s
) ->
978 all_same true tgt (mcode2line inc
) [mcode2arity inc
; mcode2arity s
] in
979 let inc = mcode inc in
981 make_rule_elem stm
tgt arity (Ast0.Include
(inc,s))
982 | Ast0.Undef
(def
,id) ->
983 let arity = all_same true tgt (mcode2line def
) [mcode2arity def
] in
984 let def = mcode def in
985 let id = ident false arity id in
986 make_rule_elem stm
tgt arity (Ast0.Undef
(def,id))
987 | Ast0.Define
(def,id,params,body) ->
988 let arity = all_same true tgt (mcode2line def) [mcode2arity def] in
989 let def = mcode def in
990 let id = ident false arity id in
991 let params = define_parameters
arity params in
992 let body = dots (statement
arity) body in
993 make_rule_elem stm
tgt arity (Ast0.Define
(def,id,params,body))
994 | Ast0.OptStm
(_
) | Ast0.UniqueStm
(_
) ->
995 failwith
"unexpected code"
997 and define_parameters
tgt params =
998 match Ast0.unwrap
params with
999 Ast0.NoParams
-> params
1000 | Ast0.DParams
(lp,params,rp) ->
1002 all_same true tgt (mcode2line lp) [mcode2arity lp;mcode2arity rp] in
1003 let lp = mcode lp in
1004 let params = dots (define_param
arity) params in
1005 let rp = mcode rp in
1006 Ast0.rewrap
params (Ast0.DParams
(lp,params,rp))
1008 and make_define_param x
=
1010 (function x
-> Ast0.OptDParam x
)
1011 (function x
-> Ast0.UniqueDParam x
)
1014 and define_param
tgt param
=
1015 match Ast0.unwrap param
with
1017 let new_id = ident true tgt id in
1019 (match Ast0.unwrap
new_id with
1020 Ast0.OptIdent
(id) ->
1021 Ast0.OptDParam
(Ast0.rewrap param
(Ast0.DParam
(id)))
1022 | Ast0.UniqueIdent
(decl
) ->
1023 Ast0.UniqueDParam
(Ast0.rewrap param
(Ast0.DParam
(id)))
1024 | _
-> Ast0.DParam
(new_id))
1025 | Ast0.DPComma
(cm) ->
1027 all_same true tgt (mcode2line cm) [mcode2arity cm] in
1028 let cm = mcode cm in
1029 make_define_param param
tgt arity (Ast0.DPComma
(cm))
1030 | Ast0.DPdots
(dots) ->
1032 all_same true tgt (mcode2line dots) [mcode2arity dots] in
1033 let dots = mcode dots in
1034 make_define_param param
tgt arity (Ast0.DPdots
(dots))
1035 | Ast0.DPcircles
(circles
) ->
1037 all_same true tgt (mcode2line circles
) [mcode2arity circles
] in
1038 let circles = mcode circles in
1039 make_define_param param
tgt arity (Ast0.DPcircles
(circles))
1040 | Ast0.OptDParam
(dp
) | Ast0.UniqueDParam
(dp
) ->
1041 failwith
"unexpected code"
1043 and fninfo
arity = function
1044 Ast0.FStorage
(stg) -> Ast0.FStorage
(mcode stg)
1045 | Ast0.FType
(ty) -> Ast0.FType
(typeC
arity ty)
1046 | Ast0.FInline
(inline
) -> Ast0.FInline
(mcode inline
)
1047 | Ast0.FAttr
(attr
) -> Ast0.FAttr
(mcode attr
)
1049 and fninfo2arity fninfo
=
1053 Ast0.FStorage
(stg) -> [mcode2arity stg]
1054 | Ast0.FType
(ty) -> []
1055 | Ast0.FInline
(inline
) -> [mcode2arity inline
]
1056 | Ast0.FAttr
(attr
) -> [mcode2arity attr
])
1059 and whencode notfn alwaysfn expression
= function
1060 Ast0.WhenNot a
-> Ast0.WhenNot
(notfn a
)
1061 | Ast0.WhenAlways a
-> Ast0.WhenAlways
(alwaysfn a
)
1062 | Ast0.WhenModifier
(x
) -> Ast0.WhenModifier
(x
)
1063 | Ast0.WhenNotTrue a
-> Ast0.WhenNotTrue
(expression a
)
1064 | Ast0.WhenNotFalse a
-> Ast0.WhenNotFalse
(expression a
)
1066 and make_case_line
=
1068 (function x
-> Ast0.OptCase x
)
1069 (function x
-> failwith
"unique not allowed for case_line")
1071 and case_line
tgt c
=
1072 match Ast0.unwrap c
with
1073 Ast0.Default
(def,colon,code
) ->
1075 all_same true tgt (mcode2line def)
1076 [mcode2arity def; mcode2arity colon] in
1077 let def = mcode def in
1078 let colon = mcode colon in
1079 let code = dots (statement
arity) code in
1080 make_case_line c
tgt arity (Ast0.Default
(def,colon,code))
1081 | Ast0.Case
(case
,exp,colon,code) ->
1083 all_same true tgt (mcode2line case
)
1084 [mcode2arity case
; mcode2arity colon] in
1085 let case = mcode case in
1086 let exp = expression
arity exp in
1087 let colon = mcode colon in
1088 let code = dots (statement
arity) code in
1089 make_case_line c
tgt arity (Ast0.Case
(case,exp,colon,code))
1090 | Ast0.DisjCase
(starter
,case_lines
,mids
,ender
) ->
1091 let case_lines = List.map
(case_line
tgt) case_lines in
1092 (match List.rev
case_lines with
1094 if anyopt xs
(function Ast0.OptCase
(_
) -> true | _
-> false)
1095 then fail c
"opt only allowed in the last disjunct"
1097 Ast0.rewrap c
(Ast0.DisjCase
(starter
,case_lines,mids
,ender
))
1098 | Ast0.OptCase
(_
) -> failwith
"unexpected OptCase"
1100 (* --------------------------------------------------------------------- *)
1101 (* Function declaration *)
1102 (* Haven't thought much about arity here... *)
1104 let top_level tgt t
=
1106 (match Ast0.unwrap t
with
1107 Ast0.FILEINFO
(old_file
,new_file
) ->
1108 if mcode2arity old_file
= Ast0.NONE
&& mcode2arity new_file
= Ast0.NONE
1109 then Ast0.FILEINFO
(mcode old_file
,mcode new_file
)
1110 else fail t
"unexpected arity for file info"
1111 | Ast0.DECL
(stmt
) ->
1112 Ast0.DECL
(statement
tgt stmt
)
1113 | Ast0.CODE
(rule_elem_dots
) ->
1114 Ast0.CODE
(concat_dots (statement
tgt) rule_elem_dots
)
1115 | Ast0.ERRORWORDS
(exps) ->
1116 Ast0.ERRORWORDS
(List.map
(top_expression false Ast0.NONE
) exps)
1117 | Ast0.OTHER
(_
) -> fail t
"eliminated by top_level")
1119 let rule tgt = List.map
(top_level tgt)
1121 (* --------------------------------------------------------------------- *)
1124 let minus_arity code =