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.
27 (* Arities matter for the minus slice, but not for the plus slice. *)
29 (* + only allowed on code in a nest (in_nest = true). ? only allowed on
30 rule_elems, and on subterms if the context is ? also. *)
32 module Ast0
= Ast0_cocci
33 module Ast
= Ast_cocci
34 module V0
= Visitor_ast0
35 module VT0
= Visitor_ast0_types
37 let unitary = Type_cocci.Unitary
45 (* --------------------------------------------------------------------- *)
46 (* Move plus tokens from the MINUS and CONTEXT structured nodes to the
47 corresponding leftmost and rightmost mcodes *)
51 let option_default = () in
53 let do_nothing r k e
=
55 let einfo = Ast0.get_info e
in
56 match (Ast0.get_mcodekind e
) with
57 Ast0.MINUS
(replacements
) ->
58 (match !replacements
with
59 (Ast.NOREPLACEMENT
,_
) -> ()
61 let minus_try = function
65 Ast0.MINUS
(mreplacements
) -> true | _
-> false)
70 Ast0.MINUS
(mreplacements
) ->
71 mreplacements
:= replacements
77 if not
(minus_try(einfo.Ast0.attachable_start
,
78 einfo.Ast0.mcode_start
)
80 minus_try(einfo.Ast0.attachable_end
,
81 einfo.Ast0.mcode_end
))
83 failwith
"minus tree should not have bad code on both sides")
84 | Ast0.CONTEXT
(befaft
)
85 | Ast0.MIXED
(befaft
) ->
86 let concat starter startinfo ender endinfo
=
88 match (starter
,ender
) with
92 if startinfo
.Ast0.tline_end
= endinfo
.Ast0.tline_start
93 then (* put them in the same inner list *)
94 let last = List.hd
(List.rev starter
) in
95 let butlast = List.rev
(List.tl
(List.rev starter
)) in
96 butlast @ (last@(List.hd ender
)) :: (List.tl ender
)
97 else starter
@ ender
in
99 {endinfo
with Ast0.tline_start
= startinfo
.Ast0.tline_start
}) in
100 let attach_bef bef beforeinfo befit
= function
104 Ast0.MINUS
(mreplacements
) ->
105 (match !mreplacements
with
106 (Ast.NOREPLACEMENT
,tokeninfo
) ->
108 (Ast.REPLACEMENT
(bef
,befit
),beforeinfo
)
109 | (Ast.REPLACEMENT
(anythings
,it
),tokeninfo
) ->
110 let (newbef
,newinfo
) =
111 concat bef beforeinfo anythings tokeninfo
in
112 let it = Ast.lub_count befit
it in
114 (Ast.REPLACEMENT
(newbef
,it),newinfo
))
115 | Ast0.CONTEXT
(mbefaft
) ->
117 (Ast.BEFORE
(mbef
,it),mbeforeinfo
,a
) ->
118 let (newbef
,newinfo
) =
119 concat bef beforeinfo mbef mbeforeinfo
in
120 let it = Ast.lub_count befit
it in
121 mbefaft
:= (Ast.BEFORE
(newbef
,it),newinfo
,a
)
122 | (Ast.AFTER
(maft
,it),_
,a
) ->
123 let it = Ast.lub_count befit
it in
125 (Ast.BEFOREAFTER
(bef
,maft
,it),beforeinfo
,a
)
126 | (Ast.BEFOREAFTER
(mbef
,maft
,it),mbeforeinfo
,a
) ->
127 let (newbef
,newinfo
) =
128 concat bef beforeinfo mbef mbeforeinfo
in
129 let it = Ast.lub_count befit
it in
131 (Ast.BEFOREAFTER
(newbef
,maft
,it),newinfo
,a
)
132 | (Ast.NOTHING
,_
,a
) ->
134 (Ast.BEFORE
(bef
,befit
),beforeinfo
,a
))
135 | _
-> failwith
"unexpected annotation")
138 Printf.printf
"before %s\n" (Dumper.dump bef
);
140 "context tree should not have bad code before" in
141 let attach_aft aft afterinfo aftit
= function
145 Ast0.MINUS
(mreplacements
) ->
146 (match !mreplacements
with
147 (Ast.NOREPLACEMENT
,tokeninfo
) ->
149 (Ast.REPLACEMENT
(aft
,aftit
),afterinfo
)
150 | (Ast.REPLACEMENT
(anythings
,it),tokeninfo
) ->
151 let (newaft
,newinfo
) =
152 concat anythings tokeninfo aft afterinfo
in
153 let it = Ast.lub_count aftit
it in
155 (Ast.REPLACEMENT
(newaft
,it),newinfo
))
156 | Ast0.CONTEXT
(mbefaft
) ->
158 (Ast.BEFORE
(mbef
,it),b
,_
) ->
159 let it = Ast.lub_count aftit
it in
161 (Ast.BEFOREAFTER
(mbef
,aft
,it),b
,afterinfo
)
162 | (Ast.AFTER
(maft
,it),b
,mafterinfo
) ->
163 let (newaft
,newinfo
) =
164 concat maft mafterinfo aft afterinfo
in
165 let it = Ast.lub_count aftit
it in
166 mbefaft
:= (Ast.AFTER
(newaft
,it),b
,newinfo
)
167 | (Ast.BEFOREAFTER
(mbef
,maft
,it),b
,mafterinfo
) ->
168 let (newaft
,newinfo
) =
169 concat maft mafterinfo aft afterinfo
in
170 let it = Ast.lub_count aftit
it in
172 (Ast.BEFOREAFTER
(mbef
,newaft
,it),b
,newinfo
)
173 | (Ast.NOTHING
,b
,_
) ->
174 mbefaft
:= (Ast.AFTER
(aft
,aftit
),b
,afterinfo
))
175 | _
-> failwith
"unexpected annotation")
179 "context tree should not have bad code after" in
181 (Ast.BEFORE
(bef
,it),beforeinfo
,_
) ->
182 attach_bef bef beforeinfo
it
183 (einfo.Ast0.attachable_start
,einfo.Ast0.mcode_start
)
184 | (Ast.AFTER
(aft
,it),_
,afterinfo
) ->
185 attach_aft aft afterinfo
it
186 (einfo.Ast0.attachable_end
,einfo.Ast0.mcode_end
)
187 | (Ast.BEFOREAFTER
(bef
,aft
,it),beforeinfo
,afterinfo
) ->
188 attach_bef bef beforeinfo
it
189 (einfo.Ast0.attachable_start
,einfo.Ast0.mcode_start
);
190 attach_aft aft afterinfo
it
191 (einfo.Ast0.attachable_end
,einfo.Ast0.mcode_end
)
192 | (Ast.NOTHING
,_
,_
) -> ())
193 | Ast0.PLUS _
-> () in
194 V0.flat_combiner
bind option_default
195 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
197 do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
198 do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
199 do_nothing do_nothing do_nothing
201 (* --------------------------------------------------------------------- *)
202 (* For function declarations. Can't use the mcode at the root, because that
203 might be mixed when the function contains ()s, where agglomeration of -s is
207 let donothing r k e
= k e
in
208 let bind x y
= x
&& y
in
209 let option_default = true in
210 let mcode (_
,_
,_
,mc
,_
,_
) =
212 Ast0.MINUS
(r
) -> let (plusses
,_
) = !r
in plusses
= Ast.NOREPLACEMENT
215 (* special case for disj and asExpr etc *)
217 match Ast0.unwrap e
with
218 Ast0.DisjId
(starter
,id_list
,mids
,ender
) ->
219 List.for_all r
.VT0.combiner_rec_ident id_list
222 let expression r k e
=
223 match Ast0.unwrap e
with
224 Ast0.DisjExpr
(starter
,expr_list
,mids
,ender
) ->
225 List.for_all r
.VT0.combiner_rec_expression expr_list
226 | Ast0.AsExpr
(exp
,asexp
) -> k exp
229 let declaration r k e
=
230 match Ast0.unwrap e
with
231 Ast0.DisjDecl
(starter
,decls
,mids
,ender
) ->
232 List.for_all r
.VT0.combiner_rec_declaration decls
233 | Ast0.AsDecl
(decl
,asdecl
) -> k decl
237 match Ast0.unwrap e
with
238 Ast0.DisjType
(starter
,decls
,mids
,ender
) ->
239 List.for_all r
.VT0.combiner_rec_typeC decls
240 | Ast0.AsType
(ty
,asty
) -> k ty
243 let initialiser r k e
=
244 match Ast0.unwrap e
with
245 Ast0.AsInit
(init
,asinit
) -> k init
248 let statement r k e
=
249 match Ast0.unwrap e
with
250 Ast0.Disj
(starter
,statement_dots_list
,mids
,ender
) ->
251 List.for_all r
.VT0.combiner_rec_statement_dots statement_dots_list
252 | Ast0.AsStmt
(stmt
,asstmt
) -> k stmt
255 let case_line r k e
=
256 match Ast0.unwrap e
with
257 Ast0.DisjCase
(starter
,case_lines
,mids
,ender
) ->
258 List.for_all r
.VT0.combiner_rec_case_line case_lines
261 V0.flat_combiner
bind option_default
262 mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
264 donothing donothing donothing donothing donothing donothing
265 ident expression typeC initialiser donothing declaration
266 statement case_line donothing
268 (* --------------------------------------------------------------------- *)
269 (* --------------------------------------------------------------------- *)
271 let get_option fn
= function
273 | Some x
-> Some
(fn x
)
275 (* --------------------------------------------------------------------- *)
276 (* --------------------------------------------------------------------- *)
279 let convert_info info
=
282 (function (s
,info
) -> (s
,info
.Ast0.line_start
,info
.Ast0.column
))
284 { Ast.line
= info
.Ast0.pos_info
.Ast0.line_start
;
285 Ast.column
= info
.Ast0.pos_info
.Ast0.column
;
286 Ast.strbef
= strings_to_s info
.Ast0.strings_before
;
287 Ast.straft
= strings_to_s info
.Ast0.strings_after
;
290 let convert_mcodekind adj
= function
291 Ast0.MINUS
(replacements
) ->
292 let (replacements
,_
) = !replacements
in
293 Ast.MINUS
(Ast.NoPos
,[],Ast.ADJ adj
,replacements
)
294 | Ast0.PLUS count
-> Ast.PLUS count
295 | Ast0.CONTEXT
(befaft
) ->
296 let (befaft
,_
,_
) = !befaft
in
297 Ast.CONTEXT
(Ast.NoPos
,befaft
)
298 | Ast0.MIXED
(_
) -> failwith
"not possible for mcode"
300 let convert_allminus_mcodekind allminus
= function
301 Ast0.CONTEXT
(befaft
) ->
302 let (befaft
,_
,_
) = !befaft
in
307 Ast.MINUS
(Ast.NoPos
,[],Ast.ALLMINUS
,Ast.NOREPLACEMENT
)
308 | Ast.BEFORE
(a
,ct
) | Ast.AFTER
(a
,ct
) ->
309 Ast.MINUS
(Ast.NoPos
,[],Ast.ALLMINUS
,Ast.REPLACEMENT
(a
,ct
))
310 | Ast.BEFOREAFTER
(b
,a
,ct
) ->
311 Ast.MINUS
(Ast.NoPos
,[],Ast.ALLMINUS
,Ast.REPLACEMENT
(b
@a
,ct
)))
312 else Ast.CONTEXT
(Ast.NoPos
,befaft
)
313 | _
-> failwith
"convert_allminus_mcodekind: unexpected mcodekind"
315 let pos_mcode(term
,_
,info
,mcodekind
,pos
,adj
) =
316 (* avoids a recursion problem *)
317 (term
,convert_info info
,convert_mcodekind adj mcodekind
,[])
319 let mcode (term
,_
,info
,mcodekind
,pos
,adj
) =
324 Ast0.MetaPosTag
(Ast0.MetaPos
(pos,constraints
,per
)) ->
325 (Ast.MetaPos
(pos_mcode pos,constraints
,per
,unitary,false))::prev
328 (term
,convert_info info
,convert_mcodekind adj mcodekind
,List.rev
pos)
330 (* --------------------------------------------------------------------- *)
332 let wrap ast line isos
=
333 {(Ast.make_term ast
) with Ast.node_line
= line
;
336 let rewrap ast0 isos ast
=
337 wrap ast
((Ast0.get_info ast0
).Ast0.pos_info
.Ast0.line_start
) isos
341 (* no isos on tokens *)
342 let tokenwrap (_
,info
,_
,_
) s ast
= wrap ast info
.Ast.line
no_isos
343 let iso_tokenwrap (_
,info
,_
,_
) s ast iso
= wrap ast info
.Ast.line iso
347 (match Ast0.unwrap d
with
348 Ast0.DOTS
(x
) -> Ast.DOTS
(List.map fn x
)
349 | Ast0.CIRCLES
(x
) -> Ast.CIRCLES
(List.map fn x
)
350 | Ast0.STARS
(x
) -> Ast.STARS
(List.map fn x
))
352 (* commas in dotted lists, here due to polymorphism restrictions *)
354 let add_comma is_comma is_dots make_comma itemlist
=
355 match Ast0.unwrap itemlist
with
357 (match List.rev x
with
359 (* Not sure if comma is needed if the list is just ...; leave it there for
360 now. See list_matcher in cocci_vs_c.ml in first try_matches case. *)
361 (* | [e] when is_dots e -> itemlist*)
367 match Ast0.get_mcodekind e
with
368 Ast0.MINUS
(_
) -> (Ast0.make_minus_mcode
",")
369 | _
-> (Ast0.make_mcode
",") in
372 (List.rev
(Ast0.rewrap e
(make_comma
comma) :: (e
::es
)))))
373 | _
-> failwith
"not possible"
377 (function x
-> match Ast0.unwrap x
with Ast0.EComma _
-> true | _
-> false)
378 (function x
-> match Ast0.unwrap x
with Ast0.Edots _
-> true | _
-> false)
379 (function x
-> Ast0.EComma x
)
383 (function x
-> match Ast0.unwrap x
with Ast0.IComma _
-> true | _
-> false)
384 (function x
-> match Ast0.unwrap x
with Ast0.Idots _
-> true | _
-> false)
385 (function x
-> Ast0.IComma x
)
387 (* --------------------------------------------------------------------- *)
390 let rec do_isos l
= List.map
(function (nm
,x
) -> (nm
,anything x
)) l
393 rewrap i
(do_isos (Ast0.get_iso i
))
394 (match Ast0.unwrap i
with
395 Ast0.Id
(name
) -> Ast.Id
(mcode name
)
396 | Ast0.DisjId
(_
,id_list
,_
,_
) ->
397 Ast.DisjId
(List.map
ident id_list
)
398 | Ast0.MetaId
(name
,constraints
,_
,_
) ->
399 Ast.MetaId
(mcode name
,constraints
,unitary,false)
400 | Ast0.MetaFunc
(name
,constraints
,_
) ->
401 Ast.MetaFunc
(mcode name
,constraints
,unitary,false)
402 | Ast0.MetaLocalFunc
(name
,constraints
,_
) ->
403 Ast.MetaLocalFunc
(mcode name
,constraints
,unitary,false)
404 | Ast0.OptIdent
(id
) -> Ast.OptIdent
(ident id
)
405 | Ast0.UniqueIdent
(id
) -> Ast.UniqueIdent
(ident id
))
407 (* --------------------------------------------------------------------- *)
412 rewrap e
(do_isos (Ast0.get_iso e
))
413 (match Ast0.unwrap e
with
414 Ast0.Ident
(id
) -> Ast.Ident
(ident id
)
415 | Ast0.Constant
(const
) ->
416 Ast.Constant
(mcode const
)
417 | Ast0.FunCall
(fn
,lp
,args
,rp
) ->
418 let fn = expression fn in
420 let args = dots expression args in
422 Ast.FunCall
(fn,lp,args,rp)
423 | Ast0.Assignment
(left
,op
,right
,simple
) ->
424 Ast.Assignment
(expression left
,mcode op
,expression right
,simple
)
425 | Ast0.Sequence
(left
,op
,right
) ->
426 Ast.Sequence
(expression left
,mcode op
,expression right
)
427 | Ast0.CondExpr
(exp1
,why
,exp2
,colon
,exp3
) ->
428 let exp1 = expression exp1 in
429 let why = mcode why in
430 let exp2 = get_option expression exp2 in
431 let colon = mcode colon in
432 let exp3 = expression exp3 in
433 Ast.CondExpr
(exp1,why,exp2,colon,exp3)
434 | Ast0.Postfix
(exp
,op
) ->
435 Ast.Postfix
(expression exp
,mcode op
)
436 | Ast0.Infix
(exp
,op
) ->
437 Ast.Infix
(expression exp
,mcode op
)
438 | Ast0.Unary
(exp
,op
) ->
439 Ast.Unary
(expression exp
,mcode op
)
440 | Ast0.Binary
(left
,op
,right
) ->
441 Ast.Binary
(expression left
,mcode op
,expression right
)
442 | Ast0.Nested
(left
,op
,right
) ->
443 Ast.Nested
(expression left
,mcode op
,expression right
)
444 | Ast0.Paren
(lp,exp
,rp) ->
445 Ast.Paren
(mcode lp,expression exp
,mcode rp)
446 | Ast0.ArrayAccess
(exp1,lb
,exp2,rb
) ->
447 Ast.ArrayAccess
(expression exp1,mcode lb
,expression exp2,mcode rb
)
448 | Ast0.RecordAccess
(exp
,pt
,field
) ->
449 Ast.RecordAccess
(expression exp
,mcode pt
,ident field
)
450 | Ast0.RecordPtAccess
(exp
,ar
,field
) ->
451 Ast.RecordPtAccess
(expression exp
,mcode ar
,ident field
)
452 | Ast0.Cast
(lp,ty
,rp,exp
) ->
453 let allminus = check_allminus.VT0.combiner_rec_expression e
in
454 Ast.Cast
(mcode lp,typeC allminus ty
,mcode rp,expression exp
)
455 | Ast0.SizeOfExpr
(szf
,exp
) ->
456 Ast.SizeOfExpr
(mcode szf
,expression exp
)
457 | Ast0.SizeOfType
(szf
,lp,ty
,rp) ->
458 let allminus = check_allminus.VT0.combiner_rec_expression e
in
459 Ast.SizeOfType
(mcode szf
, mcode lp,typeC allminus ty
,mcode rp)
460 | Ast0.TypeExp
(ty
) ->
461 let allminus = check_allminus.VT0.combiner_rec_expression e
in
462 Ast.TypeExp
(typeC allminus ty
)
463 | Ast0.Constructor
(lp,ty
,rp,init
) ->
464 let allminus = check_allminus.VT0.combiner_rec_expression e
in
465 Ast.Constructor
(mcode lp,typeC allminus ty
,mcode rp,initialiser init
)
466 | Ast0.MetaErr
(name
,cstrts
,_
) ->
467 Ast.MetaErr
(mcode name
,constraints cstrts
,unitary,false)
468 | Ast0.MetaExpr
(name
,cstrts
,ty
,form
,_
) ->
469 Ast.MetaExpr
(mcode name
,constraints cstrts
,unitary,ty
,form
,false)
470 | Ast0.MetaExprList
(name
,lenname
,_
) ->
471 Ast.MetaExprList
(mcode name
,do_lenname lenname
,unitary,false)
472 | Ast0.AsExpr
(expr
,asexpr
) ->
473 Ast.AsExpr
(expression expr
,expression asexpr
)
474 | Ast0.EComma
(cm
) -> Ast.EComma
(mcode cm
)
475 | Ast0.DisjExpr
(_
,exps
,_
,_
) ->
476 Ast.DisjExpr
(List.map
expression exps
)
477 | Ast0.NestExpr
(starter
,exp_dots
,ender
,whencode
,multi
) ->
478 let starter = mcode starter in
479 let whencode = get_option expression whencode in
480 let ender = mcode ender in
481 Ast.NestExpr
(starter,dots expression exp_dots
,ender,whencode,multi
)
482 | Ast0.Edots
(dots,whencode) ->
483 let dots = mcode dots in
484 let whencode = get_option expression whencode in
485 Ast.Edots
(dots,whencode)
486 | Ast0.Ecircles
(dots,whencode) ->
487 let dots = mcode dots in
488 let whencode = get_option expression whencode in
489 Ast.Ecircles
(dots,whencode)
490 | Ast0.Estars
(dots,whencode) ->
491 let dots = mcode dots in
492 let whencode = get_option expression whencode in
493 Ast.Estars
(dots,whencode)
494 | Ast0.OptExp
(exp
) -> Ast.OptExp
(expression exp
)
495 | Ast0.UniqueExp
(exp
) -> Ast.UniqueExp
(expression exp
)) in
496 if Ast0.get_test_exp e
then Ast.set_test_exp
e1 else e1
498 and expression_dots ed
= dots expression ed
502 Ast0.NoConstraint
-> Ast.NoConstraint
503 | Ast0.NotIdCstrt idctrt
-> Ast.NotIdCstrt idctrt
504 | Ast0.NotExpCstrt exps
-> Ast.NotExpCstrt
(List.map
expression exps
)
505 | Ast0.SubExpCstrt ids
-> Ast.SubExpCstrt ids
507 and do_lenname
= function
508 Ast0.MetaListLen
(nm
) -> Ast.MetaListLen
(mcode nm
,unitary,false)
509 | Ast0.CstListLen n
-> Ast.CstListLen n
510 | Ast0.AnyListLen
-> Ast.AnyListLen
512 (* --------------------------------------------------------------------- *)
515 and rewrap_iso t t1
= rewrap t
(do_isos (Ast0.get_iso t
)) t1
517 and typeC allminus t
=
518 rewrap t
(do_isos (Ast0.get_iso t
))
519 (match Ast0.unwrap t
with
520 Ast0.ConstVol
(cv
,ty
) ->
521 let rec collect_disjs t
=
522 match Ast0.unwrap t
with
523 Ast0.DisjType
(_
,types
,_
,_
) ->
524 if Ast0.get_iso t
= []
525 then List.concat (List.map
collect_disjs types
)
526 else failwith
"unexpected iso on a disjtype"
532 (allminus, Some
(mcode cv
),
533 rewrap_iso ty
(base_typeC
allminus ty
)))
534 (collect_disjs ty
) in
535 (* one could worry that isos are lost because we flatten the
536 disjunctions. but there should not be isos on the disjunctions
540 | types
-> Ast.DisjType
(List.map
(rewrap t
no_isos) types
))
541 | Ast0.BaseType
(_
) | Ast0.Signed
(_
,_
) | Ast0.Pointer
(_
,_
)
542 | Ast0.FunctionPointer
(_
,_
,_
,_
,_
,_
,_
) | Ast0.FunctionType
(_
,_
,_
,_
)
543 | Ast0.Array
(_
,_
,_
,_
) | Ast0.EnumName
(_
,_
) | Ast0.StructUnionName
(_
,_
)
544 | Ast0.StructUnionDef
(_
,_
,_
,_
) | Ast0.EnumDef
(_
,_
,_
,_
)
545 | Ast0.TypeName
(_
) | Ast0.MetaType
(_
,_
) ->
546 Ast.Type
(allminus,None
,rewrap t
no_isos (base_typeC
allminus t
))
547 | Ast0.DisjType
(_
,types
,_
,_
) ->
548 Ast.DisjType
(List.map
(typeC allminus) types
)
549 | Ast0.AsType
(ty
,asty
) ->
550 Ast.AsType
(typeC allminus ty
,typeC allminus asty
)
551 | Ast0.OptType
(ty
) -> Ast.OptType
(typeC allminus ty
)
552 | Ast0.UniqueType
(ty
) -> Ast.UniqueType
(typeC allminus ty
))
554 and base_typeC
allminus t
=
555 match Ast0.unwrap t
with
556 Ast0.BaseType
(ty
,strings
) -> Ast.BaseType
(ty
,List.map
mcode strings
)
557 | Ast0.Signed
(sgn
,ty
) ->
560 get_option (function x
-> rewrap_iso x
(base_typeC
allminus x
)) ty
)
561 | Ast0.Pointer
(ty
,star
) -> Ast.Pointer
(typeC allminus ty
,mcode star
)
562 | Ast0.FunctionPointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
564 (typeC allminus ty
,mcode lp1
,mcode star
,mcode rp1
,
565 mcode lp2
,parameter_list params
,mcode rp2
)
566 | Ast0.FunctionType
(ret
,lp,params
,rp) ->
567 let allminus = check_allminus.VT0.combiner_rec_typeC t
in
569 (allminus,get_option (typeC allminus) ret
,mcode lp,
570 parameter_list params
,mcode rp)
571 | Ast0.Array
(ty
,lb
,size
,rb
) ->
572 Ast.Array
(typeC allminus ty
,mcode lb
,get_option expression size
,
574 | Ast0.EnumName
(kind
,name
) ->
575 Ast.EnumName
(mcode kind
,get_option ident name
)
576 | Ast0.EnumDef
(ty
,lb
,ids
,rb
) ->
577 let ids = add_exp_comma ids in
578 Ast.EnumDef
(typeC allminus ty
,mcode lb
,dots expression ids,mcode rb
)
579 | Ast0.StructUnionName
(kind
,name
) ->
580 Ast.StructUnionName
(mcode kind
,get_option ident name
)
581 | Ast0.StructUnionDef
(ty
,lb
,decls
,rb
) ->
582 Ast.StructUnionDef
(typeC allminus ty
,mcode lb
,
583 dots declaration decls
,
585 | Ast0.TypeName
(name
) -> Ast.TypeName
(mcode name
)
586 | Ast0.MetaType
(name
,_
) ->
587 Ast.MetaType
(mcode name
,unitary,false)
588 | _
-> failwith
"ast0toast: unexpected type"
590 (* --------------------------------------------------------------------- *)
591 (* Variable declaration *)
592 (* Even if the Cocci program specifies a list of declarations, they are
593 split out into multiple declarations of a single variable each. *)
596 rewrap d
(do_isos (Ast0.get_iso d
))
597 (match Ast0.unwrap d
with
598 Ast0.MetaDecl
(name
,_
) -> Ast.MetaDecl
(mcode name
,unitary,false)
599 | Ast0.MetaField
(name
,_
) -> Ast.MetaField
(mcode name
,unitary,false)
600 | Ast0.MetaFieldList
(name
,lenname
,_
) ->
601 Ast.MetaFieldList
(mcode name
,do_lenname lenname
,unitary,false)
602 | Ast0.AsDecl
(decl
,asdecl
) ->
603 Ast.AsDecl
(declaration decl
,declaration asdecl
)
604 | Ast0.Init
(stg
,ty
,id
,eq
,ini
,sem
) ->
605 let allminus = check_allminus.VT0.combiner_rec_declaration d
in
606 let stg = get_option mcode stg in
607 let ty = typeC allminus ty in
610 let ini = initialiser ini in
611 let sem = mcode sem in
612 Ast.Init
(stg,ty,id,eq,ini,sem)
613 | Ast0.UnInit
(stg,ty,id,sem) ->
614 (match Ast0.unwrap
ty with
615 Ast0.FunctionType
(tyx
,lp1
,params
,rp1
) ->
616 let allminus = check_allminus.VT0.combiner_rec_declaration d
in
617 Ast.UnInit
(get_option mcode stg,
618 rewrap ty (do_isos (Ast0.get_iso
ty))
623 (allminus,get_option (typeC allminus) tyx
,
625 parameter_list params
,mcode rp1
)))),
628 let allminus = check_allminus.VT0.combiner_rec_declaration d
in
629 Ast.UnInit
(get_option mcode stg,typeC allminus ty,ident id,
631 | Ast0.MacroDecl
(name
,lp,args,rp,sem) ->
632 let name = ident name in
634 let args = dots expression args in
636 let sem = mcode sem in
637 Ast.MacroDecl
(name,lp,args,rp,sem)
638 | Ast0.MacroDeclInit
(name,lp,args,rp,eq,ini,sem) ->
639 let name = ident name in
641 let args = dots expression args in
644 let ini = initialiser ini in
645 let sem = mcode sem in
646 Ast.MacroDeclInit
(name,lp,args,rp,eq,ini,sem)
647 | Ast0.TyDecl
(ty,sem) ->
648 let allminus = check_allminus.VT0.combiner_rec_declaration d
in
649 Ast.TyDecl
(typeC allminus ty,mcode sem)
650 | Ast0.Typedef
(stg,ty,id,sem) ->
651 let allminus = check_allminus.VT0.combiner_rec_declaration d
in
652 let id = typeC allminus id in
653 (match Ast.unwrap
id with
654 Ast.Type
(_
,None
,id) -> (* only MetaType or Id *)
655 Ast.Typedef
(mcode stg,typeC allminus ty,id,mcode sem)
656 | _
-> failwith
"bad typedef")
657 | Ast0.DisjDecl
(_
,decls
,_
,_
) -> Ast.DisjDecl
(List.map
declaration decls
)
658 | Ast0.Ddots
(dots,whencode) ->
659 let dots = mcode dots in
660 let whencode = get_option declaration whencode in
661 Ast.Ddots
(dots,whencode)
662 | Ast0.OptDecl
(decl
) -> Ast.OptDecl
(declaration decl
)
663 | Ast0.UniqueDecl
(decl
) -> Ast.UniqueDecl
(declaration decl
))
665 and declaration_dots l
= dots declaration l
667 (* --------------------------------------------------------------------- *)
670 and strip_idots initlist
=
672 match Ast0.get_mcode_mcodekind mc
with
675 match Ast0.unwrap initlist
with
678 match List.rev
l with
681 (match (Ast0.unwrap x
,Ast0.unwrap y
) with
682 (Ast0.IComma _
,Ast0.Idots _
) ->
683 (* drop comma that was added by add_comma *)
686 let (whencode,init
,dotinfo
) =
687 let rec loop = function
690 (match Ast0.unwrap x
with
691 Ast0.Idots
(dots,Some
whencode) ->
692 let (restwhen
,restinit
,dotinfo
) = loop rest
in
693 (whencode :: restwhen
, restinit
,
694 (isminus dots)::dotinfo
)
695 | Ast0.Idots
(dots,None
) ->
696 let (restwhen
,restinit
,dotinfo
) = loop rest
in
697 (restwhen
, restinit
, (isminus dots)::dotinfo
)
699 let (restwhen
,restinit
,dotinfo
) = loop rest
in
700 (restwhen
,x
::restinit
,dotinfo
)) in
703 if List.for_all
(function x
-> not x
) dotinfo
704 then false (* false if no dots *)
706 if List.for_all
(function x
-> x
) dotinfo
708 else failwith
"inconsistent annotations on initialiser list dots" in
709 (whencode, init
, allminus)
710 | Ast0.CIRCLES
(x
) | Ast0.STARS
(x
) -> failwith
"not possible for an initlist"
714 (match Ast0.unwrap i
with
715 Ast0.MetaInit
(name,_
) -> Ast.MetaInit
(mcode name,unitary,false)
716 | Ast0.MetaInitList
(name,lenname
,_
) ->
717 Ast.MetaInitList
(mcode name,do_lenname lenname
,unitary,false)
718 | Ast0.AsInit
(init
,asinit
) ->
719 Ast.AsInit
(initialiser init
,initialiser asinit
)
720 | Ast0.InitExpr
(exp
) -> Ast.InitExpr
(expression exp
)
721 | Ast0.InitList
(lb
,initlist
,rb
,true) ->
722 let initlist = add_init_comma
initlist in
723 Ast.ArInitList
(mcode lb
,dots initialiser initlist,mcode rb
)
724 | Ast0.InitList
(lb
,initlist,rb
,false) ->
725 let initlist = add_init_comma
initlist in
726 let (whencode,initlist,allminus) = strip_idots
initlist in
728 (allminus,mcode lb
,List.map
initialiser initlist,mcode rb
,
729 List.map
initialiser whencode)
730 | Ast0.InitGccExt
(designators
,eq,ini) ->
731 Ast.InitGccExt
(List.map designator designators
,mcode eq,
733 | Ast0.InitGccName
(name,eq,ini) ->
734 Ast.InitGccName
(ident name,mcode eq,initialiser ini)
735 | Ast0.IComma
(comma) -> Ast.IComma
(mcode comma)
736 | Ast0.Idots
(dots,whencode) ->
737 let dots = mcode dots in
738 let whencode = get_option initialiser whencode in
739 Ast.Idots
(dots,whencode)
740 | Ast0.OptIni
(ini) -> Ast.OptIni
(initialiser ini)
741 | Ast0.UniqueIni
(ini) -> Ast.UniqueIni
(initialiser ini))
743 and designator
= function
744 Ast0.DesignatorField
(dot
,id) -> Ast.DesignatorField
(mcode dot
,ident id)
745 | Ast0.DesignatorIndex
(lb
,exp
,rb
) ->
746 Ast.DesignatorIndex
(mcode lb
, expression exp
, mcode rb
)
747 | Ast0.DesignatorRange
(lb
,min
,dots,max
,rb
) ->
748 Ast.DesignatorRange
(mcode lb
,expression min
,mcode dots,expression max
,
751 (* --------------------------------------------------------------------- *)
754 and parameterTypeDef p
=
756 (match Ast0.unwrap p
with
757 Ast0.VoidParam
(ty) -> Ast.VoidParam
(typeC false ty)
758 | Ast0.Param
(ty,id) ->
759 let allminus = check_allminus.VT0.combiner_rec_parameter p
in
760 Ast.Param
(typeC allminus ty,get_option ident id)
761 | Ast0.MetaParam
(name,_
) ->
762 Ast.MetaParam
(mcode name,unitary,false)
763 | Ast0.MetaParamList
(name,lenname
,_
) ->
764 Ast.MetaParamList
(mcode name,do_lenname lenname
,unitary,false)
765 | Ast0.PComma
(cm
) -> Ast.PComma
(mcode cm
)
766 | Ast0.Pdots
(dots) -> Ast.Pdots
(mcode dots)
767 | Ast0.Pcircles
(dots) -> Ast.Pcircles
(mcode dots)
768 | Ast0.OptParam
(param
) -> Ast.OptParam
(parameterTypeDef param
)
769 | Ast0.UniqueParam
(param
) -> Ast.UniqueParam
(parameterTypeDef param
))
771 and parameter_list
l = dots parameterTypeDef
l
773 (* --------------------------------------------------------------------- *)
777 let rec statement seqible s
=
778 let rewrap_stmt ast0 ast
=
780 match Ast0.get_dots_bef_aft s
with
781 Ast0.NoDots
-> Ast.NoDots
782 | Ast0.DroppingBetweenDots s
->
783 Ast.DroppingBetweenDots
(statement seqible s
,get_ctr())
784 | Ast0.AddingBetweenDots s
->
785 Ast.AddingBetweenDots
(statement seqible s
,get_ctr()) in
786 Ast.set_dots_bef_aft
befaft (rewrap ast0
no_isos ast
) in
787 let rewrap_rule_elem ast0 ast
=
788 rewrap ast0
(do_isos (Ast0.get_iso ast0
)) ast
in
790 (match Ast0.unwrap s
with
791 Ast0.Decl
((_
,bef
),decl
) ->
792 let allminus = check_allminus.VT0.combiner_rec_statement s
in
793 Ast.Atomic
(rewrap_rule_elem s
794 (Ast.Decl
(convert_allminus_mcodekind allminus bef
,
795 allminus,declaration decl
)))
796 | Ast0.Seq
(lbrace
,body
,rbrace
) ->
797 let lbrace = mcode lbrace in
798 let body = dots (statement seqible
) body in
799 let rbrace = mcode rbrace in
800 Ast.Seq
(iso_tokenwrap lbrace s
(Ast.SeqStart
(lbrace))
801 (do_isos (Ast0.get_iso s
)),
803 tokenwrap rbrace s
(Ast.SeqEnd
(rbrace)))
804 | Ast0.ExprStatement
(exp
,sem) ->
805 Ast.Atomic
(rewrap_rule_elem s
806 (Ast.ExprStatement
(get_option expression exp
,mcode sem)))
807 | Ast0.IfThen
(iff
,lp,exp
,rp,branch
,(_
,aft
)) ->
810 (Ast.IfHeader
(mcode iff
,mcode lp,expression exp
,mcode rp)),
811 statement Ast.NotSequencible branch
,
812 ([],[],[],convert_mcodekind (-1) aft
))
813 | Ast0.IfThenElse
(iff
,lp,exp
,rp,branch1
,els
,branch2
,(_
,aft
)) ->
814 let els = mcode els in
817 (Ast.IfHeader
(mcode iff
,mcode lp,expression exp
,mcode rp)),
818 statement Ast.NotSequencible branch1
,
819 tokenwrap els s
(Ast.Else
(els)),
820 statement Ast.NotSequencible branch2
,
821 ([],[],[],convert_mcodekind (-1) aft
))
822 | Ast0.While
(wh
,lp,exp
,rp,body,(_
,aft
)) ->
823 Ast.While
(rewrap_rule_elem s
825 (mcode wh
,mcode lp,expression exp
,mcode rp)),
826 statement Ast.NotSequencible
body,
827 ([],[],[],convert_mcodekind (-1) aft
))
828 | Ast0.Do
(d
,body,wh
,lp,exp
,rp,sem) ->
830 Ast.Do
(rewrap_rule_elem s
(Ast.DoHeader
(mcode d
)),
831 statement Ast.NotSequencible
body,
833 (Ast.WhileTail
(wh,mcode lp,expression exp
,mcode rp,
835 | Ast0.For
(fr
,lp,exp1,sem1
,exp2,sem2
,exp3,rp,body,(_
,aft
)) ->
838 let exp1 = get_option expression exp1 in
839 let sem1 = mcode sem1 in
840 let exp2 = get_option expression exp2 in
841 let sem2= mcode sem2 in
842 let exp3 = get_option expression exp3 in
844 let body = statement Ast.NotSequencible
body in
845 Ast.For
(rewrap_rule_elem s
846 (Ast.ForHeader
(fr,lp,exp1,sem1,exp2,sem2,exp3,rp)),
847 body,([],[],[],convert_mcodekind (-1) aft
))
848 | Ast0.Iterator
(nm
,lp,args,rp,body,(_
,aft
)) ->
849 Ast.Iterator
(rewrap_rule_elem s
852 dots expression args,
854 statement Ast.NotSequencible
body,
855 ([],[],[],convert_mcodekind (-1) aft
))
856 | Ast0.Switch
(switch
,lp,exp
,rp,lb
,decls
,cases
,rb
) ->
857 let switch = mcode switch in
859 let exp = expression exp in
862 let decls = dots (statement seqible
) decls in
863 let cases = List.map
case_line (Ast0.undots
cases) in
865 Ast.Switch
(rewrap_rule_elem s
(Ast.SwitchHeader
(switch,lp,exp,rp)),
866 tokenwrap lb s
(Ast.SeqStart
(lb)),
868 tokenwrap rb s
(Ast.SeqEnd
(rb)))
869 | Ast0.Break
(br
,sem) ->
870 Ast.Atomic
(rewrap_rule_elem s
(Ast.Break
(mcode br
,mcode sem)))
871 | Ast0.Continue
(cont
,sem) ->
872 Ast.Atomic
(rewrap_rule_elem s
(Ast.Continue
(mcode cont
,mcode sem)))
873 | Ast0.Label
(l,dd
) ->
874 Ast.Atomic
(rewrap_rule_elem s
(Ast.Label
(ident l,mcode dd
)))
875 | Ast0.Goto
(goto
,l,sem) ->
877 (rewrap_rule_elem s
(Ast.Goto
(mcode goto
,ident l,mcode sem)))
878 | Ast0.Return
(ret
,sem) ->
879 Ast.Atomic
(rewrap_rule_elem s
(Ast.Return
(mcode ret
,mcode sem)))
880 | Ast0.ReturnExpr
(ret
,exp,sem) ->
883 (Ast.ReturnExpr
(mcode ret
,expression exp,mcode sem)))
884 | Ast0.MetaStmt
(name,_
) ->
885 Ast.Atomic
(rewrap_rule_elem s
886 (Ast.MetaStmt
(mcode name,unitary,seqible
,false)))
887 | Ast0.MetaStmtList
(name,_
) ->
888 Ast.Atomic
(rewrap_rule_elem s
889 (Ast.MetaStmtList
(mcode name,unitary,false)))
890 | Ast0.AsStmt
(stmt
,asstmt
) ->
891 Ast.AsStmt
(statement seqible stmt
,statement seqible asstmt
)
892 | Ast0.TopExp
(exp) ->
893 Ast.Atomic
(rewrap_rule_elem s
(Ast.TopExp
(expression exp)))
895 Ast.Atomic
(rewrap_rule_elem s
(Ast.Exp
(expression exp)))
896 | Ast0.TopInit
(init
) ->
897 Ast.Atomic
(rewrap_rule_elem s
(Ast.TopInit
(initialiser init
)))
899 let allminus = check_allminus.VT0.combiner_rec_statement s
in
900 Ast.Atomic
(rewrap_rule_elem s
(Ast.Ty
(typeC allminus ty)))
901 | Ast0.Disj
(_
,rule_elem_dots_list
,_
,_
) ->
902 Ast.Disj
(List.map
(function x
-> statement_dots seqible x
)
904 | Ast0.Nest
(starter,rule_elem_dots
,ender,whn
,multi
) ->
906 (mcode starter,statement_dots
Ast.Sequencible rule_elem_dots
,
909 (whencode (statement_dots
Ast.Sequencible
)
910 (statement Ast.NotSequencible
))
913 | Ast0.Dots
(d
,whn
) ->
917 (whencode (statement_dots
Ast.Sequencible
)
918 (statement Ast.NotSequencible
))
920 Ast.Dots
(d,whn,[],[])
921 | Ast0.Circles
(d,whn) ->
925 (whencode (statement_dots
Ast.Sequencible
)
926 (statement Ast.NotSequencible
))
928 Ast.Circles
(d,whn,[],[])
929 | Ast0.Stars
(d,whn) ->
933 (whencode (statement_dots
Ast.Sequencible
)
934 (statement Ast.NotSequencible
))
936 Ast.Stars
(d,whn,[],[])
937 | Ast0.FunDecl
((_
,bef
),fi
,name,lp,params
,rp,lbrace,body,rbrace) ->
938 let fi = List.map fninfo
fi in
939 let name = ident name in
941 let params = parameter_list
params in
943 let lbrace = mcode lbrace in
944 let body = dots (statement seqible
) body in
945 let rbrace = mcode rbrace in
946 let allminus = check_allminus.VT0.combiner_rec_statement s
in
947 Ast.FunDecl
(rewrap_rule_elem s
949 (convert_allminus_mcodekind allminus bef
,
950 allminus,fi,name,lp,params,rp)),
951 tokenwrap lbrace s
(Ast.SeqStart
(lbrace)),
953 tokenwrap rbrace s
(Ast.SeqEnd
(rbrace)))
954 | Ast0.Include
(inc
,str
) ->
955 Ast.Atomic
(rewrap_rule_elem s
(Ast.Include
(mcode inc
,mcode str
)))
956 | Ast0.Undef
(def
,id) ->
957 Ast.Atomic
(rewrap_rule_elem s
(Ast.Undef
(mcode def
,ident id)))
958 | Ast0.Define
(def
,id,params,body) ->
962 (mcode def
,ident id, define_parameters
params)),
963 statement_dots
Ast.NotSequencible
(*not sure*) body)
964 | Ast0.OptStm
(stm
) -> Ast.OptStm
(statement seqible stm
)
965 | Ast0.UniqueStm
(stm
) -> Ast.UniqueStm
(statement seqible stm
))
967 and define_parameters p
=
969 (match Ast0.unwrap p
with
970 Ast0.NoParams
-> Ast.NoParams
971 | Ast0.DParams
(lp,params,rp) ->
972 Ast.DParams
(mcode lp,
973 dots define_param
params,
978 (match Ast0.unwrap p
with
979 Ast0.DParam
(id) -> Ast.DParam
(ident id)
980 | Ast0.DPComma
(comma) -> Ast.DPComma
(mcode comma)
981 | Ast0.DPdots
(d) -> Ast.DPdots
(mcode d)
982 | Ast0.DPcircles
(c) -> Ast.DPcircles
(mcode c)
983 | Ast0.OptDParam
(dp
) -> Ast.OptDParam
(define_param dp
)
984 | Ast0.UniqueDParam
(dp
) -> Ast.UniqueDParam
(define_param dp
))
986 and whencode notfn alwaysfn
= function
987 Ast0.WhenNot a
-> Ast.WhenNot
(notfn a
)
988 | Ast0.WhenAlways a
-> Ast.WhenAlways
(alwaysfn a
)
989 | Ast0.WhenModifier
(x
) -> Ast.WhenModifier
(x
)
991 let rewrap_rule_elem ast0 ast
=
992 rewrap ast0
(do_isos (Ast0.get_iso ast0
)) ast
in
994 Ast0.WhenNotTrue
(e
) ->
995 Ast.WhenNotTrue
(rewrap_rule_elem e
(Ast.Exp
(expression e
)))
996 | Ast0.WhenNotFalse
(e
) ->
997 Ast.WhenNotFalse
(rewrap_rule_elem e
(Ast.Exp
(expression e
)))
998 | _
-> failwith
"not possible"
1000 and process_list seqible isos
= function
1003 let first = statement seqible x
in
1005 if !Flag.track_iso_usage
1006 then Ast.set_isos
first (isos
@(Ast.get_isos
first))
1008 (match Ast0.unwrap x
with
1009 Ast0.Dots
(_
,_
) | Ast0.Nest
(_
) ->
1010 first::(process_list
(Ast.SequencibleAfterDots
[]) no_isos rest
)
1012 first::(process_list
Ast.Sequencible
no_isos rest
))
1014 and statement_dots seqible
d =
1015 let isos = do_isos (Ast0.get_iso
d) in
1017 (match Ast0.unwrap
d with
1018 Ast0.DOTS
(x
) -> Ast.DOTS
(process_list seqible
isos x
)
1019 | Ast0.CIRCLES
(x
) -> Ast.CIRCLES
(process_list seqible
isos x
)
1020 | Ast0.STARS
(x
) -> Ast.STARS
(process_list seqible
isos x
))
1022 (* the following is no longer used.
1023 the goal was to let one put a statement at the very beginning of a function
1024 pattern and have it skip over the declarations in the C code.
1025 that feature was removed a long time ago, however, in favor of
1026 ... when != S, which also causes whatever comes after it to match the
1027 first real statement.
1028 the separation of declarations from the rest of the body means that the
1029 quantifier of any variable shared between them comes out too high, posing
1030 problems when there is ... decl ... stmt, as the quantifier of any shared
1031 variable will be around the whole thing, making variables not free enough
1032 in the first ..., and thus not implementing the expected shortest path
1033 condition. example: f() { ... int A; ... foo(A); }.
1034 the quantifier for A should start just before int A, not at the top of the
1036 and separate_decls seqible d =
1037 let rec collect_decls = function
1040 (match Ast0.unwrap x with
1042 let (decls,other) = collect_decls xs in
1044 | Ast0.Dots(_,_) | Ast0.Nest(_,_,_,_,_) ->
1045 let (decls,other) = collect_decls xs in
1048 | _ -> (x :: decls,other))
1049 | Ast0.Disj(starter,stmt_dots_list,mids,ender) ->
1050 let disjs = List.map collect_dot_decls stmt_dots_list in
1051 let all_decls = List.for_all (function (_,s) -> s=[]) disjs in
1054 let (decls,other) = collect_decls xs in
1059 and collect_dot_decls d =
1060 match Ast0.unwrap d with
1061 Ast0.DOTS(x) -> collect_decls x
1062 | Ast0.CIRCLES(x) -> collect_decls x
1063 | Ast0.STARS(x) -> collect_decls x in
1065 let process l d fn =
1066 let (decls,other) = collect_decls l in
1067 (rewrap d no_isos (fn (List.map (statement seqible) decls)),
1069 (fn (process_list seqible (do_isos (Ast0.get_iso d)) other))) in
1070 match Ast0.unwrap d with
1071 Ast0.DOTS(x) -> process x d (function x -> Ast.DOTS x)
1072 | Ast0.CIRCLES(x) -> process x d (function x -> Ast.CIRCLES x)
1073 | Ast0.STARS(x) -> process x d (function x -> Ast.STARS x) *) in
1075 statement Ast.Sequencible s
1077 and fninfo
= function
1078 Ast0.FStorage
(stg) -> Ast.FStorage
(mcode stg)
1079 | Ast0.FType
(ty) -> Ast.FType
(typeC false ty)
1080 | Ast0.FInline
(inline
) -> Ast.FInline
(mcode inline
)
1081 | Ast0.FAttr
(attr
) -> Ast.FAttr
(mcode attr
)
1083 and option_to_list
= function
1089 (match Ast0.unwrap
c with
1090 Ast0.Default
(def
,colon,code
) ->
1091 let def = mcode def in
1092 let colon = mcode colon in
1093 let code = dots statement code in
1094 Ast.CaseLine
(rewrap c no_isos (Ast.Default
(def,colon)),code)
1095 | Ast0.Case
(case
,exp,colon,code) ->
1096 let case = mcode case in
1097 let exp = expression exp in
1098 let colon = mcode colon in
1099 let code = dots statement code in
1100 Ast.CaseLine
(rewrap c no_isos (Ast.Case
(case,exp,colon)),code)
1101 | Ast0.DisjCase
(_
,case_lines
,_
,_
) ->
1102 failwith
"not supported"
1103 (*Ast.CaseLine(Ast.DisjRuleElem(List.map case_line case_lines))*)
1105 | Ast0.OptCase
(case) -> Ast.OptCase
(case_line case))
1107 and statement_dots
l = dots statement l
1109 (* --------------------------------------------------------------------- *)
1111 (* what is possible is only what is at the top level in an iso *)
1112 and anything
= function
1113 Ast0.DotsExprTag
(d) -> Ast.ExprDotsTag
(expression_dots
d)
1114 | Ast0.DotsParamTag
(d) -> Ast.ParamDotsTag
(parameter_list
d)
1115 | Ast0.DotsInitTag
(d) -> failwith
"not possible"
1116 | Ast0.DotsStmtTag
(d) -> Ast.StmtDotsTag
(statement_dots
d)
1117 | Ast0.DotsDeclTag
(d) -> Ast.DeclDotsTag
(declaration_dots
d)
1118 | Ast0.DotsCaseTag
(d) -> failwith
"not possible"
1119 | Ast0.IdentTag
(d) -> Ast.IdentTag
(ident d)
1120 | Ast0.ExprTag
(d) -> Ast.ExpressionTag
(expression d)
1121 | Ast0.ArgExprTag
(d) | Ast0.TestExprTag
(d) ->
1122 failwith
"only in isos, not converted to ast"
1123 | Ast0.TypeCTag
(d) -> Ast.FullTypeTag
(typeC false d)
1124 | Ast0.ParamTag
(d) -> Ast.ParamTag
(parameterTypeDef
d)
1125 | Ast0.InitTag
(d) -> Ast.InitTag
(initialiser d)
1126 | Ast0.DeclTag
(d) -> Ast.DeclarationTag
(declaration d)
1127 | Ast0.StmtTag
(d) -> Ast.StatementTag
(statement d)
1128 | Ast0.CaseLineTag
(d) -> Ast.CaseLineTag
(case_line d)
1129 | Ast0.TopTag
(d) -> Ast.Code
(top_level
d)
1130 | Ast0.IsoWhenTag
(_
) -> failwith
"not possible"
1131 | Ast0.IsoWhenTTag
(_
) -> failwith
"not possible"
1132 | Ast0.IsoWhenFTag
(_
) -> failwith
"not possible"
1133 | Ast0.MetaPosTag _
-> failwith
"not possible"
1134 | Ast0.HiddenVarTag _
-> failwith
"not possible"
1136 (* --------------------------------------------------------------------- *)
1137 (* Function declaration *)
1138 (* top level isos are probably lost to tracking *)
1142 (match Ast0.unwrap t
with
1143 Ast0.FILEINFO
(old_file
,new_file
) ->
1144 Ast.FILEINFO
(mcode old_file
,mcode new_file
)
1145 | Ast0.NONDECL
(stmt
) -> Ast.NONDECL
(statement stmt
)
1146 | Ast0.CODE
(rule_elem_dots
) -> Ast.CODE
(statement_dots rule_elem_dots
)
1147 | Ast0.ERRORWORDS
(exps
) -> Ast.ERRORWORDS
(List.map
expression exps
)
1148 | Ast0.OTHER
(_
) | Ast0.TOPCODE
(_
) -> failwith
"eliminated by top_level")
1150 (* --------------------------------------------------------------------- *)
1151 (* Entry point for minus code *)
1153 (* Inline_mcodes is very important - sends + code attached to the - code
1154 down to the mcodes. The functions above can only be used when there is no
1155 attached + code, eg in + code itself. *)
1156 let ast0toast_toplevel x
=
1157 inline_mcodes.VT0.combiner_rec_top_level x
;
1160 let ast0toast name deps dropped exists x is_exp ruletype
=
1161 List.iter
inline_mcodes.VT0.combiner_rec_top_level x
;
1163 (name,(deps
,dropped
,exists
),List.map top_level x
,is_exp
,ruletype
)