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 code in a nest (in_nest = true). ? only allowed on
28 rule_elems, and on subterms if the context is ? also. *)
30 module Ast0
= Ast0_cocci
31 module Ast
= Ast_cocci
32 module V0
= Visitor_ast0
33 module VT0
= Visitor_ast0_types
35 let unitary = Type_cocci.Unitary
43 (* --------------------------------------------------------------------- *)
44 (* Move plus tokens from the MINUS and CONTEXT structured nodes to the
45 corresponding leftmost and rightmost mcodes *)
49 let option_default = () in
51 let do_nothing r k e
=
53 let einfo = Ast0.get_info e
in
54 match (Ast0.get_mcodekind e
) with
55 Ast0.MINUS
(replacements
) ->
56 (match !replacements
with
57 (Ast.NOREPLACEMENT
,_
) -> ()
59 let minus_try = function
63 Ast0.MINUS
(mreplacements
) -> true | _
-> false)
68 Ast0.MINUS
(mreplacements
) ->
69 mreplacements
:= replacements
75 if not
(minus_try(einfo.Ast0.attachable_start
,
76 einfo.Ast0.mcode_start
)
78 minus_try(einfo.Ast0.attachable_end
,
79 einfo.Ast0.mcode_end
))
81 failwith
"minus tree should not have bad code on both sides")
82 | Ast0.CONTEXT
(befaft
)
83 | Ast0.MIXED
(befaft
) ->
84 let concat starter startinfo ender endinfo
=
86 match (starter
,ender
) with
90 if startinfo
.Ast0.tline_end
= endinfo
.Ast0.tline_start
91 then (* put them in the same inner list *)
92 let last = List.hd
(List.rev starter
) in
93 let butlast = List.rev
(List.tl
(List.rev starter
)) in
94 butlast @ (last@(List.hd ender
)) :: (List.tl ender
)
95 else starter
@ ender
in
97 {endinfo
with Ast0.tline_start
= startinfo
.Ast0.tline_start
}) in
98 let attach_bef bef beforeinfo befit
= function
102 Ast0.MINUS
(mreplacements
) ->
103 (match !mreplacements
with
104 (Ast.NOREPLACEMENT
,tokeninfo
) ->
106 (Ast.REPLACEMENT
(bef
,befit
),beforeinfo
)
107 | (Ast.REPLACEMENT
(anythings
,it
),tokeninfo
) ->
108 let (newbef
,newinfo
) =
109 concat bef beforeinfo anythings tokeninfo
in
110 let it = Ast.lub_count befit
it in
112 (Ast.REPLACEMENT
(newbef
,it),newinfo
))
113 | Ast0.CONTEXT
(mbefaft
) ->
115 (Ast.BEFORE
(mbef
,it),mbeforeinfo
,a
) ->
116 let (newbef
,newinfo
) =
117 concat bef beforeinfo mbef mbeforeinfo
in
118 let it = Ast.lub_count befit
it in
119 mbefaft
:= (Ast.BEFORE
(newbef
,it),newinfo
,a
)
120 | (Ast.AFTER
(maft
,it),_
,a
) ->
121 let it = Ast.lub_count befit
it in
123 (Ast.BEFOREAFTER
(bef
,maft
,it),beforeinfo
,a
)
124 | (Ast.BEFOREAFTER
(mbef
,maft
,it),mbeforeinfo
,a
) ->
125 let (newbef
,newinfo
) =
126 concat bef beforeinfo mbef mbeforeinfo
in
127 let it = Ast.lub_count befit
it in
129 (Ast.BEFOREAFTER
(newbef
,maft
,it),newinfo
,a
)
130 | (Ast.NOTHING
,_
,a
) ->
132 (Ast.BEFORE
(bef
,befit
),beforeinfo
,a
))
133 | _
-> failwith
"unexpected annotation")
136 Printf.printf
"before %s\n" (Dumper.dump bef
);
138 "context tree should not have bad code before" in
139 let attach_aft aft afterinfo aftit
= function
143 Ast0.MINUS
(mreplacements
) ->
144 (match !mreplacements
with
145 (Ast.NOREPLACEMENT
,tokeninfo
) ->
147 (Ast.REPLACEMENT
(aft
,aftit
),afterinfo
)
148 | (Ast.REPLACEMENT
(anythings
,it),tokeninfo
) ->
149 let (newaft
,newinfo
) =
150 concat anythings tokeninfo aft afterinfo
in
151 let it = Ast.lub_count aftit
it in
153 (Ast.REPLACEMENT
(newaft
,it),newinfo
))
154 | Ast0.CONTEXT
(mbefaft
) ->
156 (Ast.BEFORE
(mbef
,it),b
,_
) ->
157 let it = Ast.lub_count aftit
it in
159 (Ast.BEFOREAFTER
(mbef
,aft
,it),b
,afterinfo
)
160 | (Ast.AFTER
(maft
,it),b
,mafterinfo
) ->
161 let (newaft
,newinfo
) =
162 concat maft mafterinfo aft afterinfo
in
163 let it = Ast.lub_count aftit
it in
164 mbefaft
:= (Ast.AFTER
(newaft
,it),b
,newinfo
)
165 | (Ast.BEFOREAFTER
(mbef
,maft
,it),b
,mafterinfo
) ->
166 let (newaft
,newinfo
) =
167 concat maft mafterinfo aft afterinfo
in
168 let it = Ast.lub_count aftit
it in
170 (Ast.BEFOREAFTER
(mbef
,newaft
,it),b
,newinfo
)
171 | (Ast.NOTHING
,b
,_
) ->
172 mbefaft
:= (Ast.AFTER
(aft
,aftit
),b
,afterinfo
))
173 | _
-> failwith
"unexpected annotation")
177 "context tree should not have bad code after" in
179 (Ast.BEFORE
(bef
,it),beforeinfo
,_
) ->
180 attach_bef bef beforeinfo
it
181 (einfo.Ast0.attachable_start
,einfo.Ast0.mcode_start
)
182 | (Ast.AFTER
(aft
,it),_
,afterinfo
) ->
183 attach_aft aft afterinfo
it
184 (einfo.Ast0.attachable_end
,einfo.Ast0.mcode_end
)
185 | (Ast.BEFOREAFTER
(bef
,aft
,it),beforeinfo
,afterinfo
) ->
186 attach_bef bef beforeinfo
it
187 (einfo.Ast0.attachable_start
,einfo.Ast0.mcode_start
);
188 attach_aft aft afterinfo
it
189 (einfo.Ast0.attachable_end
,einfo.Ast0.mcode_end
)
190 | (Ast.NOTHING
,_
,_
) -> ())
191 | Ast0.PLUS _
-> () in
192 V0.flat_combiner
bind option_default
193 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
195 do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
196 do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
197 do_nothing do_nothing do_nothing
199 (* --------------------------------------------------------------------- *)
200 (* For function declarations. Can't use the mcode at the root, because that
201 might be mixed when the function contains ()s, where agglomeration of -s is
205 let donothing r k e
= k e
in
206 let bind x y
= x
&& y
in
207 let option_default = true in
208 let mcode (_
,_
,_
,mc
,_
,_
) =
210 Ast0.MINUS
(r
) -> let (plusses
,_
) = !r
in plusses
= Ast.NOREPLACEMENT
213 (* special case for disj *)
215 match Ast0.unwrap e
with
216 Ast0.DisjId
(starter
,id_list
,mids
,ender
) ->
217 List.for_all r
.VT0.combiner_rec_ident id_list
220 let expression r k e
=
221 match Ast0.unwrap e
with
222 Ast0.DisjExpr
(starter
,expr_list
,mids
,ender
) ->
223 List.for_all r
.VT0.combiner_rec_expression expr_list
226 let declaration r k e
=
227 match Ast0.unwrap e
with
228 Ast0.DisjDecl
(starter
,decls
,mids
,ender
) ->
229 List.for_all r
.VT0.combiner_rec_declaration decls
233 match Ast0.unwrap e
with
234 Ast0.DisjType
(starter
,decls
,mids
,ender
) ->
235 List.for_all r
.VT0.combiner_rec_typeC decls
238 let statement r k e
=
239 match Ast0.unwrap e
with
240 Ast0.Disj
(starter
,statement_dots_list
,mids
,ender
) ->
241 List.for_all r
.VT0.combiner_rec_statement_dots statement_dots_list
244 let case_line r k e
=
245 match Ast0.unwrap e
with
246 Ast0.DisjCase
(starter
,case_lines
,mids
,ender
) ->
247 List.for_all r
.VT0.combiner_rec_case_line case_lines
250 V0.flat_combiner
bind option_default
251 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
253 donothing donothing donothing donothing donothing donothing
254 ident expression typeC donothing donothing declaration
255 statement case_line donothing
257 (* --------------------------------------------------------------------- *)
258 (* --------------------------------------------------------------------- *)
260 let get_option fn
= function
262 | Some x
-> Some
(fn x
)
264 (* --------------------------------------------------------------------- *)
265 (* --------------------------------------------------------------------- *)
268 let convert_info info
=
271 (function (s
,info
) -> (s
,info
.Ast0.line_start
,info
.Ast0.column
))
273 { Ast.line
= info
.Ast0.pos_info
.Ast0.line_start
;
274 Ast.column
= info
.Ast0.pos_info
.Ast0.column
;
275 Ast.strbef
= strings_to_s info
.Ast0.strings_before
;
276 Ast.straft
= strings_to_s info
.Ast0.strings_after
;}
278 let convert_mcodekind adj
= function
279 Ast0.MINUS
(replacements
) ->
280 let (replacements
,_
) = !replacements
in
281 Ast.MINUS
(Ast.NoPos
,[],Ast.ADJ adj
,replacements
)
282 | Ast0.PLUS count
-> Ast.PLUS count
283 | Ast0.CONTEXT
(befaft
) ->
284 let (befaft
,_
,_
) = !befaft
in
285 Ast.CONTEXT
(Ast.NoPos
,befaft
)
286 | Ast0.MIXED
(_
) -> failwith
"not possible for mcode"
288 let convert_allminus_mcodekind allminus
= function
289 Ast0.CONTEXT
(befaft
) ->
290 let (befaft
,_
,_
) = !befaft
in
295 Ast.MINUS
(Ast.NoPos
,[],Ast.ALLMINUS
,Ast.NOREPLACEMENT
)
296 | Ast.BEFORE
(a
,ct
) | Ast.AFTER
(a
,ct
) ->
297 Ast.MINUS
(Ast.NoPos
,[],Ast.ALLMINUS
,Ast.REPLACEMENT
(a
,ct
))
298 | Ast.BEFOREAFTER
(b
,a
,ct
) ->
299 Ast.MINUS
(Ast.NoPos
,[],Ast.ALLMINUS
,Ast.REPLACEMENT
(b
@a
,ct
)))
300 else Ast.CONTEXT
(Ast.NoPos
,befaft
)
301 | _
-> failwith
"convert_allminus_mcodekind: unexpected mcodekind"
303 let pos_mcode(term
,_
,info
,mcodekind
,pos
,adj
) =
304 (* avoids a recursion problem *)
305 (term
,convert_info info
,convert_mcodekind adj mcodekind
,[])
307 let mcode (term
,_
,info
,mcodekind
,pos
,adj
) =
310 (function Ast0.MetaPos
(pos,constraints
,per
) ->
311 Ast.MetaPos
(pos_mcode pos,constraints
,per
,unitary,false))
313 (term
,convert_info info
,convert_mcodekind adj mcodekind
,pos)
315 (* --------------------------------------------------------------------- *)
317 let wrap ast line isos
=
318 {(Ast.make_term ast
) with Ast.node_line
= line
;
321 let rewrap ast0 isos ast
=
322 wrap ast
((Ast0.get_info ast0
).Ast0.pos_info
.Ast0.line_start
) isos
326 (* no isos on tokens *)
327 let tokenwrap (_
,info
,_
,_
) s ast
= wrap ast info
.Ast.line
no_isos
328 let iso_tokenwrap (_
,info
,_
,_
) s ast iso
= wrap ast info
.Ast.line iso
332 (match Ast0.unwrap d
with
333 Ast0.DOTS
(x
) -> Ast.DOTS
(List.map fn x
)
334 | Ast0.CIRCLES
(x
) -> Ast.CIRCLES
(List.map fn x
)
335 | Ast0.STARS
(x
) -> Ast.STARS
(List.map fn x
))
337 (* commas in dotted lists, here due to polymorphism restrictions *)
339 let add_comma is_comma make_comma itemlist
=
340 match Ast0.unwrap itemlist
with
342 (match List.rev x
with
349 match Ast0.get_mcodekind e
with
350 Ast0.MINUS
(_
) -> (Ast0.make_minus_mcode
",")
351 | _
-> (Ast0.make_mcode
",") in
354 (List.rev
(Ast0.rewrap e
(make_comma
comma) :: (e
::es
)))))
355 | _
-> failwith
"not possible"
359 (function x
-> match Ast0.unwrap x
with Ast0.EComma _
-> true | _
-> false)
360 (function x
-> Ast0.EComma x
)
364 (function x
-> match Ast0.unwrap x
with Ast0.IComma _
-> true | _
-> false)
365 (function x
-> Ast0.IComma x
)
367 (* --------------------------------------------------------------------- *)
370 let rec do_isos l
= List.map
(function (nm
,x
) -> (nm
,anything x
)) l
373 rewrap i
(do_isos (Ast0.get_iso i
))
374 (match Ast0.unwrap i
with
375 Ast0.Id
(name
) -> Ast.Id
(mcode name
)
376 | Ast0.DisjId
(_
,id_list
,_
,_
) ->
377 Ast.DisjId
(List.map
ident id_list
)
378 | Ast0.MetaId
(name
,constraints
,_
,_
) ->
379 Ast.MetaId
(mcode name
,constraints
,unitary,false)
380 | Ast0.MetaFunc
(name
,constraints
,_
) ->
381 Ast.MetaFunc
(mcode name
,constraints
,unitary,false)
382 | Ast0.MetaLocalFunc
(name
,constraints
,_
) ->
383 Ast.MetaLocalFunc
(mcode name
,constraints
,unitary,false)
384 | Ast0.OptIdent
(id
) -> Ast.OptIdent
(ident id
)
385 | Ast0.UniqueIdent
(id
) -> Ast.UniqueIdent
(ident id
))
387 (* --------------------------------------------------------------------- *)
392 rewrap e
(do_isos (Ast0.get_iso e
))
393 (match Ast0.unwrap e
with
394 Ast0.Ident
(id
) -> Ast.Ident
(ident id
)
395 | Ast0.Constant
(const
) ->
396 Ast.Constant
(mcode const
)
397 | Ast0.FunCall
(fn
,lp
,args
,rp
) ->
398 let fn = expression fn in
400 let args = dots expression args in
402 Ast.FunCall
(fn,lp,args,rp)
403 | Ast0.Assignment
(left
,op
,right
,simple
) ->
404 Ast.Assignment
(expression left
,mcode op
,expression right
,simple
)
405 | Ast0.CondExpr
(exp1
,why
,exp2
,colon
,exp3
) ->
406 let exp1 = expression exp1 in
407 let why = mcode why in
408 let exp2 = get_option expression exp2 in
409 let colon = mcode colon in
410 let exp3 = expression exp3 in
411 Ast.CondExpr
(exp1,why,exp2,colon,exp3)
412 | Ast0.Postfix
(exp
,op
) ->
413 Ast.Postfix
(expression exp
,mcode op
)
414 | Ast0.Infix
(exp
,op
) ->
415 Ast.Infix
(expression exp
,mcode op
)
416 | Ast0.Unary
(exp
,op
) ->
417 Ast.Unary
(expression exp
,mcode op
)
418 | Ast0.Binary
(left
,op
,right
) ->
419 Ast.Binary
(expression left
,mcode op
,expression right
)
420 | Ast0.Nested
(left
,op
,right
) ->
421 Ast.Nested
(expression left
,mcode op
,expression right
)
422 | Ast0.Paren
(lp,exp
,rp) ->
423 Ast.Paren
(mcode lp,expression exp
,mcode rp)
424 | Ast0.ArrayAccess
(exp1,lb
,exp2,rb
) ->
425 Ast.ArrayAccess
(expression exp1,mcode lb
,expression exp2,mcode rb
)
426 | Ast0.RecordAccess
(exp
,pt
,field
) ->
427 Ast.RecordAccess
(expression exp
,mcode pt
,ident field
)
428 | Ast0.RecordPtAccess
(exp
,ar
,field
) ->
429 Ast.RecordPtAccess
(expression exp
,mcode ar
,ident field
)
430 | Ast0.Cast
(lp,ty
,rp,exp
) ->
431 Ast.Cast
(mcode lp,typeC ty
,mcode rp,expression exp
)
432 | Ast0.SizeOfExpr
(szf
,exp
) ->
433 Ast.SizeOfExpr
(mcode szf
,expression exp
)
434 | Ast0.SizeOfType
(szf
,lp,ty
,rp) ->
435 Ast.SizeOfType
(mcode szf
, mcode lp,typeC ty
,mcode rp)
436 | Ast0.TypeExp
(ty
) -> Ast.TypeExp
(typeC ty
)
437 | Ast0.MetaErr
(name
,cstrts
,_
) ->
438 Ast.MetaErr
(mcode name
,constraints cstrts
,unitary,false)
439 | Ast0.MetaExpr
(name
,cstrts
,ty
,form
,_
) ->
440 Ast.MetaExpr
(mcode name
,constraints cstrts
,unitary,ty
,form
,false)
441 | Ast0.MetaExprList
(name
,lenname
,_
) ->
442 Ast.MetaExprList
(mcode name
,do_lenname lenname
,unitary,false)
443 | Ast0.EComma
(cm
) -> Ast.EComma
(mcode cm
)
444 | Ast0.DisjExpr
(_
,exps
,_
,_
) ->
445 Ast.DisjExpr
(List.map
expression exps
)
446 | Ast0.NestExpr
(starter
,exp_dots
,ender
,whencode
,multi
) ->
447 let starter = mcode starter in
448 let whencode = get_option expression whencode in
449 let ender = mcode ender in
450 Ast.NestExpr
(starter,dots expression exp_dots
,ender,whencode,multi
)
451 | Ast0.Edots
(dots,whencode) ->
452 let dots = mcode dots in
453 let whencode = get_option expression whencode in
454 Ast.Edots
(dots,whencode)
455 | Ast0.Ecircles
(dots,whencode) ->
456 let dots = mcode dots in
457 let whencode = get_option expression whencode in
458 Ast.Ecircles
(dots,whencode)
459 | Ast0.Estars
(dots,whencode) ->
460 let dots = mcode dots in
461 let whencode = get_option expression whencode in
462 Ast.Estars
(dots,whencode)
463 | Ast0.OptExp
(exp
) -> Ast.OptExp
(expression exp
)
464 | Ast0.UniqueExp
(exp
) -> Ast.UniqueExp
(expression exp
)) in
465 if Ast0.get_test_exp e
then Ast.set_test_exp
e1 else e1
467 and expression_dots ed
= dots expression ed
471 Ast0.NoConstraint
-> Ast.NoConstraint
472 | Ast0.NotIdCstrt idctrt
-> Ast.NotIdCstrt idctrt
473 | Ast0.NotExpCstrt exps
-> Ast.NotExpCstrt
(List.map
expression exps
)
474 | Ast0.SubExpCstrt ids
-> Ast.SubExpCstrt ids
476 and do_lenname
= function
477 Ast0.MetaListLen
(nm
) -> Ast.MetaListLen
(mcode nm
,unitary,false)
478 | Ast0.CstListLen n
-> Ast.CstListLen n
479 | Ast0.AnyListLen
-> Ast.AnyListLen
481 (* --------------------------------------------------------------------- *)
484 and rewrap_iso t t1
= rewrap t
(do_isos (Ast0.get_iso t
)) t1
487 rewrap t
(do_isos (Ast0.get_iso t
))
488 (match Ast0.unwrap t
with
489 Ast0.ConstVol
(cv
,ty
) ->
490 let rec collect_disjs t
=
491 match Ast0.unwrap t
with
492 Ast0.DisjType
(_
,types
,_
,_
) ->
493 if Ast0.get_iso t
= []
494 then List.concat (List.map
collect_disjs types
)
495 else failwith
"unexpected iso on a disjtype"
501 (Some
(mcode cv
),rewrap_iso ty
(base_typeC ty
)))
502 (collect_disjs ty
) in
503 (* one could worry that isos are lost because we flatten the
504 disjunctions. but there should not be isos on the disjunctions
508 | types
-> Ast.DisjType
(List.map
(rewrap t
no_isos) types
))
509 | Ast0.BaseType
(_
) | Ast0.Signed
(_
,_
) | Ast0.Pointer
(_
,_
)
510 | Ast0.FunctionPointer
(_
,_
,_
,_
,_
,_
,_
) | Ast0.FunctionType
(_
,_
,_
,_
)
511 | Ast0.Array
(_
,_
,_
,_
) | Ast0.EnumName
(_
,_
) | Ast0.StructUnionName
(_
,_
)
512 | Ast0.StructUnionDef
(_
,_
,_
,_
) | Ast0.EnumDef
(_
,_
,_
,_
)
513 | Ast0.TypeName
(_
) | Ast0.MetaType
(_
,_
) ->
514 Ast.Type
(None
,rewrap t
no_isos (base_typeC t
))
515 | Ast0.DisjType
(_
,types
,_
,_
) -> Ast.DisjType
(List.map
typeC types
)
516 | Ast0.OptType
(ty
) -> Ast.OptType
(typeC ty
)
517 | Ast0.UniqueType
(ty
) -> Ast.UniqueType
(typeC ty
))
520 match Ast0.unwrap t
with
521 Ast0.BaseType
(ty
,strings
) -> Ast.BaseType
(ty
,List.map
mcode strings
)
522 | Ast0.Signed
(sgn
,ty
) ->
523 Ast.SignedT
(mcode sgn
,
524 get_option (function x
-> rewrap_iso x
(base_typeC x
)) ty
)
525 | Ast0.Pointer
(ty
,star
) -> Ast.Pointer
(typeC ty
,mcode star
)
526 | Ast0.FunctionPointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
528 (typeC ty
,mcode lp1
,mcode star
,mcode rp1
,
529 mcode lp2
,parameter_list params
,mcode rp2
)
530 | Ast0.FunctionType
(ret
,lp,params
,rp) ->
531 let allminus = check_allminus.VT0.combiner_rec_typeC t
in
533 (allminus,get_option typeC ret
,mcode lp,
534 parameter_list params
,mcode rp)
535 | Ast0.Array
(ty
,lb
,size
,rb
) ->
536 Ast.Array
(typeC ty
,mcode lb
,get_option expression size
,mcode rb
)
537 | Ast0.EnumName
(kind
,name
) ->
538 Ast.EnumName
(mcode kind
,get_option ident name
)
539 | Ast0.EnumDef
(ty
,lb
,ids
,rb
) ->
540 let ids = add_exp_comma ids in
541 Ast.EnumDef
(typeC ty
,mcode lb
,dots expression ids,mcode rb
)
542 | Ast0.StructUnionName
(kind
,name
) ->
543 Ast.StructUnionName
(mcode kind
,get_option ident name
)
544 | Ast0.StructUnionDef
(ty
,lb
,decls
,rb
) ->
545 Ast.StructUnionDef
(typeC ty
,mcode lb
,
546 dots declaration decls
,
548 | Ast0.TypeName
(name
) -> Ast.TypeName
(mcode name
)
549 | Ast0.MetaType
(name
,_
) ->
550 Ast.MetaType
(mcode name
,unitary,false)
551 | _
-> failwith
"ast0toast: unexpected type"
553 (* --------------------------------------------------------------------- *)
554 (* Variable declaration *)
555 (* Even if the Cocci program specifies a list of declarations, they are
556 split out into multiple declarations of a single variable each. *)
559 rewrap d
(do_isos (Ast0.get_iso d
))
560 (match Ast0.unwrap d
with
561 Ast0.MetaDecl
(name
,_
) -> Ast.MetaDecl
(mcode name
,unitary,false)
562 | Ast0.MetaField
(name
,_
) -> Ast.MetaField
(mcode name
,unitary,false)
563 | Ast0.MetaFieldList
(name
,lenname
,_
) ->
564 Ast.MetaFieldList
(mcode name
,do_lenname lenname
,unitary,false)
565 | Ast0.Init
(stg
,ty
,id
,eq
,ini
,sem
) ->
566 let stg = get_option mcode stg in
570 let ini = initialiser
ini in
571 let sem = mcode sem in
572 Ast.Init
(stg,ty,id,eq,ini,sem)
573 | Ast0.UnInit
(stg,ty,id,sem) ->
574 (match Ast0.unwrap
ty with
575 Ast0.FunctionType
(tyx
,lp1
,params
,rp1
) ->
576 let allminus = check_allminus.VT0.combiner_rec_declaration d
in
577 Ast.UnInit
(get_option mcode stg,
578 rewrap ty (do_isos (Ast0.get_iso
ty))
583 (allminus,get_option typeC tyx
,mcode lp1
,
584 parameter_list params
,mcode rp1
)))),
586 | _
-> Ast.UnInit
(get_option mcode stg,typeC ty,ident id,mcode sem))
587 | Ast0.MacroDecl
(name
,lp,args,rp,sem) ->
588 let name = ident name in
590 let args = dots expression args in
592 let sem = mcode sem in
593 Ast.MacroDecl
(name,lp,args,rp,sem)
594 | Ast0.TyDecl
(ty,sem) -> Ast.TyDecl
(typeC ty,mcode sem)
595 | Ast0.Typedef
(stg,ty,id,sem) ->
597 (match Ast.unwrap
id with
598 Ast.Type
(None
,id) -> (* only MetaType or Id *)
599 Ast.Typedef
(mcode stg,typeC ty,id,mcode sem)
600 | _
-> failwith
"bad typedef")
601 | Ast0.DisjDecl
(_
,decls
,_
,_
) -> Ast.DisjDecl
(List.map
declaration decls
)
602 | Ast0.Ddots
(dots,whencode) ->
603 let dots = mcode dots in
604 let whencode = get_option declaration whencode in
605 Ast.Ddots
(dots,whencode)
606 | Ast0.OptDecl
(decl
) -> Ast.OptDecl
(declaration decl
)
607 | Ast0.UniqueDecl
(decl
) -> Ast.UniqueDecl
(declaration decl
))
609 and declaration_dots l
= dots declaration l
611 (* --------------------------------------------------------------------- *)
614 and strip_idots initlist
=
616 match Ast0.get_mcode_mcodekind mc
with
619 match Ast0.unwrap initlist
with
622 match List.rev
l with
625 (match (Ast0.unwrap x
,Ast0.unwrap y
) with
626 (Ast0.IComma _
,Ast0.Idots _
) ->
627 (* drop comma that was added by add_comma *)
630 let (whencode,init
,dotinfo
) =
631 let rec loop = function
634 (match Ast0.unwrap x
with
635 Ast0.Idots
(dots,Some
whencode) ->
636 let (restwhen
,restinit
,dotinfo
) = loop rest
in
637 (whencode :: restwhen
, restinit
,
638 (isminus dots)::dotinfo
)
639 | Ast0.Idots
(dots,None
) ->
640 let (restwhen
,restinit
,dotinfo
) = loop rest
in
641 (restwhen
, restinit
, (isminus dots)::dotinfo
)
643 let (restwhen
,restinit
,dotinfo
) = loop rest
in
644 (restwhen
,x
::restinit
,dotinfo
)) in
647 if List.for_all
(function x
-> not x
) dotinfo
648 then false (* false if no dots *)
650 if List.for_all
(function x
-> x
) dotinfo
652 else failwith
"inconsistent annotations on initialiser list dots" in
653 (whencode, init
, allminus)
654 | Ast0.CIRCLES
(x
) | Ast0.STARS
(x
) -> failwith
"not possible for an initlist"
658 (match Ast0.unwrap i
with
659 Ast0.MetaInit
(name,_
) -> Ast.MetaInit
(mcode name,unitary,false)
660 | Ast0.MetaInitList
(name,lenname
,_
) ->
661 Ast.MetaInitList
(mcode name,do_lenname lenname
,unitary,false)
662 | Ast0.InitExpr
(exp
) -> Ast.InitExpr
(expression exp
)
663 | Ast0.InitList
(lb
,initlist
,rb
,true) ->
664 let initlist = add_init_comma
initlist in
665 Ast.ArInitList
(mcode lb
,dots initialiser
initlist,mcode rb
)
666 | Ast0.InitList
(lb
,initlist,rb
,false) ->
667 let initlist = add_init_comma
initlist in
668 let (whencode,initlist,allminus) = strip_idots
initlist in
670 (allminus,mcode lb
,List.map initialiser
initlist,mcode rb
,
671 List.map initialiser
whencode)
672 | Ast0.InitGccExt
(designators
,eq,ini) ->
673 Ast.InitGccExt
(List.map designator designators
,mcode eq,
675 | Ast0.InitGccName
(name,eq,ini) ->
676 Ast.InitGccName
(ident name,mcode eq,initialiser
ini)
677 | Ast0.IComma
(comma) -> Ast.IComma
(mcode comma)
678 | Ast0.Idots
(dots,whencode) ->
679 let dots = mcode dots in
680 let whencode = get_option initialiser
whencode in
681 Ast.Idots
(dots,whencode)
682 | Ast0.OptIni
(ini) -> Ast.OptIni
(initialiser
ini)
683 | Ast0.UniqueIni
(ini) -> Ast.UniqueIni
(initialiser
ini))
685 and designator
= function
686 Ast0.DesignatorField
(dot
,id) -> Ast.DesignatorField
(mcode dot
,ident id)
687 | Ast0.DesignatorIndex
(lb
,exp
,rb
) ->
688 Ast.DesignatorIndex
(mcode lb
, expression exp
, mcode rb
)
689 | Ast0.DesignatorRange
(lb
,min
,dots,max
,rb
) ->
690 Ast.DesignatorRange
(mcode lb
,expression min
,mcode dots,expression max
,
693 (* --------------------------------------------------------------------- *)
696 and parameterTypeDef p
=
698 (match Ast0.unwrap p
with
699 Ast0.VoidParam
(ty) -> Ast.VoidParam
(typeC ty)
700 | Ast0.Param
(ty,id) -> Ast.Param
(typeC ty,get_option ident id)
701 | Ast0.MetaParam
(name,_
) ->
702 Ast.MetaParam
(mcode name,unitary,false)
703 | Ast0.MetaParamList
(name,lenname
,_
) ->
704 Ast.MetaParamList
(mcode name,do_lenname lenname
,unitary,false)
705 | Ast0.PComma
(cm
) -> Ast.PComma
(mcode cm
)
706 | Ast0.Pdots
(dots) -> Ast.Pdots
(mcode dots)
707 | Ast0.Pcircles
(dots) -> Ast.Pcircles
(mcode dots)
708 | Ast0.OptParam
(param
) -> Ast.OptParam
(parameterTypeDef param
)
709 | Ast0.UniqueParam
(param
) -> Ast.UniqueParam
(parameterTypeDef param
))
711 and parameter_list
l = dots parameterTypeDef
l
713 (* --------------------------------------------------------------------- *)
717 let rec statement seqible s
=
718 let rewrap_stmt ast0 ast
=
720 match Ast0.get_dots_bef_aft s
with
721 Ast0.NoDots
-> Ast.NoDots
722 | Ast0.DroppingBetweenDots s
->
723 Ast.DroppingBetweenDots
(statement seqible s
,get_ctr())
724 | Ast0.AddingBetweenDots s
->
725 Ast.AddingBetweenDots
(statement seqible s
,get_ctr()) in
726 Ast.set_dots_bef_aft
befaft (rewrap ast0
no_isos ast
) in
727 let rewrap_rule_elem ast0 ast
=
728 rewrap ast0
(do_isos (Ast0.get_iso ast0
)) ast
in
730 (match Ast0.unwrap s
with
731 Ast0.Decl
((_
,bef
),decl
) ->
732 let allminus = check_allminus.VT0.combiner_rec_statement s
in
733 Ast.Atomic
(rewrap_rule_elem s
734 (Ast.Decl
(convert_allminus_mcodekind allminus bef
,
735 allminus,declaration decl
)))
736 | Ast0.Seq
(lbrace
,body
,rbrace
) ->
737 let lbrace = mcode lbrace in
738 let body = dots (statement seqible
) body in
739 let rbrace = mcode rbrace in
740 Ast.Seq
(iso_tokenwrap lbrace s
(Ast.SeqStart
(lbrace))
741 (do_isos (Ast0.get_iso s
)),
743 tokenwrap rbrace s
(Ast.SeqEnd
(rbrace)))
744 | Ast0.ExprStatement
(exp
,sem) ->
745 Ast.Atomic
(rewrap_rule_elem s
746 (Ast.ExprStatement
(get_option expression exp
,mcode sem)))
747 | Ast0.IfThen
(iff
,lp,exp
,rp,branch
,(_
,aft
)) ->
750 (Ast.IfHeader
(mcode iff
,mcode lp,expression exp
,mcode rp)),
751 statement Ast.NotSequencible branch
,
752 ([],[],[],convert_mcodekind (-1) aft
))
753 | Ast0.IfThenElse
(iff
,lp,exp
,rp,branch1
,els
,branch2
,(_
,aft
)) ->
754 let els = mcode els in
757 (Ast.IfHeader
(mcode iff
,mcode lp,expression exp
,mcode rp)),
758 statement Ast.NotSequencible branch1
,
759 tokenwrap els s
(Ast.Else
(els)),
760 statement Ast.NotSequencible branch2
,
761 ([],[],[],convert_mcodekind (-1) aft
))
762 | Ast0.While
(wh
,lp,exp
,rp,body,(_
,aft
)) ->
763 Ast.While
(rewrap_rule_elem s
765 (mcode wh
,mcode lp,expression exp
,mcode rp)),
766 statement Ast.NotSequencible
body,
767 ([],[],[],convert_mcodekind (-1) aft
))
768 | Ast0.Do
(d
,body,wh
,lp,exp
,rp,sem) ->
770 Ast.Do
(rewrap_rule_elem s
(Ast.DoHeader
(mcode d
)),
771 statement Ast.NotSequencible
body,
773 (Ast.WhileTail
(wh,mcode lp,expression exp
,mcode rp,
775 | Ast0.For
(fr
,lp,exp1,sem1
,exp2,sem2
,exp3,rp,body,(_
,aft
)) ->
778 let exp1 = get_option expression exp1 in
779 let sem1 = mcode sem1 in
780 let exp2 = get_option expression exp2 in
781 let sem2= mcode sem2 in
782 let exp3 = get_option expression exp3 in
784 let body = statement Ast.NotSequencible
body in
785 Ast.For
(rewrap_rule_elem s
786 (Ast.ForHeader
(fr,lp,exp1,sem1,exp2,sem2,exp3,rp)),
787 body,([],[],[],convert_mcodekind (-1) aft
))
788 | Ast0.Iterator
(nm
,lp,args,rp,body,(_
,aft
)) ->
789 Ast.Iterator
(rewrap_rule_elem s
792 dots expression args,
794 statement Ast.NotSequencible
body,
795 ([],[],[],convert_mcodekind (-1) aft
))
796 | Ast0.Switch
(switch
,lp,exp
,rp,lb
,decls
,cases
,rb
) ->
797 let switch = mcode switch in
799 let exp = expression exp in
802 let decls = dots (statement seqible
) decls in
803 let cases = List.map
case_line (Ast0.undots
cases) in
805 Ast.Switch
(rewrap_rule_elem s
(Ast.SwitchHeader
(switch,lp,exp,rp)),
806 tokenwrap lb s
(Ast.SeqStart
(lb)),
808 tokenwrap rb s
(Ast.SeqEnd
(rb)))
809 | Ast0.Break
(br
,sem) ->
810 Ast.Atomic
(rewrap_rule_elem s
(Ast.Break
(mcode br
,mcode sem)))
811 | Ast0.Continue
(cont
,sem) ->
812 Ast.Atomic
(rewrap_rule_elem s
(Ast.Continue
(mcode cont
,mcode sem)))
813 | Ast0.Label
(l,dd
) ->
814 Ast.Atomic
(rewrap_rule_elem s
(Ast.Label
(ident l,mcode dd
)))
815 | Ast0.Goto
(goto
,l,sem) ->
817 (rewrap_rule_elem s
(Ast.Goto
(mcode goto
,ident l,mcode sem)))
818 | Ast0.Return
(ret
,sem) ->
819 Ast.Atomic
(rewrap_rule_elem s
(Ast.Return
(mcode ret
,mcode sem)))
820 | Ast0.ReturnExpr
(ret
,exp,sem) ->
823 (Ast.ReturnExpr
(mcode ret
,expression exp,mcode sem)))
824 | Ast0.MetaStmt
(name,_
) ->
825 Ast.Atomic
(rewrap_rule_elem s
826 (Ast.MetaStmt
(mcode name,unitary,seqible
,false)))
827 | Ast0.MetaStmtList
(name,_
) ->
828 Ast.Atomic
(rewrap_rule_elem s
829 (Ast.MetaStmtList
(mcode name,unitary,false)))
830 | Ast0.TopExp
(exp) ->
831 Ast.Atomic
(rewrap_rule_elem s
(Ast.TopExp
(expression exp)))
833 Ast.Atomic
(rewrap_rule_elem s
(Ast.Exp
(expression exp)))
834 | Ast0.TopInit
(init
) ->
835 Ast.Atomic
(rewrap_rule_elem s
(Ast.TopInit
(initialiser init
)))
837 Ast.Atomic
(rewrap_rule_elem s
(Ast.Ty
(typeC ty)))
838 | Ast0.Disj
(_
,rule_elem_dots_list
,_
,_
) ->
839 Ast.Disj
(List.map
(function x
-> statement_dots seqible x
)
841 | Ast0.Nest
(starter,rule_elem_dots
,ender,whn
,multi
) ->
843 (mcode starter,statement_dots
Ast.Sequencible rule_elem_dots
,
846 (whencode (statement_dots
Ast.Sequencible
)
847 (statement Ast.NotSequencible
))
850 | Ast0.Dots
(d
,whn
) ->
854 (whencode (statement_dots
Ast.Sequencible
)
855 (statement Ast.NotSequencible
))
857 Ast.Dots
(d,whn,[],[])
858 | Ast0.Circles
(d,whn) ->
862 (whencode (statement_dots
Ast.Sequencible
)
863 (statement Ast.NotSequencible
))
865 Ast.Circles
(d,whn,[],[])
866 | Ast0.Stars
(d,whn) ->
870 (whencode (statement_dots
Ast.Sequencible
)
871 (statement Ast.NotSequencible
))
873 Ast.Stars
(d,whn,[],[])
874 | Ast0.FunDecl
((_
,bef
),fi
,name,lp,params
,rp,lbrace,body,rbrace) ->
875 let fi = List.map fninfo
fi in
876 let name = ident name in
878 let params = parameter_list
params in
880 let lbrace = mcode lbrace in
881 let body = dots (statement seqible
) body in
882 let rbrace = mcode rbrace in
883 let allminus = check_allminus.VT0.combiner_rec_statement s
in
884 Ast.FunDecl
(rewrap_rule_elem s
886 (convert_allminus_mcodekind allminus bef
,
887 allminus,fi,name,lp,params,rp)),
888 tokenwrap lbrace s
(Ast.SeqStart
(lbrace)),
890 tokenwrap rbrace s
(Ast.SeqEnd
(rbrace)))
891 | Ast0.Include
(inc
,str
) ->
892 Ast.Atomic
(rewrap_rule_elem s
(Ast.Include
(mcode inc
,mcode str
)))
893 | Ast0.Undef
(def
,id) ->
894 Ast.Atomic
(rewrap_rule_elem s
(Ast.Undef
(mcode def
,ident id)))
895 | Ast0.Define
(def
,id,params,body) ->
899 (mcode def
,ident id, define_parameters
params)),
900 statement_dots
Ast.NotSequencible
(*not sure*) body)
901 | Ast0.OptStm
(stm
) -> Ast.OptStm
(statement seqible stm
)
902 | Ast0.UniqueStm
(stm
) -> Ast.UniqueStm
(statement seqible stm
))
904 and define_parameters p
=
906 (match Ast0.unwrap p
with
907 Ast0.NoParams
-> Ast.NoParams
908 | Ast0.DParams
(lp,params,rp) ->
909 Ast.DParams
(mcode lp,
910 dots define_param
params,
915 (match Ast0.unwrap p
with
916 Ast0.DParam
(id) -> Ast.DParam
(ident id)
917 | Ast0.DPComma
(comma) -> Ast.DPComma
(mcode comma)
918 | Ast0.DPdots
(d) -> Ast.DPdots
(mcode d)
919 | Ast0.DPcircles
(c) -> Ast.DPcircles
(mcode c)
920 | Ast0.OptDParam
(dp
) -> Ast.OptDParam
(define_param dp
)
921 | Ast0.UniqueDParam
(dp
) -> Ast.UniqueDParam
(define_param dp
))
923 and whencode notfn alwaysfn
= function
924 Ast0.WhenNot a
-> Ast.WhenNot
(notfn a
)
925 | Ast0.WhenAlways a
-> Ast.WhenAlways
(alwaysfn a
)
926 | Ast0.WhenModifier
(x
) -> Ast.WhenModifier
(x
)
928 let rewrap_rule_elem ast0 ast
=
929 rewrap ast0
(do_isos (Ast0.get_iso ast0
)) ast
in
931 Ast0.WhenNotTrue
(e
) ->
932 Ast.WhenNotTrue
(rewrap_rule_elem e
(Ast.Exp
(expression e
)))
933 | Ast0.WhenNotFalse
(e
) ->
934 Ast.WhenNotFalse
(rewrap_rule_elem e
(Ast.Exp
(expression e
)))
935 | _
-> failwith
"not possible"
937 and process_list seqible isos
= function
940 let first = statement seqible x
in
942 if !Flag.track_iso_usage
943 then Ast.set_isos
first (isos
@(Ast.get_isos
first))
945 (match Ast0.unwrap x
with
946 Ast0.Dots
(_
,_
) | Ast0.Nest
(_
) ->
947 first::(process_list
(Ast.SequencibleAfterDots
[]) no_isos rest
)
949 first::(process_list
Ast.Sequencible
no_isos rest
))
951 and statement_dots seqible
d =
952 let isos = do_isos (Ast0.get_iso
d) in
954 (match Ast0.unwrap
d with
955 Ast0.DOTS
(x
) -> Ast.DOTS
(process_list seqible
isos x
)
956 | Ast0.CIRCLES
(x
) -> Ast.CIRCLES
(process_list seqible
isos x
)
957 | Ast0.STARS
(x
) -> Ast.STARS
(process_list seqible
isos x
))
959 (* the following is no longer used.
960 the goal was to let one put a statement at the very beginning of a function
961 pattern and have it skip over the declarations in the C code.
962 that feature was removed a long time ago, however, in favor of
963 ... when != S, which also causes whatever comes after it to match the
964 first real statement.
965 the separation of declarations from the rest of the body means that the
966 quantifier of any variable shared between them comes out too high, posing
967 problems when there is ... decl ... stmt, as the quantifier of any shared
968 variable will be around the whole thing, making variables not free enough
969 in the first ..., and thus not implementing the expected shortest path
970 condition. example: f() { ... int A; ... foo(A); }.
971 the quantifier for A should start just before int A, not at the top of the
973 and separate_decls seqible d =
974 let rec collect_decls = function
977 (match Ast0.unwrap x with
979 let (decls,other) = collect_decls xs in
981 | Ast0.Dots(_,_) | Ast0.Nest(_,_,_,_,_) ->
982 let (decls,other) = collect_decls xs in
985 | _ -> (x :: decls,other))
986 | Ast0.Disj(starter,stmt_dots_list,mids,ender) ->
987 let disjs = List.map collect_dot_decls stmt_dots_list in
988 let all_decls = List.for_all (function (_,s) -> s=[]) disjs in
991 let (decls,other) = collect_decls xs in
996 and collect_dot_decls d =
997 match Ast0.unwrap d with
998 Ast0.DOTS(x) -> collect_decls x
999 | Ast0.CIRCLES(x) -> collect_decls x
1000 | Ast0.STARS(x) -> collect_decls x in
1002 let process l d fn =
1003 let (decls,other) = collect_decls l in
1004 (rewrap d no_isos (fn (List.map (statement seqible) decls)),
1006 (fn (process_list seqible (do_isos (Ast0.get_iso d)) other))) in
1007 match Ast0.unwrap d with
1008 Ast0.DOTS(x) -> process x d (function x -> Ast.DOTS x)
1009 | Ast0.CIRCLES(x) -> process x d (function x -> Ast.CIRCLES x)
1010 | Ast0.STARS(x) -> process x d (function x -> Ast.STARS x) *) in
1012 statement Ast.Sequencible s
1014 and fninfo
= function
1015 Ast0.FStorage
(stg) -> Ast.FStorage
(mcode stg)
1016 | Ast0.FType
(ty) -> Ast.FType
(typeC ty)
1017 | Ast0.FInline
(inline
) -> Ast.FInline
(mcode inline
)
1018 | Ast0.FAttr
(attr
) -> Ast.FAttr
(mcode attr
)
1020 and option_to_list
= function
1026 (match Ast0.unwrap
c with
1027 Ast0.Default
(def
,colon,code
) ->
1028 let def = mcode def in
1029 let colon = mcode colon in
1030 let code = dots statement code in
1031 Ast.CaseLine
(rewrap c no_isos (Ast.Default
(def,colon)),code)
1032 | Ast0.Case
(case
,exp,colon,code) ->
1033 let case = mcode case in
1034 let exp = expression exp in
1035 let colon = mcode colon in
1036 let code = dots statement code in
1037 Ast.CaseLine
(rewrap c no_isos (Ast.Case
(case,exp,colon)),code)
1038 | Ast0.DisjCase
(_
,case_lines
,_
,_
) ->
1039 failwith
"not supported"
1040 (*Ast.CaseLine(Ast.DisjRuleElem(List.map case_line case_lines))*)
1042 | Ast0.OptCase
(case) -> Ast.OptCase
(case_line case))
1044 and statement_dots
l = dots statement l
1046 (* --------------------------------------------------------------------- *)
1048 (* what is possible is only what is at the top level in an iso *)
1049 and anything
= function
1050 Ast0.DotsExprTag
(d) -> Ast.ExprDotsTag
(expression_dots
d)
1051 | Ast0.DotsParamTag
(d) -> Ast.ParamDotsTag
(parameter_list
d)
1052 | Ast0.DotsInitTag
(d) -> failwith
"not possible"
1053 | Ast0.DotsStmtTag
(d) -> Ast.StmtDotsTag
(statement_dots
d)
1054 | Ast0.DotsDeclTag
(d) -> Ast.DeclDotsTag
(declaration_dots
d)
1055 | Ast0.DotsCaseTag
(d) -> failwith
"not possible"
1056 | Ast0.IdentTag
(d) -> Ast.IdentTag
(ident d)
1057 | Ast0.ExprTag
(d) -> Ast.ExpressionTag
(expression d)
1058 | Ast0.ArgExprTag
(d) | Ast0.TestExprTag
(d) ->
1059 failwith
"only in isos, not converted to ast"
1060 | Ast0.TypeCTag
(d) -> Ast.FullTypeTag
(typeC d)
1061 | Ast0.ParamTag
(d) -> Ast.ParamTag
(parameterTypeDef
d)
1062 | Ast0.InitTag
(d) -> Ast.InitTag
(initialiser
d)
1063 | Ast0.DeclTag
(d) -> Ast.DeclarationTag
(declaration d)
1064 | Ast0.StmtTag
(d) -> Ast.StatementTag
(statement d)
1065 | Ast0.CaseLineTag
(d) -> Ast.CaseLineTag
(case_line d)
1066 | Ast0.TopTag
(d) -> Ast.Code
(top_level
d)
1067 | Ast0.IsoWhenTag
(_
) -> failwith
"not possible"
1068 | Ast0.IsoWhenTTag
(_
) -> failwith
"not possible"
1069 | Ast0.IsoWhenFTag
(_
) -> failwith
"not possible"
1070 | Ast0.MetaPosTag _
-> failwith
"not possible"
1072 (* --------------------------------------------------------------------- *)
1073 (* Function declaration *)
1074 (* top level isos are probably lost to tracking *)
1078 (match Ast0.unwrap t
with
1079 Ast0.FILEINFO
(old_file
,new_file
) ->
1080 Ast.FILEINFO
(mcode old_file
,mcode new_file
)
1081 | Ast0.DECL
(stmt
) -> Ast.DECL
(statement stmt
)
1082 | Ast0.CODE
(rule_elem_dots
) ->
1083 Ast.CODE
(statement_dots rule_elem_dots
)
1084 | Ast0.ERRORWORDS
(exps
) -> Ast.ERRORWORDS
(List.map
expression exps
)
1085 | Ast0.OTHER
(_
) -> failwith
"eliminated by top_level")
1087 (* --------------------------------------------------------------------- *)
1088 (* Entry point for minus code *)
1090 (* Inline_mcodes is very important - sends + code attached to the - code
1091 down to the mcodes. The functions above can only be used when there is no
1092 attached + code, eg in + code itself. *)
1093 let ast0toast_toplevel x
=
1094 inline_mcodes.VT0.combiner_rec_top_level x
;
1097 let ast0toast name deps dropped exists x is_exp ruletype
=
1098 List.iter
inline_mcodes.VT0.combiner_rec_top_level x
;
1100 (name,(deps
,dropped
,exists
),List.map top_level x
,is_exp
,ruletype
)