2 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
4 * This file is part of Coccinelle.
6 * Coccinelle is free software: you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation, according to version 2 of the License.
10 * Coccinelle is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
15 * You should have received a copy of the GNU General Public License
16 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
24 module Ast
= Ast_cocci
26 let print_plus_flag = ref true
27 let print_minus_flag = ref true
28 let print_newlines_disj = ref true
31 force_newline
(); print_string
" "; open_box
0
34 close_box
(); force_newline
()
36 let print_string_box s
= print_string s
; open_box
0
39 let print_option = Common.do_option
40 let print_between = Common.print_between
42 (* --------------------------------------------------------------------- *)
45 (* avoid polyvariance problems *)
46 let anything : (Ast.anything -> unit) ref = ref (function _
-> ())
48 let rec print_anything str
= function
52 print_between force_newline
54 print_string str
; open_box
0; print_anything_list x
; close_box
())
58 and print_anything_list
= function
61 | bef
::((aft
::_
) as rest
) ->
65 Ast.Rule_elemTag
(_
) | Ast.AssignOpTag
(_
) | Ast.BinaryOpTag
(_
)
66 | Ast.ArithOpTag
(_
) | Ast.LogicalOpTag
(_
)
67 | Ast.Token
("if",_
) | Ast.Token
("while",_
) -> true | _
-> false) or
69 Ast.Rule_elemTag
(_
) | Ast.AssignOpTag
(_
) | Ast.BinaryOpTag
(_
)
70 | Ast.ArithOpTag
(_
) | Ast.LogicalOpTag
(_
) | Ast.Token
("{",_
) -> true
72 if space then print_string
" ";
73 print_anything_list rest
75 let print_around printer term
= function
76 Ast.NOTHING
-> printer term
77 | Ast.BEFORE
(bef
) -> print_anything "<<< " bef
; printer term
78 | Ast.AFTER
(aft
) -> printer term
; print_anything ">>> " aft
79 | Ast.BEFOREAFTER
(bef
,aft
) ->
80 print_anything "<<< " bef
; printer term
; print_anything ">>> " aft
82 let print_string_befaft fn x info
=
83 List.iter
(function (s
,_
,_
) -> print_string s
; force_newline
())
86 List.iter
(function (s
,_
,_
) -> force_newline
(); print_string s
)
89 let print_meta (r
,x
) = print_string r
; print_string
":"; print_string x
91 let print_pos = function
92 Ast.MetaPos
(name
,_
,_
,_
,_
) ->
93 let name = Ast.unwrap_mcode
name in
94 print_string
"@"; print_meta name
97 let mcode fn
= function
98 (x
, _
, Ast.MINUS
(_
,_
,adj
,plus_stream
), pos
) ->
100 then print_string
(if !Flag.sgrep_mode2
then "*" else "-");
103 then print_anything ">>> " plus_stream
104 | (x
, _
, Ast.CONTEXT
(_
,plus_streams
), pos
) ->
107 let fn x
= fn x
; print_pos pos
in
108 print_around fn x plus_streams
109 else (fn x
; print_pos pos
)
110 | (x
, info
, Ast.PLUS
, pos
) ->
111 let fn x
= fn x
; print_pos pos
in
112 print_string_befaft fn x info
114 let print_mcodekind = function
115 Ast.MINUS
(_
,_
,_
,plus_stream
) ->
116 print_string
"MINUS";
117 print_anything ">>> " plus_stream
118 | Ast.CONTEXT
(_
,plus_streams
) ->
119 print_around (function _
-> print_string
"CONTEXT") () plus_streams
120 | Ast.PLUS
-> print_string
"PLUS"
122 (* --------------------------------------------------------------------- *)
123 (* --------------------------------------------------------------------- *)
126 let dots between
fn d
=
127 match Ast.unwrap d
with
128 Ast.DOTS
(l
) -> print_between between
fn l
129 | Ast.CIRCLES
(l
) -> print_between between
fn l
130 | Ast.STARS
(l
) -> print_between between
fn l
132 let nest_dots multi
fn f d
=
133 let mo s
= if multi
then "<+"^s
else "<"^s
in
134 let mc s
= if multi
then s^
"+>" else s^
">" in
135 match Ast.unwrap d
with
137 print_string
(mo "..."); f
(); start_block();
138 print_between force_newline
fn l
;
139 end_block(); print_string
(mc "...")
141 print_string
(mo "ooo"); f
(); start_block();
142 print_between force_newline
fn l
;
143 end_block(); print_string
(mc "ooo")
145 print_string
(mo "***"); f
(); start_block();
146 print_between force_newline
fn l
;
147 end_block(); print_string
(mc "***")
149 (* --------------------------------------------------------------------- *)
151 let print_type keep info
= function
153 (* print_string "/* ";
154 print_string "keep:"; print_unitary keep;
155 print_string " inherited:"; print_bool inherited;
160 print_between (function _ -> print_string ", ") Type_cocci.typeC ty;(*
161 print_string "keep:"; print_unitary keep;
162 print_string " inherited:"; print_bool inherited;*)
165 (* --------------------------------------------------------------------- *)
169 match Ast.unwrap i
with
170 Ast.Id
(name) -> mcode print_string
name
171 | Ast.MetaId
(name,_
,keep
,inherited
) -> mcode print_meta name
172 | Ast.MetaFunc
(name,_
,_
,_
) -> mcode print_meta name
173 | Ast.MetaLocalFunc
(name,_
,_
,_
) -> mcode print_meta name
174 | Ast.OptIdent
(id
) -> print_string
"?"; ident id
175 | Ast.UniqueIdent
(id
) -> print_string
"!"; ident id
177 and print_unitary
= function
178 Type_cocci.Unitary
-> print_string
"unitary"
179 | Type_cocci.Nonunitary
-> print_string
"nonunitary"
180 | Type_cocci.Saved
-> print_string
"saved"
182 (* --------------------------------------------------------------------- *)
185 let print_disj_list fn l
=
186 if !print_newlines_disj
187 then (force_newline
(); print_string
"("; force_newline
())
188 else print_string
"(";
191 if !print_newlines_disj
192 then (force_newline
(); print_string
"|"; force_newline
())
193 else print_string
" | ")
195 if !print_newlines_disj
196 then (force_newline
(); print_string
")"; force_newline
())
197 else print_string
")"
199 let rec expression e
=
200 match Ast.unwrap e
with
201 Ast.Ident
(id
) -> ident id
202 | Ast.Constant
(const
) -> mcode constant const
203 | Ast.FunCall
(fn,lp
,args
,rp
) ->
204 expression fn; mcode print_string_box lp
;
205 dots (function _
-> ()) expression args
;
206 close_box
(); mcode print_string rp
207 | Ast.Assignment
(left
,op
,right
,simple
) ->
208 expression left
; print_string
" "; mcode assignOp op
;
209 print_string
" "; expression right
210 | Ast.CondExpr
(exp1
,why
,exp2
,colon
,exp3
) ->
211 expression exp1
; print_string
" "; mcode print_string why
;
212 print_option (function e
-> print_string
" "; expression e
) exp2
;
213 print_string
" "; mcode print_string colon
; expression exp3
214 | Ast.Postfix
(exp
,op
) -> expression exp
; mcode fixOp op
215 | Ast.Infix
(exp
,op
) -> mcode fixOp op
; expression exp
216 | Ast.Unary
(exp
,op
) -> mcode unaryOp op
; expression exp
217 | Ast.Binary
(left
,op
,right
) ->
218 expression left
; print_string
" "; mcode binaryOp op
; print_string
" ";
220 | Ast.Nested
(left
,op
,right
) ->
221 expression left
; print_string
" "; mcode binaryOp op
; print_string
" ";
223 | Ast.Paren
(lp
,exp
,rp
) ->
224 mcode print_string_box lp
; expression exp
; close_box
();
225 mcode print_string rp
226 | Ast.ArrayAccess
(exp1
,lb
,exp2
,rb
) ->
227 expression exp1
; mcode print_string_box lb
; expression exp2
; close_box
();
228 mcode print_string rb
229 | Ast.RecordAccess
(exp
,pt
,field
) ->
230 expression exp
; mcode print_string pt
; ident field
231 | Ast.RecordPtAccess
(exp
,ar
,field
) ->
232 expression exp
; mcode print_string ar
; ident field
233 | Ast.Cast
(lp
,ty
,rp
,exp
) ->
234 mcode print_string_box lp
; fullType ty
; close_box
();
235 mcode print_string rp
; expression exp
236 | Ast.SizeOfExpr
(sizeof
,exp
) ->
237 mcode print_string sizeof
; expression exp
238 | Ast.SizeOfType
(sizeof
,lp
,ty
,rp
) ->
239 mcode print_string sizeof
;
240 mcode print_string_box lp
; fullType ty
; close_box
();
241 mcode print_string rp
242 | Ast.TypeExp
(ty
) -> fullType ty
244 | Ast.MetaErr
(name,_
,_
,_
) -> mcode print_meta name
245 | Ast.MetaExpr
(name,_
,keep
,ty
,form
,inherited
) ->
246 mcode print_meta name; print_type keep inherited ty
247 | Ast.MetaExprList
(name,_
,_
,_
) -> mcode print_meta name
248 | Ast.EComma
(cm
) -> mcode print_string cm
; print_space
()
249 | Ast.DisjExpr
(exp_list
) -> print_disj_list expression exp_list
250 | Ast.NestExpr
(expr_dots
,Some whencode
,multi
) ->
251 nest_dots multi
expression
252 (function _
-> print_string
" when != "; expression whencode
)
254 | Ast.NestExpr
(expr_dots
,None
,multi
) ->
255 nest_dots multi
expression (function _
-> ()) expr_dots
256 | Ast.Edots
(dots,Some whencode
)
257 | Ast.Ecircles
(dots,Some whencode
)
258 | Ast.Estars
(dots,Some whencode
) ->
259 mcode print_string
dots; print_string
" when != "; expression whencode
260 | Ast.Edots
(dots,None
)
261 | Ast.Ecircles
(dots,None
)
262 | Ast.Estars
(dots,None
) -> mcode print_string
dots
263 | Ast.OptExp
(exp
) -> print_string
"?"; expression exp
264 | Ast.UniqueExp
(exp
) -> print_string
"!"; expression exp
266 and unaryOp
= function
267 Ast.GetRef
-> print_string
"&"
268 | Ast.DeRef
-> print_string
"*"
269 | Ast.UnPlus
-> print_string
"+"
270 | Ast.UnMinus
-> print_string
"-"
271 | Ast.Tilde
-> print_string
"~"
272 | Ast.Not
-> print_string
"!"
274 and assignOp
= function
275 Ast.SimpleAssign
-> print_string
"="
276 | Ast.OpAssign
(aop
) -> arithOp aop
; print_string
"="
279 Ast.Dec
-> print_string
"--"
280 | Ast.Inc
-> print_string
"++"
282 and binaryOp
= function
283 Ast.Arith
(aop
) -> arithOp aop
284 | Ast.Logical
(lop
) -> logicalOp lop
286 and arithOp
= function
287 Ast.Plus
-> print_string
"+"
288 | Ast.Minus
-> print_string
"-"
289 | Ast.Mul
-> print_string
"*"
290 | Ast.Div
-> print_string
"/"
291 | Ast.Mod
-> print_string
"%"
292 | Ast.DecLeft
-> print_string
"<<"
293 | Ast.DecRight
-> print_string
">>"
294 | Ast.And
-> print_string
"&"
295 | Ast.Or
-> print_string
"|"
296 | Ast.Xor
-> print_string
"^"
298 and logicalOp
= function
299 Ast.Inf
-> print_string
"<"
300 | Ast.Sup
-> print_string
">"
301 | Ast.InfEq
-> print_string
"<="
302 | Ast.SupEq
-> print_string
">="
303 | Ast.Eq
-> print_string
"=="
304 | Ast.NotEq
-> print_string
"!="
305 | Ast.AndLog
-> print_string
"&&"
306 | Ast.OrLog
-> print_string
"||"
308 and constant
= function
309 Ast.String
(s
) -> print_string
"\""; print_string s
; print_string
"\""
310 | Ast.Char
(s
) -> print_string
"'"; print_string s
; print_string
"'"
311 | Ast.Int
(s
) -> print_string s
312 | Ast.Float
(s
) -> print_string s
314 (* --------------------------------------------------------------------- *)
317 and storage
= function
318 Ast.Static
-> print_string
"static "
319 | Ast.Auto
-> print_string
"auto "
320 | Ast.Register
-> print_string
"register "
321 | Ast.Extern
-> print_string
"extern "
323 (* --------------------------------------------------------------------- *)
327 match Ast.unwrap ft
with
329 print_option (function x
-> mcode const_vol x
; print_string
" ") cv
;
331 | Ast.DisjType
(decls
) -> print_disj_list fullType decls
332 | Ast.OptType
(ty
) -> print_string
"?"; fullType ty
333 | Ast.UniqueType
(ty
) -> print_string
"!"; fullType ty
335 and print_function_pointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) fn =
336 fullType ty
; mcode print_string lp1
; mcode print_string star
; fn();
337 mcode print_string rp1
; mcode print_string lp1
;
338 parameter_list params
; mcode print_string rp2
340 and print_function_type
(ty
,lp1
,params
,rp1
) fn =
341 print_option fullType ty
; fn(); mcode print_string lp1
;
342 parameter_list params
; mcode print_string rp1
344 and print_fninfo
= function
345 Ast.FStorage
(stg
) -> mcode storage stg
346 | Ast.FType
(ty
) -> fullType ty
347 | Ast.FInline
(inline
) -> mcode print_string inline
; print_string
" "
348 | Ast.FAttr
(attr
) -> mcode print_string attr
; print_string
" "
351 match Ast.unwrap ty
with
352 Ast.BaseType
(ty
,strings
) ->
353 List.iter
(function s
-> mcode print_string s
; print_string
" ") strings
354 | Ast.SignedT
(sgn
,ty
) -> mcode sign sgn
; print_option typeC ty
355 | Ast.Pointer
(ty
,star
) -> fullType ty
; mcode print_string star
356 | Ast.FunctionPointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
357 print_function_pointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
)
359 | Ast.FunctionType
(_
,ty
,lp1
,params
,rp1
) ->
360 print_function_type
(ty
,lp1
,params
,rp1
) (function _
-> ())
361 | Ast.Array
(ty
,lb
,size
,rb
) ->
362 fullType ty
; mcode print_string lb
; print_option expression size
;
363 mcode print_string rb
364 | Ast.EnumName
(kind
,name) -> mcode print_string kind
; print_string
" ";
366 | Ast.StructUnionName
(kind
,name) ->
367 mcode structUnion kind
;
368 print_option (function x
-> ident x
; print_string
" ") name
369 | Ast.StructUnionDef
(ty
,lb
,decls
,rb
) ->
370 fullType ty
; mcode print_string lb
;
371 dots force_newline declaration decls
;
372 mcode print_string rb
373 | Ast.TypeName
(name) -> mcode print_string
name; print_string
" "
374 | Ast.MetaType
(name,_
,_
) ->
375 mcode print_meta name; print_string
" "
377 and baseType
= function
378 Ast.VoidType
-> print_string
"void "
379 | Ast.CharType
-> print_string
"char "
380 | Ast.ShortType
-> print_string
"short "
381 | Ast.IntType
-> print_string
"int "
382 | Ast.DoubleType
-> print_string
"double "
383 | Ast.FloatType
-> print_string
"float "
384 | Ast.LongType
-> print_string
"long "
385 | Ast.LongLongType
-> print_string
"long long "
387 and structUnion
= function
388 Ast.Struct
-> print_string
"struct "
389 | Ast.Union
-> print_string
"union "
392 Ast.Signed
-> print_string
"signed "
393 | Ast.Unsigned
-> print_string
"unsigned "
395 and const_vol
= function
396 Ast.Const
-> print_string
"const"
397 | Ast.Volatile
-> print_string
"volatile"
399 (* --------------------------------------------------------------------- *)
400 (* Variable declaration *)
401 (* Even if the Cocci program specifies a list of declarations, they are
402 split out into multiple declarations of a single variable each. *)
404 and print_named_type ty id
=
405 match Ast.unwrap ty
with
406 Ast.Type
(None
,ty1
) ->
407 (match Ast.unwrap ty1
with
408 Ast.FunctionPointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
409 print_function_pointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
)
410 (function _
-> print_string
" "; ident id
)
411 | Ast.FunctionType
(_
,ty
,lp1
,params
,rp1
) ->
412 print_function_type
(ty
,lp1
,params
,rp1
)
413 (function _
-> print_string
" "; ident id
)
414 | Ast.Array
(ty
,lb
,size
,rb
) ->
416 match Ast.unwrap ty
with
417 Ast.Array
(ty
,lb
,size
,rb
) ->
418 (match Ast.unwrap ty
with
423 mcode print_string lb
;
424 print_option expression size
;
425 mcode print_string rb
)
426 | _
-> failwith
"complex array types not supported")
427 | _
-> typeC ty
; ident id
; k
() in
428 loop ty1
(function _
-> ())
429 | _
-> fullType ty
; ident id
)
430 | _
-> fullType ty
; ident id
433 match Ast.unwrap d
with
434 Ast.Init
(stg
,ty
,id
,eq
,ini
,sem
) ->
435 print_option (mcode storage
) stg
; print_named_type ty id
;
436 print_string
" "; mcode print_string eq
;
437 print_string
" "; initialiser ini
; mcode print_string sem
438 | Ast.UnInit
(stg
,ty
,id
,sem
) ->
439 print_option (mcode storage
) stg
; print_named_type ty id
;
440 mcode print_string sem
441 | Ast.MacroDecl
(name,lp
,args
,rp
,sem
) ->
442 ident name; mcode print_string_box lp
;
443 dots (function _
-> ()) expression args
;
444 close_box
(); mcode print_string rp
; mcode print_string sem
445 | Ast.TyDecl
(ty
,sem
) -> fullType ty
; mcode print_string sem
446 | Ast.Typedef
(stg
,ty
,id
,sem
) ->
447 mcode print_string stg
; print_string
" "; fullType ty
; typeC id
;
448 mcode print_string sem
449 | Ast.DisjDecl
(decls
) -> print_disj_list declaration decls
450 | Ast.Ddots
(dots,Some whencode
) ->
451 mcode print_string
dots; print_string
" when != "; declaration whencode
452 | Ast.Ddots
(dots,None
) -> mcode print_string
dots
453 | Ast.MetaDecl
(name,_
,_
) -> mcode print_meta name
454 | Ast.OptDecl
(decl
) -> print_string
"?"; declaration decl
455 | Ast.UniqueDecl
(decl
) -> print_string
"!"; declaration decl
457 (* --------------------------------------------------------------------- *)
461 match Ast.unwrap i
with
462 Ast.MetaInit
(name,_
,_
) ->
463 mcode print_meta name; print_string
" "
464 | Ast.InitExpr
(exp
) -> expression exp
465 | Ast.InitList
(lb
,initlist
,rb
,whencode
) ->
466 mcode print_string lb
; open_box
0;
467 if not
(whencode
= [])
469 (print_string
" WHEN != ";
470 print_between (function _
-> print_string
" v ")
471 initialiser whencode
;
473 List.iter initialiser initlist
; close_box
();
474 mcode print_string rb
475 | Ast.InitGccExt
(designators
,eq
,ini
) ->
476 List.iter designator designators
; print_string
" ";
477 mcode print_string eq
; print_string
" "; initialiser ini
478 | Ast.InitGccName
(name,eq
,ini
) ->
479 ident name; mcode print_string eq
; initialiser ini
480 | Ast.IComma
(comma
) -> mcode print_string comma
; force_newline
()
481 | Ast.OptIni
(ini
) -> print_string
"?"; initialiser ini
482 | Ast.UniqueIni
(ini
) -> print_string
"!"; initialiser ini
484 and designator
= function
485 Ast.DesignatorField
(dot
,id
) -> mcode print_string dot
; ident id
486 | Ast.DesignatorIndex
(lb
,exp
,rb
) ->
487 mcode print_string lb
; expression exp
; mcode print_string rb
488 | Ast.DesignatorRange
(lb
,min
,dots,max
,rb
) ->
489 mcode print_string lb
; expression min
; mcode print_string
dots;
490 expression max
; mcode print_string rb
492 (* --------------------------------------------------------------------- *)
495 and parameterTypeDef p
=
496 match Ast.unwrap p
with
497 Ast.VoidParam
(ty
) -> fullType ty
498 | Ast.Param
(ty
,Some id
) -> print_named_type ty id
499 | Ast.Param
(ty
,None
) -> fullType ty
500 | Ast.MetaParam
(name,_
,_
) -> mcode print_meta name
501 | Ast.MetaParamList
(name,_
,_
,_
) -> mcode print_meta name
502 | Ast.PComma
(cm
) -> mcode print_string cm
; print_space
()
503 | Ast.Pdots
(dots) -> mcode print_string
dots
504 | Ast.Pcircles
(dots) -> mcode print_string
dots
505 | Ast.OptParam
(param
) -> print_string
"?"; parameterTypeDef param
506 | Ast.UniqueParam
(param
) -> print_string
"!"; parameterTypeDef param
508 and parameter_list l
= dots (function _
-> ()) parameterTypeDef l
510 (* --------------------------------------------------------------------- *)
513 let rec rule_elem arity re
=
514 match Ast.unwrap re
with
515 Ast.FunHeader
(bef
,allminus
,fninfo
,name,lp
,params
,rp
) ->
516 mcode (function _
-> ()) ((),Ast.no_info
,bef
,Ast.NoMetaPos
);
517 print_string arity
; List.iter print_fninfo fninfo
;
518 ident name; mcode print_string_box lp
;
519 parameter_list params
; close_box
(); mcode print_string rp
;
521 | Ast.Decl
(bef
,allminus
,decl
) ->
522 mcode (function _
-> ()) ((),Ast.no_info
,bef
,Ast.NoMetaPos
);
525 | Ast.SeqStart
(brace
) ->
526 print_string arity
; mcode print_string brace
;
527 if !print_newlines_disj then start_block()
528 | Ast.SeqEnd
(brace
) ->
529 if !print_newlines_disj then end_block();
530 print_string arity
; mcode print_string brace
531 | Ast.ExprStatement
(exp
,sem
) ->
532 print_string arity
; expression exp
; mcode print_string sem
533 | Ast.IfHeader
(iff
,lp
,exp
,rp
) ->
535 mcode print_string iff
; print_string
" "; mcode print_string_box lp
;
536 expression exp
; close_box
(); mcode print_string rp
; print_string
" "
538 print_string arity
; mcode print_string els
; print_string
" "
539 | Ast.WhileHeader
(whl
,lp
,exp
,rp
) ->
541 mcode print_string whl
; print_string
" "; mcode print_string_box lp
;
542 expression exp
; close_box
(); mcode print_string rp
; print_string
" "
544 print_string arity
; mcode print_string d
; print_string
" "
545 | Ast.WhileTail
(whl
,lp
,exp
,rp
,sem
) ->
547 mcode print_string whl
; print_string
" "; mcode print_string_box lp
;
548 expression exp
; close_box
(); mcode print_string rp
;
549 mcode print_string sem
550 | Ast.ForHeader
(fr
,lp
,e1
,sem1
,e2
,sem2
,e3
,rp
) ->
552 mcode print_string fr
; mcode print_string_box lp
;
553 print_option expression e1
; mcode print_string sem1
;
554 print_option expression e2
; mcode print_string sem2
;
555 print_option expression e3
; close_box
();
556 mcode print_string rp
; print_string
" "
557 | Ast.IteratorHeader
(nm
,lp
,args
,rp
) ->
559 ident nm
; print_string
" "; mcode print_string_box lp
;
560 dots (function _
-> ()) expression args
; close_box
();
561 mcode print_string rp
; print_string
" "
562 | Ast.SwitchHeader
(switch
,lp
,exp
,rp
) ->
564 mcode print_string switch
; print_string
" "; mcode print_string_box lp
;
565 expression exp
; close_box
(); mcode print_string rp
; print_string
" "
566 | Ast.Break
(br
,sem
) ->
567 print_string arity
; mcode print_string br
; mcode print_string sem
568 | Ast.Continue
(cont
,sem
) ->
569 print_string arity
; mcode print_string cont
; mcode print_string sem
570 | Ast.Label
(l
,dd
) -> ident l
; mcode print_string dd
571 | Ast.Goto
(goto
,l
,sem
) ->
572 mcode print_string goto
; ident l
; mcode print_string sem
573 | Ast.Return
(ret
,sem
) ->
574 print_string arity
; mcode print_string ret
; mcode print_string sem
575 | Ast.ReturnExpr
(ret
,exp
,sem
) ->
576 print_string arity
; mcode print_string ret
; print_string
" ";
577 expression exp
; mcode print_string sem
578 | Ast.MetaRuleElem
(name,_
,_
) ->
579 print_string arity
; mcode print_meta name
580 | Ast.MetaStmt
(name,_
,_
,_
) ->
581 print_string arity
; mcode print_meta name
582 | Ast.MetaStmtList
(name,_
,_
) ->
583 print_string arity
; mcode print_meta name
584 | Ast.Exp
(exp
) -> print_string arity
; expression exp
585 | Ast.TopExp
(exp
) -> print_string arity
; expression exp
586 | Ast.Ty
(ty
) -> print_string arity
; fullType ty
587 | Ast.TopInit
(init
) -> initialiser init
588 | Ast.Include
(inc
,s
) ->
589 mcode print_string inc
; print_string
" "; mcode inc_file s
590 | Ast.DefineHeader
(def
,id
,params
) ->
591 mcode print_string def
; print_string
" "; ident id
;
592 print_define_parameters params
593 | Ast.Default
(def
,colon
) ->
594 mcode print_string def
; mcode print_string colon
; print_string
" "
595 | Ast.Case
(case
,exp
,colon
) ->
596 mcode print_string case
; print_string
" "; expression exp
;
597 mcode print_string colon
; print_string
" "
598 | Ast.DisjRuleElem
(res
) ->
600 force_newline
(); print_string
"("; force_newline
();
602 (function _
-> force_newline
();print_string
"|"; force_newline
())
605 force_newline
(); print_string
")"
608 and print_define_parameters params
=
609 match Ast.unwrap params
with
611 | Ast.DParams
(lp
,params
,rp
) ->
612 mcode print_string lp
;
613 dots (function _
-> ()) print_define_param params
; mcode print_string rp
615 and print_define_param param
=
616 match Ast.unwrap param
with
617 Ast.DParam
(id
) -> ident id
618 | Ast.DPComma
(comma
) -> mcode print_string comma
619 | Ast.DPdots
(dots) -> mcode print_string
dots
620 | Ast.DPcircles
(circles
) -> mcode print_string circles
621 | Ast.OptDParam
(dp
) -> print_string
"?"; print_define_param dp
622 | Ast.UniqueDParam
(dp
) -> print_string
"!"; print_define_param dp
624 and statement arity s
=
625 match Ast.unwrap s
with
626 Ast.Seq
(lbrace
,body
,rbrace
) ->
627 rule_elem arity lbrace
;
628 dots force_newline
(statement arity
) body
;
629 rule_elem arity rbrace
630 | Ast.IfThen
(header
,branch
,(_
,_
,_
,aft
)) ->
631 rule_elem arity header
; statement arity branch
;
632 mcode (function _
-> ()) ((),Ast.no_info
,aft
,Ast.NoMetaPos
)
633 | Ast.IfThenElse
(header
,branch1
,els
,branch2
,(_
,_
,_
,aft
)) ->
634 rule_elem arity header
; statement arity branch1
; print_string
" ";
635 rule_elem arity els
; statement arity branch2
;
636 mcode (function _
-> ()) ((),Ast.no_info
,aft
,Ast.NoMetaPos
)
637 | Ast.While
(header
,body
,(_
,_
,_
,aft
)) ->
638 rule_elem arity header
; statement arity body
;
639 mcode (function _
-> ()) ((),Ast.no_info
,aft
,Ast.NoMetaPos
)
640 | Ast.Do
(header
,body
,tail
) ->
641 rule_elem arity header
; statement arity body
;
643 | Ast.For
(header
,body
,(_
,_
,_
,aft
)) ->
644 rule_elem arity header
; statement arity body
;
645 mcode (function _
-> ()) ((),Ast.no_info
,aft
,Ast.NoMetaPos
)
646 | Ast.Iterator
(header
,body
,(_
,_
,_
,aft
)) ->
647 rule_elem arity header
; statement arity body
;
648 mcode (function _
-> ()) ((),Ast.no_info
,aft
,Ast.NoMetaPos
)
649 | Ast.Switch
(header
,lb
,cases
,rb
) ->
650 rule_elem arity header
; rule_elem arity lb
;
651 List.iter
(function x
-> case_line arity x
; force_newline
()) cases
;
653 | Ast.Atomic
(re
) -> rule_elem arity re
654 | Ast.FunDecl
(header
,lbrace
,body
,rbrace
) ->
655 rule_elem arity header
; rule_elem arity lbrace
;
656 dots force_newline
(statement arity
) body
;
657 rule_elem arity rbrace
658 | Ast.Disj
([stmt_dots
]) ->
660 dots (function _
-> if !print_newlines_disj then force_newline
())
661 (statement arity
) stmt_dots
662 | Ast.Disj
(stmt_dots_list
) -> (* ignores newline directive for readability *)
664 force_newline
(); print_string
"("; force_newline
();
666 (function _
-> force_newline
();print_string
"|"; force_newline
())
667 (dots force_newline
(statement arity
))
669 force_newline
(); print_string
")"
670 | Ast.Define
(header
,body
) ->
671 rule_elem arity header
; print_string
" ";
672 dots force_newline
(statement arity
) body
673 | Ast.Nest
(stmt_dots
,whn
,multi
,_
,_
) ->
675 nest_dots multi
(statement arity
)
678 print_between force_newline
679 (whencode
(dots force_newline
(statement
"")) (statement
"")) whn
;
680 close_box
(); force_newline
())
682 | Ast.Dots
(d
,whn
,_
,_
) | Ast.Circles
(d
,whn
,_
,_
) | Ast.Stars
(d
,whn
,_
,_
) ->
683 print_string arity
; mcode print_string d
;
685 print_between force_newline
686 (whencode
(dots force_newline
(statement
"")) (statement
"")) whn
;
687 close_box
(); force_newline
()
688 | Ast.OptStm
(s
) -> statement
"?" s
689 | Ast.UniqueStm
(s
) -> statement
"!" s
691 and print_statement_when whencode
=
692 print_string
" WHEN != ";
694 print_between (function _
-> print_string
" &"; force_newline
())
695 (dots force_newline
(statement
"")) whencode
;
699 and whencode notfn alwaysfn
= function
701 print_string
" WHEN != "; open_box
0; notfn a
; close_box
()
702 | Ast.WhenAlways a
->
703 print_string
" WHEN = "; open_box
0; alwaysfn a
; close_box
()
704 | Ast.WhenModifier x
-> print_string
" WHEN "; print_when_modif x
705 | Ast.WhenNotTrue a
->
706 print_string
" WHEN != TRUE "; open_box
0; rule_elem "" a
; close_box
()
707 | Ast.WhenNotFalse a
->
708 print_string
" WHEN != FALSE "; open_box
0; rule_elem "" a
; close_box
()
710 and print_when_modif
= function
711 | Ast.WhenAny
-> print_string
"ANY"
712 | Ast.WhenStrict
-> print_string
"STRICT"
713 | Ast.WhenForall
-> print_string
"FORALL"
714 | Ast.WhenExists
-> print_string
"EXISTS"
716 and case_line arity c
=
717 match Ast.unwrap c
with
718 Ast.CaseLine
(header
,code
) ->
719 rule_elem arity header
; print_string
" ";
720 dots force_newline
(statement arity
) code
721 | Ast.OptCase
(case
) -> case_line
"?" case
723 (* --------------------------------------------------------------------- *)
726 and inc_file
= function
729 print_between (function _
-> print_string
"/") inc_elem elems
;
731 | Ast.NonLocal
(elems
) ->
733 print_between (function _
-> print_string
"/") inc_elem elems
;
736 and inc_elem
= function
737 Ast.IncPath s
-> print_string s
738 | Ast.IncDots
-> print_string
"..."
740 (* for export only *)
741 let statement_dots l
= dots force_newline
(statement
"") l
744 match Ast.unwrap t
with
745 Ast.FILEINFO
(old_file
,new_file
) ->
746 print_string
"--- "; mcode print_string old_file
; force_newline
();
747 print_string
"+++ "; mcode print_string new_file
748 | Ast.DECL
(stmt
) -> statement
"" stmt
749 | Ast.CODE
(stmt_dots
) ->
750 dots force_newline
(statement
"") stmt_dots
751 | Ast.ERRORWORDS
(exps
) ->
752 print_string
"error words = [";
753 print_between (function _
-> print_string
", ") expression exps
;
757 print_between (function _
-> force_newline
(); force_newline
()) top_level
759 let pp_print_anything x
= !anything x
763 Ast.FullTypeTag
(x
) -> fullType x
764 | Ast.BaseTypeTag
(x
) -> baseType x
765 | Ast.StructUnionTag
(x
) -> structUnion x
766 | Ast.SignTag
(x
) -> sign x
767 | Ast.IdentTag
(x
) -> ident x
768 | Ast.ExpressionTag
(x
) -> expression x
769 | Ast.ConstantTag
(x
) -> constant x
770 | Ast.UnaryOpTag
(x
) -> unaryOp x
771 | Ast.AssignOpTag
(x
) -> assignOp x
772 | Ast.FixOpTag
(x
) -> fixOp x
773 | Ast.BinaryOpTag
(x
) -> binaryOp x
774 | Ast.ArithOpTag
(x
) -> arithOp x
775 | Ast.LogicalOpTag
(x
) -> logicalOp x
776 | Ast.InitTag
(x
) -> initialiser x
777 | Ast.DeclarationTag
(x
) -> declaration x
778 | Ast.StorageTag
(x
) -> storage x
779 | Ast.IncFileTag
(x
) -> inc_file x
780 | Ast.Rule_elemTag
(x
) -> rule_elem "" x
781 | Ast.StatementTag
(x
) -> statement
"" x
782 | Ast.CaseLineTag
(x
) -> case_line
"" x
783 | Ast.ConstVolTag
(x
) -> const_vol x
784 | Ast.Token
(x
,Some info
) -> print_string_befaft print_string x info
785 | Ast.Token
(x
,None
) -> print_string x
786 | Ast.Pragma
(xs
) -> print_between force_newline print_string xs
787 | Ast.Code
(x
) -> let _ = top_level x
in ()
788 | Ast.ExprDotsTag
(x
) -> dots (function _ -> ()) expression x
789 | Ast.ParamDotsTag
(x
) -> parameter_list x
790 | Ast.StmtDotsTag
(x
) -> dots (function _ -> ()) (statement
"") x
791 | Ast.DeclDotsTag
(x
) -> dots (function _ -> ()) declaration x
792 | Ast.TypeCTag
(x
) -> typeC x
793 | Ast.ParamTag
(x
) -> parameterTypeDef x
794 | Ast.SgrepStartTag
(x
) -> print_string x
795 | Ast.SgrepEndTag
(x
) -> print_string x
797 let rec dep in_and
= function
798 Ast.Dep
(s
) -> print_string s
799 | Ast.AntiDep
(s
) -> print_string
"!"; print_string s
800 | Ast.EverDep
(s
) -> print_string
"ever "; print_string s
801 | Ast.NeverDep
(s
) -> print_string
"never "; print_string s
802 | Ast.AndDep
(s1
,s2
) ->
803 let print_and _ = dep true s1
; print_string
" && "; dep true s2
in
806 else (print_string
"("; print_and(); print_string
")")
807 | Ast.OrDep
(s1
,s2
) ->
808 let print_or _ = dep false s1
; print_string
" || "; dep false s2
in
811 else (print_string
"("; print_or(); print_string
")")
812 | Ast.NoDep
-> failwith
"not possible"
816 Ast.InitialScriptRule
(lang
,code
) ->
819 print_string
("initialize:" ^ lang
);
825 | Ast.FinalScriptRule
(lang
,code
) ->
828 print_string
("finalize:" ^ lang
);
834 | Ast.ScriptRule
(lang
,deps
,bindings
,code
) ->
837 print_string
("script:" ^ lang
);
840 | _ -> print_string
" depends on "; dep true deps
);
846 | Ast.CocciRule
(nm
, (deps
, drops
, exists
), x
, _, _) ->
852 | _ -> print_string
" depends on "; dep true deps
);
854 print_string "line ";
855 print_int (Ast.get_line (List.hd x));
859 print_newlines_disj := true;
865 let rule_elem_to_string x
=
866 print_newlines_disj := true;
867 Common.format_to_string
(function _ -> rule_elem "" x
)
869 let ident_to_string x
=
870 print_newlines_disj := true;
871 Common.format_to_string
(function _ -> ident x
)
873 let unparse_to_string x
=
874 print_newlines_disj := true;
875 Common.format_to_string
(function _ -> unparse x
)
877 let print_rule_elem re
=
878 let nl = !print_newlines_disj in
879 print_newlines_disj := false;
881 print_newlines_disj := nl