3 (*****************************************************************************)
4 (* mostly a copy paste of parsing_cocci/pretty_print_cocci.ml
5 * todo?: try to factorize ?
7 (*****************************************************************************)
11 let term s
= Ast.unwrap_mcode s
13 (* or perhaps can have in plus, for instance a Disj, but those Disj must be
14 * handled by interactive tool (by proposing alternatives)
16 exception CantBeInPlus
18 (*****************************************************************************)
20 type pos
= Before
| After
| InPlace
22 let rec pp_list_list_any (env
, pr
, pr_elem
, pr_space
, indent
, unindent
)
25 (* Just to be able to copy paste the code from pretty_print_cocci.ml. *)
26 let print_string = pr
in
27 let close_box _
= () in
28 let print_space() = pr
" " in
29 let force_newline () = pr
"\n" in
31 let start_block () = force_newline(); indent
() in
32 let end_block () = unindent
(); force_newline () in
33 let print_string_box s
= print_string s
in
35 let print_option = Common.do_option
in
36 let print_between = Common.print_between in
38 (* --------------------------------------------------------------------- *)
40 let handle_metavar name fn
=
41 match (Common.optionise
(fun () -> List.assoc
(term name
) env
)) with
43 let name_string (_
,s
) = s
in
44 failwith
(Printf.sprintf
"SP line %d: Not found a value in env for: %s"
45 (Ast_cocci.get_mcode_line name
) (name_string (term name
)))
49 (* --------------------------------------------------------------------- *)
50 (* Here we don't care about the annotation on s. *)
51 let mcode fn
(s
,info
,_
,_
) =
52 List.iter
(function str
-> print_string str
; print_string "\n")
54 if info
.Ast.column
> 0 && not
(info
.Ast.strbef
= [])
55 then print_string (String.make info
.Ast.column ' '
);
57 match info
.Ast.straft
with
60 List.iter
(function str
-> print_string "\n"; print_string str
) aft
;
61 print_string "\n"; (*XXX pr current_tabbing *)
64 (* --------------------------------------------------------------------- *)
65 let dots between fn d
=
66 match Ast.unwrap d
with
67 Ast.DOTS
(l
) -> print_between between fn l
68 | Ast.CIRCLES
(l
) -> print_between between fn l
69 | Ast.STARS
(l
) -> print_between between fn l
73 (* --------------------------------------------------------------------- *)
77 match Ast.unwrap i
with
78 Ast.Id
(name
) -> mcode print_string name
79 | Ast.MetaId
(name
,_
,_
,_
) ->
80 handle_metavar name
(function
81 | (Ast_c.MetaIdVal id
) -> pr id
82 | _
-> raise Impossible
84 | Ast.MetaFunc
(name
,_
,_
,_
) ->
85 handle_metavar name
(function
86 | (Ast_c.MetaFuncVal id
) -> pr id
87 | _
-> raise Impossible
89 | Ast.MetaLocalFunc
(name
,_
,_
,_
) ->
90 handle_metavar name
(function
91 | (Ast_c.MetaLocalFuncVal id
) -> pr id
92 | _
-> raise Impossible
95 | Ast.OptIdent
(_
) | Ast.UniqueIdent
(_
) ->
100 (* --------------------------------------------------------------------- *)
103 let rec expression e
=
104 match Ast.unwrap e
with
105 Ast.Ident
(id
) -> ident id
107 | Ast.Constant
(const
) -> mcode constant const
108 | Ast.FunCall
(fn
,lp
,args
,rp
) ->
109 expression fn
; mcode print_string_box lp
;
110 dots (function _
-> ()) expression args
;
111 close_box(); mcode print_string rp
112 | Ast.Assignment
(left
,op
,right
,_
) ->
113 expression left
; print_string " "; mcode assignOp op
;
114 print_string " "; expression right
115 | Ast.CondExpr
(exp1
,why
,exp2
,colon
,exp3
) ->
116 expression exp1
; print_string " "; mcode print_string why
;
117 print_option (function e
-> print_string " "; expression e
) exp2
;
118 print_string " "; mcode print_string colon
; expression exp3
119 | Ast.Postfix
(exp
,op
) -> expression exp
; mcode fixOp op
120 | Ast.Infix
(exp
,op
) -> mcode fixOp op
; expression exp
121 | Ast.Unary
(exp
,op
) -> mcode unaryOp op
; expression exp
122 | Ast.Binary
(left
,op
,right
) ->
123 expression left
; print_string " "; mcode binaryOp op
; print_string " ";
125 | Ast.Nested
(left
,op
,right
) -> failwith
"nested only in minus code"
126 | Ast.Paren
(lp
,exp
,rp
) ->
127 mcode print_string_box lp
; expression exp
; close_box();
128 mcode print_string rp
129 | Ast.ArrayAccess
(exp1
,lb
,exp2
,rb
) ->
130 expression exp1
; mcode print_string_box lb
; expression exp2
; close_box();
131 mcode print_string rb
132 | Ast.RecordAccess
(exp
,pt
,field
) ->
133 expression exp
; mcode print_string pt
; ident field
134 | Ast.RecordPtAccess
(exp
,ar
,field
) ->
135 expression exp
; mcode print_string ar
; ident field
136 | Ast.Cast
(lp
,ty
,rp
,exp
) ->
137 mcode print_string_box lp
; fullType ty
; close_box();
138 mcode print_string rp
; expression exp
139 | Ast.SizeOfExpr
(sizeof
,exp
) ->
140 mcode print_string sizeof
; expression exp
141 | Ast.SizeOfType
(sizeof
,lp
,ty
,rp
) ->
142 mcode print_string sizeof
;
143 mcode print_string_box lp
; fullType ty
; close_box();
144 mcode print_string rp
145 | Ast.TypeExp
(ty
) -> fullType ty
147 | Ast.MetaErr
(name
,_
,_
,_
) ->
148 failwith
"metaErr not handled"
150 | Ast.MetaExpr
(name
,_
,_
,_typedontcare
,_formdontcare
,_
) ->
151 handle_metavar name
(function
152 | Ast_c.MetaExprVal exp
->
153 Pretty_print_c.pp_expression_gen pr_elem pr_space exp
154 | _
-> raise Impossible
157 | Ast.MetaExprList
(name
,_
,_
,_
) ->
158 failwith
"not handling MetaExprList"
160 | Ast.EComma
(cm
) -> mcode print_string cm
; print_space()
167 -> raise CantBeInPlus
169 | Ast.OptExp
(exp
) | Ast.UniqueExp
(exp
) ->
172 and unaryOp
= function
173 Ast.GetRef
-> print_string "&"
174 | Ast.DeRef
-> print_string "*"
175 | Ast.UnPlus
-> print_string "+"
176 | Ast.UnMinus
-> print_string "-"
177 | Ast.Tilde
-> print_string "~"
178 | Ast.Not
-> print_string "!"
180 and assignOp
= function
181 Ast.SimpleAssign
-> print_string "="
182 | Ast.OpAssign
(aop
) -> arithOp aop
; print_string "="
185 Ast.Dec
-> print_string "--"
186 | Ast.Inc
-> print_string "++"
188 and binaryOp
= function
189 Ast.Arith
(aop
) -> arithOp aop
190 | Ast.Logical
(lop
) -> logicalOp lop
192 and arithOp
= function
193 Ast.Plus
-> print_string "+"
194 | Ast.Minus
-> print_string "-"
195 | Ast.Mul
-> print_string "*"
196 | Ast.Div
-> print_string "/"
197 | Ast.Mod
-> print_string "%"
198 | Ast.DecLeft
-> print_string "<<"
199 | Ast.DecRight
-> print_string ">>"
200 | Ast.And
-> print_string "&"
201 | Ast.Or
-> print_string "|"
202 | Ast.Xor
-> print_string "^"
204 and logicalOp
= function
205 Ast.Inf
-> print_string "<"
206 | Ast.Sup
-> print_string ">"
207 | Ast.InfEq
-> print_string "<="
208 | Ast.SupEq
-> print_string ">="
209 | Ast.Eq
-> print_string "=="
210 | Ast.NotEq
-> print_string "!="
211 | Ast.AndLog
-> print_string "&&"
212 | Ast.OrLog
-> print_string "||"
214 and constant
= function
215 Ast.String
(s
) -> print_string "\""; print_string s
; print_string "\""
216 | Ast.Char
(s
) -> print_string s
217 | Ast.Int
(s
) -> print_string s
218 | Ast.Float
(s
) -> print_string s
220 (* --------------------------------------------------------------------- *)
225 match Ast.unwrap ft
with
227 print_option (function x
-> mcode const_vol x
; print_string " ") cv
;
229 | Ast.DisjType _
-> failwith
"can't be in plus"
230 | Ast.OptType
(_
) | Ast.UniqueType
(_
) ->
233 and print_function_pointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) fn
=
234 fullType ty
; mcode print_string lp1
; mcode print_string star
; fn
();
235 mcode print_string rp1
; mcode print_string lp1
;
236 parameter_list params
; mcode print_string rp2
238 and print_function_type
(ty
,lp1
,params
,rp1
) fn
=
239 print_option fullType ty
; fn
(); mcode print_string lp1
;
240 parameter_list params
; mcode print_string rp1
243 match Ast.unwrap ty
with
244 Ast.BaseType
(ty
,sgn
) -> print_option (mcode sign
) sgn
; mcode baseType ty
245 | Ast.ImplicitInt
(sgn
) -> mcode signns sgn
246 | Ast.Pointer
(ty
,star
) -> fullType ty
; ft_space ty
; mcode print_string star
247 | Ast.FunctionPointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
248 print_function_pointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
)
250 | Ast.FunctionType
(am
,ty
,lp1
,params
,rp1
) ->
251 print_function_type
(ty
,lp1
,params
,rp1
) (function _
-> ())
252 | Ast.Array
(ty
,lb
,size
,rb
) ->
253 fullType ty
; mcode print_string lb
; print_option expression size
;
254 mcode print_string rb
255 | Ast.StructUnionName
(kind
,name
) ->
256 mcode structUnion kind
;
257 print_option ident name
258 | Ast.StructUnionDef
(ty
,lb
,decls
,rb
) ->
260 mcode print_string lb
;
261 dots force_newline declaration decls
;
262 mcode print_string rb
263 | Ast.TypeName
(name
)-> mcode print_string name
264 | Ast.MetaType
(name
,_
,_
) ->
265 handle_metavar name
(function
266 Ast_c.MetaTypeVal exp
->
267 Pretty_print_c.pp_type_gen pr_elem pr_space exp
268 | _
-> raise Impossible
)
270 and baseType
= function
271 Ast.VoidType
-> print_string "void"
272 | Ast.CharType
-> print_string "char"
273 | Ast.ShortType
-> print_string "short"
274 | Ast.IntType
-> print_string "int"
275 | Ast.DoubleType
-> print_string "double"
276 | Ast.FloatType
-> print_string "float"
277 | Ast.LongType
-> print_string "long"
279 and structUnion
= function
280 Ast.Struct
-> print_string "struct "
281 | Ast.Union
-> print_string "union "
284 Ast.Signed
-> print_string "signed "
285 | Ast.Unsigned
-> print_string "unsigned "
287 and signns
= function (* no space, like a normal type *)
288 Ast.Signed
-> print_string "signed"
289 | Ast.Unsigned
-> print_string "unsigned"
292 and const_vol
= function
293 Ast.Const
-> print_string "const "
294 | Ast.Volatile
-> print_string "volatile "
296 (* --------------------------------------------------------------------- *)
297 (* Function declaration *)
299 and storage
= function
300 Ast.Static
-> print_string "static "
301 | Ast.Auto
-> print_string "auto "
302 | Ast.Register
-> print_string "register "
303 | Ast.Extern
-> print_string "extern "
305 (* --------------------------------------------------------------------- *)
306 (* Variable declaration *)
308 and print_named_type ty id
=
309 match Ast.unwrap ty
with
310 Ast.Type
(None
,ty1
) ->
311 (match Ast.unwrap ty1
with
312 Ast.FunctionPointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
313 print_function_pointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
)
314 (function _
-> print_string " "; ident id
)
315 | Ast.FunctionType
(am
,ty
,lp1
,params
,rp1
) ->
316 print_function_type
(ty
,lp1
,params
,rp1
)
317 (function _
-> print_string " "; ident id
)
318 | Ast.Array
(_
,_
,_
,_
) ->
320 match Ast.unwrap ty
with
321 Ast.Array
(ty
,lb
,size
,rb
) ->
322 (match Ast.unwrap ty
with
327 mcode print_string lb
;
328 print_option expression size
;
329 mcode print_string rb
)
330 | _
-> failwith
"complex array types not supported")
331 | _
-> typeC ty
; ty_space ty
; ident id
; k
() in
332 loop ty1
(function _
-> ())
333 (*| should have a case here for pointer to array or function type
334 that would put ( * ) around the variable. This makes one wonder
335 why we really need a special case for function pointer *)
336 | _
-> fullType ty
; ft_space ty
; ident id
)
337 | _
-> fullType ty
; ft_space ty
; ident id
340 match Ast.unwrap ty
with
341 Ast.Pointer
(_
,_
) -> ()
345 match Ast.unwrap ty
with
347 (match Ast.unwrap ty
with
348 Ast.Pointer
(_
,_
) -> ()
349 | _
-> print_space())
353 match Ast.unwrap d
with
354 Ast.Init
(stg
,ty
,id
,eq
,ini
,sem
) ->
355 print_option (mcode storage
) stg
;
356 print_named_type ty id
;
357 print_string " "; mcode print_string eq
;
358 print_string " "; initialiser
true ini
; mcode print_string sem
359 | Ast.UnInit
(stg
,ty
,id
,sem
) ->
360 print_option (mcode storage
) stg
;
361 print_named_type ty id
;
362 mcode print_string sem
363 | Ast.MacroDecl
(name
,lp
,args
,rp
,sem
) ->
364 ident name
; mcode print_string_box lp
;
365 dots (function _
-> ()) expression args
;
366 close_box(); mcode print_string rp
; mcode print_string sem
367 | Ast.TyDecl
(ty
,sem
) -> fullType ty
; mcode print_string sem
368 | Ast.Typedef
(stg
,ty
,id
,sem
) ->
369 mcode print_string stg
;
370 fullType ty
; typeC id
;
371 mcode print_string sem
372 | Ast.DisjDecl
(_
) | Ast.MetaDecl
(_
,_
,_
) -> raise CantBeInPlus
373 | Ast.Ddots
(_
,_
) -> raise CantBeInPlus
374 | Ast.OptDecl
(decl
) | Ast.UniqueDecl
(decl
) ->
377 (* --------------------------------------------------------------------- *)
380 and initialiser nlcomma i
=
381 match Ast.unwrap i
with
382 Ast.InitExpr
(exp
) -> expression exp
383 | Ast.InitList
(lb
,initlist
,rb
,[]) ->
384 mcode print_string lb
; start_block();
385 (* awkward, because the comma is separate from the initialiser *)
386 let rec loop = function
388 | [x
] -> initialiser
false x
389 | x
::xs
-> initialiser nlcomma x
; loop xs
in
391 end_block(); mcode print_string rb
392 | Ast.InitList
(lb
,initlist
,rb
,_
) -> failwith
"unexpected whencode in plus"
393 | Ast.InitGccDotName
(dot
,name
,eq
,ini
) ->
394 mcode print_string dot
; ident name
; print_string " ";
395 mcode print_string eq
; print_string " "; initialiser nlcomma ini
396 | Ast.InitGccName
(name
,eq
,ini
) ->
397 ident name
; mcode print_string eq
; initialiser nlcomma ini
398 | Ast.InitGccIndex
(lb
,exp
,rb
,eq
,ini
) ->
399 mcode print_string lb
; expression exp
; mcode print_string rb
;
400 print_string " "; mcode print_string eq
; print_string " ";
401 initialiser nlcomma ini
402 | Ast.InitGccRange
(lb
,exp1
,dots,exp2
,rb
,eq
,ini
) ->
403 mcode print_string lb
; expression exp1
; mcode print_string dots;
404 expression exp2
; mcode print_string rb
;
405 print_string " "; mcode print_string eq
; print_string " ";
406 initialiser nlcomma ini
407 | Ast.IComma
(comma
) ->
408 mcode print_string comma
;
409 if nlcomma
then force_newline()
410 | Ast.OptIni
(ini
) | Ast.UniqueIni
(ini
) ->
413 (* --------------------------------------------------------------------- *)
416 and parameterTypeDef p
=
417 match Ast.unwrap p
with
418 Ast.VoidParam
(ty
) -> fullType ty
419 | Ast.Param
(ty
,Some id
) -> print_named_type ty id
420 | Ast.Param
(ty
,None
) -> fullType ty
422 | Ast.MetaParam
(name
,_
,_
) ->
423 failwith
"not handling MetaParam"
424 | Ast.MetaParamList
(name
,_
,_
,_
) ->
425 failwith
"not handling MetaParamList"
427 | Ast.PComma
(cm
) -> mcode print_string cm
; print_space()
430 -> raise CantBeInPlus
431 | Ast.OptParam
(param
) | Ast.UniqueParam
(param
) -> raise CantBeInPlus
433 and parameter_list l
= dots (function _
-> ()) parameterTypeDef l
437 (* --------------------------------------------------------------------- *)
440 let rec inc_file = function
443 print_between (function _
-> print_string "/") inc_elem elems
;
445 | Ast.NonLocal
(elems
) ->
447 print_between (function _
-> print_string "/") inc_elem elems
;
450 and inc_elem
= function
451 Ast.IncPath s
-> print_string s
452 | Ast.IncDots
-> print_string "..."
454 (* --------------------------------------------------------------------- *)
457 and rule_elem arity re
=
458 match Ast.unwrap re
with
459 Ast.FunHeader
(_
,_
,fninfo
,name
,lp
,params
,rp
) ->
460 print_string arity
; List.iter print_fninfo fninfo
;
461 ident name
; mcode print_string_box lp
;
462 parameter_list params
; close_box(); mcode print_string rp
;
464 | Ast.Decl
(_
,_
,decl
) -> print_string arity
; declaration decl
466 | Ast.SeqStart
(brace
) ->
467 print_string arity
; mcode print_string brace
; start_block()
468 | Ast.SeqEnd
(brace
) ->
469 end_block(); print_string arity
; mcode print_string brace
471 | Ast.ExprStatement
(exp
,sem
) ->
472 print_string arity
; expression exp
; mcode print_string sem
474 | Ast.IfHeader
(iff
,lp
,exp
,rp
) ->
476 mcode print_string iff
; print_string " "; mcode print_string_box lp
;
477 expression exp
; close_box(); mcode print_string rp
; print_string " "
479 print_string arity
; mcode print_string els
; print_string " "
481 | Ast.WhileHeader
(whl
,lp
,exp
,rp
) ->
483 mcode print_string whl
; print_string " "; mcode print_string_box lp
;
484 expression exp
; close_box(); mcode print_string rp
; print_string " "
486 print_string arity
; mcode print_string d
; print_string " "
487 | Ast.WhileTail
(whl
,lp
,exp
,rp
,sem
) ->
489 mcode print_string whl
; print_string " "; mcode print_string_box lp
;
490 expression exp
; close_box(); mcode print_string rp
;
491 mcode print_string sem
492 | Ast.ForHeader
(fr
,lp
,e1
,sem1
,e2
,sem2
,e3
,rp
) ->
494 mcode print_string fr
; mcode print_string_box lp
;
495 print_option expression e1
; mcode print_string sem1
;
496 print_option expression e2
; mcode print_string sem2
;
497 print_option expression e3
; close_box();
498 mcode print_string rp
; print_string " "
499 | Ast.IteratorHeader
(nm
,lp
,args
,rp
) ->
501 ident nm
; print_string " "; mcode print_string_box lp
;
502 dots (function _
-> ()) expression args
; close_box();
503 mcode print_string rp
; print_string " "
505 | Ast.SwitchHeader
(switch
,lp
,exp
,rp
) ->
507 mcode print_string switch
; print_string " "; mcode print_string_box lp
;
508 expression exp
; close_box(); mcode print_string rp
; print_string " "
510 | Ast.Break
(br
,sem
) ->
511 print_string arity
; mcode print_string br
; mcode print_string sem
512 | Ast.Continue
(cont
,sem
) ->
513 print_string arity
; mcode print_string cont
; mcode print_string sem
514 | Ast.Label
(l
,dd
) -> ident l
; mcode print_string dd
515 | Ast.Goto
(goto
,l
,sem
) ->
516 mcode print_string goto
; ident l
; mcode print_string sem
517 | Ast.Return
(ret
,sem
) ->
518 print_string arity
; mcode print_string ret
;
519 mcode print_string sem
520 | Ast.ReturnExpr
(ret
,exp
,sem
) ->
521 print_string arity
; mcode print_string ret
; print_string " ";
522 expression exp
; mcode print_string sem
524 | Ast.Exp
(exp
) -> print_string arity
; expression exp
525 | Ast.TopExp
(exp
) -> print_string arity
; expression exp
526 | Ast.Ty
(ty
) -> print_string arity
; fullType ty
527 | Ast.TopInit
(init
) -> initialiser
false init
528 | Ast.Include
(inc
,s
) ->
529 mcode print_string inc
; print_string " "; mcode inc_file s
530 | Ast.DefineHeader
(def
,id
,params
) ->
531 mcode print_string def
; print_string " "; ident id
;
532 print_define_parameters params
533 | Ast.Default
(def
,colon
) ->
534 mcode print_string def
; mcode print_string colon
; print_string " "
535 | Ast.Case
(case
,exp
,colon
) ->
536 mcode print_string case
; print_string " "; expression exp
;
537 mcode print_string colon
; print_string " "
538 | Ast.DisjRuleElem
(res
) -> raise CantBeInPlus
540 | Ast.MetaRuleElem
(name
,_
,_
) ->
543 | Ast.MetaStmt
(name
,_
,_
,_
) ->
544 handle_metavar name
(function
545 | Ast_c.MetaStmtVal exp
->
546 Pretty_print_c.pp_statement_gen pr_elem pr_space exp
547 | _
-> raise Impossible
549 | Ast.MetaStmtList
(name
,_
,_
) ->
551 "MetaStmtList not supported (not even in ast_c metavars binding)"
553 and print_define_parameters params
=
554 match Ast.unwrap params
with
556 | Ast.DParams
(lp
,params
,rp
) ->
557 mcode print_string lp
;
558 dots (function _
-> ()) print_define_param params
; mcode print_string rp
560 and print_define_param param
=
561 match Ast.unwrap param
with
562 Ast.DParam
(id
) -> ident id
563 | Ast.DPComma
(comma
) -> mcode print_string comma
564 | Ast.DPdots
(dots) -> mcode print_string dots
565 | Ast.DPcircles
(circles
) -> mcode print_string circles
566 | Ast.OptDParam
(dp
) -> print_string "?"; print_define_param dp
567 | Ast.UniqueDParam
(dp
) -> print_string "!"; print_define_param dp
569 and print_fninfo
= function
570 Ast.FStorage
(stg
) -> mcode storage stg
571 | Ast.FType
(ty
) -> fullType ty
572 | Ast.FInline
(inline
) -> mcode print_string inline
; print_string " "
573 | Ast.FAttr
(attr
) -> mcode print_string attr
; print_string " " in
575 let rec statement arity s
=
576 match Ast.unwrap s
with
577 Ast.Seq
(lbrace
,decls
,body
,rbrace
) ->
578 rule_elem arity lbrace
;
579 dots force_newline (statement arity
) decls
;
580 dots force_newline (statement arity
) body
;
581 rule_elem arity rbrace
583 | Ast.IfThen
(header
,branch
,_
) ->
584 rule_elem arity header
; statement arity branch
585 | Ast.IfThenElse
(header
,branch1
,els
,branch2
,_
) ->
586 rule_elem arity header
; statement arity branch1
; print_string " ";
587 rule_elem arity els
; statement arity branch2
589 | Ast.While
(header
,body
,_
) ->
590 rule_elem arity header
; statement arity body
591 | Ast.Do
(header
,body
,tail
) ->
592 rule_elem arity header
; statement arity body
;
594 | Ast.For
(header
,body
,_
) ->
595 rule_elem arity header
; statement arity body
596 | Ast.Iterator
(header
,body
,(_
,_
,_
,aft
)) ->
597 rule_elem arity header
; statement arity body
;
598 mcode (function _
-> ()) ((),Ast.no_info
,aft
,Ast.NoMetaPos
)
600 | Ast.Switch
(header
,lb
,cases
,rb
) ->
601 rule_elem arity header
; rule_elem arity lb
;
602 List.iter
(function x
-> case_line arity x
; force_newline()) cases
;
605 | Ast.Atomic
(re
) -> rule_elem arity re
607 | Ast.FunDecl
(header
,lbrace
,decls
,body
,rbrace
) ->
608 rule_elem arity header
; rule_elem arity lbrace
;
609 dots force_newline (statement arity
) decls
;
610 dots force_newline (statement arity
) body
; rule_elem arity rbrace
612 | Ast.Define
(header
,body
) ->
613 rule_elem arity header
; print_string " ";
614 dots force_newline (statement arity
) body
616 | Ast.Disj
(_
)| Ast.Nest
(_
)
617 | Ast.Dots
(_
) | Ast.Circles
(_
) | Ast.Stars
(_
) ->
620 | Ast.OptStm
(s
) | Ast.UniqueStm
(s
) ->
623 and case_line arity c
=
624 match Ast.unwrap c
with
625 Ast.CaseLine
(header
,code
) ->
626 rule_elem arity header
; print_string " ";
627 dots force_newline (statement arity
) code
628 | Ast.OptCase
(case
) -> raise CantBeInPlus
in
631 match Ast.unwrap t
with
632 Ast.FILEINFO
(old_file
,new_file
) -> raise CantBeInPlus
633 | Ast.DECL
(stmt
) -> statement "" stmt
634 | Ast.CODE
(stmt_dots
) -> dots force_newline (statement "") stmt_dots
635 | Ast.ERRORWORDS
(exps
) -> raise CantBeInPlus
640 print_between (function _ -> force_newline(); force_newline()) top_level
644 let if_open_brace = function "{" -> true | _
-> false in
646 let rec pp_any = function
647 (* assert: normally there is only CONTEXT NOTHING tokens in any *)
648 Ast.FullTypeTag
(x
) -> fullType x
; false
649 | Ast.BaseTypeTag
(x
) -> baseType x
; false
650 | Ast.StructUnionTag
(x
) -> structUnion x
; false
651 | Ast.SignTag
(x
) -> sign x
; false
653 | Ast.IdentTag
(x
) -> ident x
; false
655 | Ast.ExpressionTag
(x
) -> expression x
; false
657 | Ast.ConstantTag
(x
) -> constant x
; false
658 | Ast.UnaryOpTag
(x
) -> unaryOp x
; false
659 | Ast.AssignOpTag
(x
) -> assignOp x
; false
660 | Ast.FixOpTag
(x
) -> fixOp x
; false
661 | Ast.BinaryOpTag
(x
) -> binaryOp x
; false
662 | Ast.ArithOpTag
(x
) -> arithOp x
; false
663 | Ast.LogicalOpTag
(x
) -> logicalOp x
; false
665 | Ast.InitTag
(x
) -> initialiser
false x
; false
666 | Ast.DeclarationTag
(x
) -> declaration x
; false
668 | Ast.StorageTag
(x
) -> storage x
; false
669 | Ast.IncFileTag
(x
) -> inc_file x
; false
671 | Ast.Rule_elemTag
(x
) -> rule_elem
"" x
; false
672 | Ast.StatementTag
(x
) -> statement "" x
; false
673 | Ast.CaseLineTag
(x
) -> case_line
"" x
; false
675 | Ast.ConstVolTag
(x
) -> const_vol x
; false
676 | Ast.Token
(x
,None
) -> print_string x
; if_open_brace x
677 | Ast.Token
(x
,Some info
) ->
684 (* if x ==~ Common.regexp_alpha then print_string " "; *)
686 (*"return" |*) "else" -> print_string " "
688 (x
,info
,(),Ast.NoMetaPos
);
691 | Ast.Code
(x
) -> let _ = top_level x
in false
693 (* this is not '...', but a list of expr/statement/params, and
694 normally there should be no '...' inside them *)
695 | Ast.ExprDotsTag
(x
) -> dots (function _ -> ()) expression x
; false
696 | Ast.ParamDotsTag
(x
) -> parameter_list x
; false
697 | Ast.StmtDotsTag
(x
) -> dots (function _ -> pr
"\n") (statement "") x
; false
698 | Ast.DeclDotsTag
(x
) -> dots (function _ -> pr
"\n") declaration x
; false
700 | Ast.TypeCTag
(x
) -> typeC x
; false
701 | Ast.ParamTag
(x
) -> parameterTypeDef x
; false
702 | Ast.SgrepStartTag
(x
) -> failwith
"unexpected start tag"
703 | Ast.SgrepEndTag
(x
) -> failwith
"unexpected end tag"
706 (* todo? imitate what is in pretty_print_cocci ? *)
710 (* for many tags, we must not do a newline before the first '+' *)
712 match Ast.unwrap s
with Ast.FunDecl
_ -> true | _ -> false in
713 let unindent_before = function
714 (* need to get unindent before newline for } *)
715 (Ast.Token
("}",_)::_) -> true
718 (if unindent_before x
then unindent
());
720 let newline_before _ =
723 let hd = List.hd xxs
in
725 (Ast.StatementTag s
::_) when isfn s
-> pr
"\n\n"
726 | (Ast.Rule_elemTag
_::_) | (Ast.StatementTag
_::_)
728 | (Ast.DeclarationTag
_::_) | (Ast.Token
("}",_)::_) -> prnl hd
730 let newline_after _ =
733 match List.rev
(List.hd(List.rev xxs
)) with
734 (Ast.StatementTag s
::_) when isfn s
-> pr
"\n\n"
735 | (Ast.Rule_elemTag
_::_) | (Ast.StatementTag
_::_)
737 | (Ast.DeclarationTag
_::_) | (Ast.Token
("{",_)::_) -> pr
"\n"
739 (* print a newline at the beginning, if needed *)
741 (* print a newline before each of the rest *)
742 let rec loop leading_newline indent_needed
= function
747 match (indent_needed
,unindent_before x
) with
748 (true,true) -> pr
"\n"
749 | (true,false) -> pr
"\n"; indent
()
750 | (false,true) -> unindent
(); pr
"\n"
751 | (false,false) -> pr
"\n");
753 List.fold_left
(function indent_needed -> pp_any) false x
in
754 loop true indent_needed xs
in
755 loop false false (x
::xs
);
756 (* print a newline at the end, if needed *)