2 * Copyright (C) 2012, INRIA.
3 * Copyright (C) 2010, University of Copenhagen DIKU and INRIA.
4 * Copyright (C) 2006, 2007 Julia Lawall
6 * This program is free software; you can redistribute it and/or
7 * modify it under the terms of the GNU General Public License (GPL)
8 * version 2 as published by the Free Software Foundation.
10 * This program 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 * file license.txt for more details.
15 * This file was part of Coccinelle.
19 (*****************************************************************************)
20 (* mostly a copy paste of parsing_cocci/pretty_print_cocci.ml
21 * todo?: try to factorize ?
23 (*****************************************************************************)
25 module Ast
= Ast_cocci
27 let term s
= Ast.unwrap_mcode s
29 (* or perhaps can have in plus, for instance a Disj, but those Disj must be
30 * handled by interactive tool (by proposing alternatives)
32 exception CantBeInPlus
34 (*****************************************************************************)
36 type pos
= Before
| After
| InPlace
37 type nlhint
= StartBox
| EndBox
| SpaceOrNewline
of string ref
39 let get_string_info = function
40 Ast.Noindent s
| Ast.Indent s
| Ast.Space s
-> s
45 (env
, pr
, pr_celem
, pr_cspace
, pr_space
, pr_arity
, pr_barrier
,
46 indent
, unindent
, eatspace
)
47 generating xxs before
=
49 (* Just to be able to copy paste the code from pretty_print_cocci.ml. *)
50 let print_string s line lcol
=
51 let rcol = if lcol
= unknown then unknown else lcol
+ (String.length s
) in
52 pr s line lcol
rcol None
in
53 let print_string_with_hint hint s line lcol
=
54 let rcol = if lcol
= unknown then unknown else lcol
+ (String.length s
) in
55 pr s line lcol
rcol (Some hint
) in
56 let print_text s
= pr s
unknown unknown unknown None
in
57 let close_box _
= () in
58 let force_newline _
= print_text "\n" in
60 let start_block () = force_newline(); indent
() in
61 let end_block () = unindent
true; force_newline () in
62 let print_string_box s
= print_string s
in
64 let print_option = Common.do_option
in
65 let print_option_space fn
= function
67 | Some x
-> fn x
; pr_space
() in
68 let print_option_prespace fn
= function
70 | Some x
-> pr_space
(); fn x
in
71 let print_between = Common.print_between in
73 let rec param_print_between between fn
= function
76 | x
::xs
-> fn x
; between x
; param_print_between between fn xs
in
79 let outdent _
= () (* should go to leftmost col, does nothing now *) in
82 Pretty_print_c.mk_pretty_printers pr_celem pr_cspace
83 force_newline indent
outdent (function _
-> unindent
true) in
85 (* --------------------------------------------------------------------- *)
86 (* Only for make_hrule, print plus code, unbound metavariables *)
88 (* avoid polyvariance problems *)
89 let anything : (Ast.anything -> unit) ref = ref (function _
-> ()) in
91 let rec print_anything = function
95 print_between force_newline print_anything_list stream
;
98 and print_anything_list
= function
101 | bef
::((aft
::_
) as rest
) ->
105 Ast.Rule_elemTag
(_
) | Ast.AssignOpTag
(_
) | Ast.BinaryOpTag
(_
)
106 | Ast.ArithOpTag
(_
) | Ast.LogicalOpTag
(_
)
107 | Ast.Token
("if",_
) | Ast.Token
("while",_
) -> true | _
-> false) or
109 Ast.Rule_elemTag
(_
) | Ast.AssignOpTag
(_
) | Ast.BinaryOpTag
(_
)
110 | Ast.ArithOpTag
(_
) | Ast.LogicalOpTag
(_
) | Ast.Token
("{",_
) -> true
112 if space then pr_space
();
113 print_anything_list rest
in
115 let print_around printer
term = function
116 Ast.NOTHING
-> printer
term
117 | Ast.BEFORE
(bef
,_
) -> print_anything bef
; printer
term
118 | Ast.AFTER
(aft
,_
) -> printer
term; print_anything aft
119 | Ast.BEFOREAFTER
(bef
,aft
,_
) ->
120 print_anything bef
; printer
term; print_anything aft
in
122 let print_string_befaft fn fn1 x info
=
123 let print ln col s
= print_string (get_string_info s
) ln col
in
125 (function (s
,ln
,col
) -> fn1
(); print ln col s
; force_newline())
129 (function (s
,ln
,col
) -> force_newline(); fn1
(); print ln col s
)
131 let print_meta (r
,x
) = print_text x
in
136 Ast.MetaPos
(name
,_
,_
,_
,_
) ->
137 let name = Ast.unwrap_mcode
name in
138 print_text "@"; print_meta name)
141 (* --------------------------------------------------------------------- *)
143 let mcode fn
(s
,info
,mc
,pos
) =
144 let line = info
.Ast.line in
145 let lcol = info
.Ast.column
in
146 match (generating
,mc
) with
148 (* printing for transformation *)
149 (* Here we don't care about the annotation on s. *)
150 let print_comments lb comments
=
152 (function line_before
->
153 function (str
,line,col
) ->
154 match line_before
with
158 Ast.Noindent s
-> unindent
false; s
160 | Ast.Space s
-> s
in
161 print_string str line col
; Some
line
162 | Some lb
when line =|= lb
->
163 print_string (get_string_info str) line col
; Some
line
166 (* not super elegant to put side-effecting unindent in a let
170 Ast.Noindent s
-> unindent
false; s
172 | Ast.Space s
-> s
in
173 print_string str line col
; Some
line)
175 let line_before = print_comments None info
.Ast.strbef
in
176 (match line_before with
178 | Some lb
when lb
=|= info
.Ast.line -> ()
179 | _
-> force_newline());
181 let _ = print_comments (Some info
.Ast.line) info
.Ast.straft
in
182 (* newline after a pragma
183 should really store parsed versions of the strings, but make a cheap
185 print_comments takes care of interior newlines *)
187 (* printing for rule generation *)
188 | (true, Ast.MINUS
(_,_,_,plus_stream
)) ->
191 fn s
line lcol; print_pos pos
;
192 (match plus_stream
with
193 Ast.NOREPLACEMENT
-> ()
194 | Ast.REPLACEMENT
(plus_stream
,ct
) -> print_anything plus_stream
)
195 | (true, Ast.CONTEXT
(_,plus_streams
)) ->
196 let fn s
= force_newline(); fn s
line lcol; print_pos pos
in
197 print_around fn s plus_streams
198 | (true,Ast.PLUS
Ast.ONE
) ->
200 force_newline(); print_text "+ "; fn s
line lcol; print_pos pos
in
201 print_string_befaft fn (function _ -> print_text "+ ") s info
202 | (true,Ast.PLUS
Ast.MANY
) ->
204 force_newline(); print_text "++ "; fn s
line lcol; print_pos pos
in
205 print_string_befaft fn (function _ -> print_text "++ ") s info
209 (* --------------------------------------------------------------------- *)
211 let lookup_metavar name =
212 let ((_,b
) as s
,info
,mc
,pos
) = name in
213 let line = info
.Ast.line in
214 let lcol = info
.Ast.column
in
215 let rcol = if lcol = unknown then unknown else lcol + (String.length b
) in
216 let res = Common.optionise
(fun () -> List.assoc s env
) in
217 (res,b
,line,lcol,rcol) in
219 let handle_metavar name fn =
220 let (res,name_string
,line,lcol,rcol) = lookup_metavar name in
224 then mcode (function _ -> print_string name_string
) name
227 (Printf.sprintf
"SP line %d: Not found a value in env for: %s"
230 pr_barrier
line lcol;
233 (* call mcode to preserve the -+ annotation *)
234 mcode (fun _ _ _ -> fn e
) name
238 (* --------------------------------------------------------------------- *)
239 let dots between
fn d
=
240 match Ast.unwrap d
with
241 Ast.DOTS
(l
) -> param_print_between between
fn l
242 | Ast.CIRCLES
(l
) -> param_print_between between
fn l
243 | Ast.STARS
(l
) -> param_print_between between
fn l
246 let nest_dots starter ender
fn f d
=
247 mcode print_string starter
;
249 (match Ast.unwrap d
with
250 Ast.DOTS
(l
) -> print_between force_newline fn l
251 | Ast.CIRCLES
(l
) -> print_between force_newline fn l
252 | Ast.STARS
(l
) -> print_between force_newline fn l
);
254 mcode print_string ender
257 let print_disj_list fn l
=
259 print_between (function _ -> print_text "\n|\n") fn l
;
260 print_text "\n)\n" in
262 (* --------------------------------------------------------------------- *)
266 match Ast.unwrap i
with
267 Ast.Id
(name) -> mcode print_string name
268 | Ast.MetaId
(name,_,_,_) ->
269 handle_metavar name (function
270 | (Ast_c.MetaIdVal
(id
,_)) -> print_text id
271 | _ -> raise
(Impossible
142)
273 | Ast.MetaFunc
(name,_,_,_) ->
274 handle_metavar name (function
275 | (Ast_c.MetaFuncVal id
) -> print_text id
276 | _ -> raise
(Impossible
143)
278 | Ast.MetaLocalFunc
(name,_,_,_) ->
279 handle_metavar name (function
280 | (Ast_c.MetaLocalFuncVal id
) -> print_text id
281 | _ -> raise
(Impossible
144)
284 | Ast.AsIdent
(id
,asid
) -> ident id
286 | Ast.DisjId
(id_list
) ->
288 then print_disj_list ident id_list
289 else raise CantBeInPlus
290 | Ast.OptIdent
(_) | Ast.UniqueIdent
(_) ->
295 (* --------------------------------------------------------------------- *)
298 let rec expression e
=
316 let left_prec_of (op
, _, _, _) =
318 | Ast.Arith
Ast.Plus
-> addit
319 | Ast.Arith
Ast.Minus
-> addit
320 | Ast.Arith
Ast.Mul
-> mulit
321 | Ast.Arith
Ast.Div
-> mulit
322 | Ast.Arith
Ast.Min
-> relat
323 | Ast.Arith
Ast.Max
-> relat
324 | Ast.Arith
Ast.Mod
-> mulit
325 | Ast.Arith
Ast.DecLeft
-> shift
326 | Ast.Arith
Ast.DecRight
-> shift
327 | Ast.Arith
Ast.And
-> bit_and
328 | Ast.Arith
Ast.Or
-> bit_or
329 | Ast.Arith
Ast.Xor
-> bit_xor
331 | Ast.Logical
Ast.Inf
-> relat
332 | Ast.Logical
Ast.Sup
-> relat
333 | Ast.Logical
Ast.InfEq
-> relat
334 | Ast.Logical
Ast.SupEq
-> relat
335 | Ast.Logical
Ast.Eq
-> equal
336 | Ast.Logical
Ast.NotEq
-> equal
337 | Ast.Logical
Ast.AndLog
-> log_and
338 | Ast.Logical
Ast.OrLog
-> log_or
340 let right_prec_of (op
, _, _, _) =
342 | Ast.Arith
Ast.Plus
-> mulit
343 | Ast.Arith
Ast.Minus
-> mulit
344 | Ast.Arith
Ast.Mul
-> cast
345 | Ast.Arith
Ast.Div
-> cast
346 | Ast.Arith
Ast.Min
-> shift
347 | Ast.Arith
Ast.Max
-> shift
348 | Ast.Arith
Ast.Mod
-> cast
349 | Ast.Arith
Ast.DecLeft
-> addit
350 | Ast.Arith
Ast.DecRight
-> addit
351 | Ast.Arith
Ast.And
-> equal
352 | Ast.Arith
Ast.Or
-> bit_xor
353 | Ast.Arith
Ast.Xor
-> bit_and
355 | Ast.Logical
Ast.Inf
-> shift
356 | Ast.Logical
Ast.Sup
-> shift
357 | Ast.Logical
Ast.InfEq
-> shift
358 | Ast.Logical
Ast.SupEq
-> shift
359 | Ast.Logical
Ast.Eq
-> relat
360 | Ast.Logical
Ast.NotEq
-> relat
361 | Ast.Logical
Ast.AndLog
-> bit_or
362 | Ast.Logical
Ast.OrLog
-> log_and
364 let prec_of_c = function
365 | Ast_c.Ident
(ident) -> primary
366 | Ast_c.Constant
(c
) -> primary
367 | Ast_c.FunCall
(e
, es
) -> postfix
368 | Ast_c.CondExpr
(e1
, e2
, e3
) -> cond
369 | Ast_c.Sequence
(e1
, e2
) -> top
370 | Ast_c.Assignment
(e1
, op
, e2
) -> assign
371 | Ast_c.Postfix
(e
, op
) -> postfix
372 | Ast_c.Infix
(e
, op
) -> unary
373 | Ast_c.Unary
(e
, op
) -> unary
374 | Ast_c.Binary
(e1
, Ast_c.Arith
Ast_c.Plus
, e2
) -> addit
375 | Ast_c.Binary
(e1
, Ast_c.Arith
Ast_c.Minus
, e2
) -> addit
376 | Ast_c.Binary
(e1
, Ast_c.Arith
Ast_c.Mul
, e2
) -> addit
377 | Ast_c.Binary
(e1
, Ast_c.Arith
Ast_c.Div
, e2
) -> addit
378 | Ast_c.Binary
(e1
, Ast_c.Arith
Ast_c.Min
, e2
) -> relat
379 | Ast_c.Binary
(e1
, Ast_c.Arith
Ast_c.Max
, e2
) -> relat
380 | Ast_c.Binary
(e1
, Ast_c.Arith
Ast_c.Mod
, e2
) -> addit
381 | Ast_c.Binary
(e1
, Ast_c.Arith
Ast_c.DecLeft
, e2
) -> addit
382 | Ast_c.Binary
(e1
, Ast_c.Arith
Ast_c.DecRight
, e2
) -> addit
383 | Ast_c.Binary
(e1
, Ast_c.Arith
Ast_c.And
, e2
) -> addit
384 | Ast_c.Binary
(e1
, Ast_c.Arith
Ast_c.Or
, e2
) -> addit
385 | Ast_c.Binary
(e1
, Ast_c.Arith
Ast_c.Xor
, e2
) -> addit
386 | Ast_c.Binary
(e1
, Ast_c.Logical
Ast_c.AndLog
, e2
) -> addit
387 | Ast_c.Binary
(e1
, Ast_c.Logical
Ast_c.OrLog
, e2
) -> addit
388 | Ast_c.Binary
(e1
, Ast_c.Logical
Ast_c.Eq
, e2
) -> addit
389 | Ast_c.Binary
(e1
, Ast_c.Logical
Ast_c.NotEq
, e2
) -> addit
390 | Ast_c.Binary
(e1
, Ast_c.Logical
Ast_c.Sup
, e2
) -> addit
391 | Ast_c.Binary
(e1
, Ast_c.Logical
Ast_c.Inf
, e2
) -> addit
392 | Ast_c.Binary
(e1
, Ast_c.Logical
Ast_c.SupEq
, e2
) -> addit
393 | Ast_c.Binary
(e1
, Ast_c.Logical
Ast_c.InfEq
, e2
) -> addit
394 | Ast_c.ArrayAccess
(e1
, e2
) -> postfix
395 | Ast_c.RecordAccess
(e
, name) -> postfix
396 | Ast_c.RecordPtAccess
(e
, name) -> postfix
397 | Ast_c.SizeOfExpr
(e
) -> unary
398 | Ast_c.SizeOfType
(t
) -> unary
399 | Ast_c.Cast
(t
, e
) -> cast
400 | Ast_c.StatementExpr
(statxs
, _) -> top
401 | Ast_c.Constructor
(t
, init
) -> unary
402 | Ast_c.ParenExpr
(e
) -> primary
403 | Ast_c.New
(_, t
) -> unary
404 | Ast_c.Delete
(t
) -> unary
407 let rec loop e prec
=
408 match Ast.unwrap e
with
409 Ast.Ident
(id
) -> ident id
410 | Ast.Constant
(const
) -> mcode constant const
411 | Ast.FunCall
(fn,lp
,args
,rp
) ->
412 loop fn postfix; mcode (print_string_with_hint StartBox
) lp
;
413 dots (function _ -> ()) arg_expression args
;
414 mcode (print_string_with_hint EndBox
) rp
415 | Ast.Assignment
(left
,op
,right
,_) ->
416 loop left
unary; pr_space
(); mcode assignOp op
;
417 pr_space
(); loop right
assign
418 | Ast.Sequence
(left
,op
,right
) ->
419 loop left
top; mcode print_string op
;
420 pr_space
(); loop right
assign
421 | Ast.CondExpr
(exp1
,why
,exp2
,colon
,exp3
) ->
422 loop exp1
log_or; pr_space
(); mcode print_string why
;
423 print_option (function e
-> pr_space
(); loop e
top) exp2
;
424 pr_space
(); mcode print_string colon
; pr_space
(); loop exp3
cond
425 | Ast.Postfix
(exp
,op
) -> loop exp
postfix; mcode fixOp op
426 | Ast.Infix
(exp
,op
) -> mcode fixOp op
; loop exp
unary
427 | Ast.Unary
(exp
,op
) -> mcode unaryOp op
; loop exp
unary
428 | Ast.Binary
(left
,op
,right
) ->
429 loop left
(left_prec_of op
); pr_space
(); mcode binaryOp op
; pr_space
();
430 loop right
(right_prec_of op
)
431 | Ast.Nested
(left
,op
,right
) -> failwith
"nested only in minus code"
432 | Ast.Paren
(lp
,exp
,rp
) ->
433 mcode print_string_box lp
; loop exp
top; close_box();
434 mcode print_string rp
435 | Ast.ArrayAccess
(exp1
,lb
,exp2
,rb
) ->
436 loop exp1
postfix; mcode print_string_box lb
; loop exp2
top; close_box();
437 mcode print_string rb
438 | Ast.RecordAccess
(exp
,pt
,field
) ->
439 loop exp
postfix; mcode print_string pt
; ident field
440 | Ast.RecordPtAccess
(exp
,ar
,field
) ->
441 loop exp
postfix; mcode print_string ar
; ident field
442 | Ast.Cast
(lp
,ty
,rp
,exp
) ->
443 mcode print_string_box lp
; fullType ty
; close_box();
444 mcode print_string rp
; loop exp
cast
445 | Ast.SizeOfExpr
(sizeof
,exp
) ->
446 mcode print_string sizeof
; loop exp
unary
447 | Ast.SizeOfType
(sizeof
,lp
,ty
,rp
) ->
448 mcode print_string sizeof
;
449 mcode print_string_box lp
; fullType ty
; close_box();
450 mcode print_string rp
451 | Ast.TypeExp
(ty
) -> fullType ty
452 | Ast.Constructor
(lp
,ty
,rp
,init
) ->
453 mcode print_string_box lp
; fullType ty
; close_box();
454 mcode print_string rp
; initialiser
true init
456 | Ast.MetaErr
(name,_,_,_) ->
457 failwith
"metaErr not handled"
459 | Ast.MetaExpr
(name,_,_,_typedontcare
,_formdontcare
,_) ->
460 handle_metavar name (function
461 | Ast_c.MetaExprVal
((((e
, _), _) as exp
),_) ->
462 if prec_of_c e
< prec
then
465 pretty_print_c.Pretty_print_c.expression exp
;
469 pretty_print_c.Pretty_print_c.expression exp
470 | _ -> raise
(Impossible
145)
473 | Ast.MetaExprList
(name,_,_,_) ->
474 handle_metavar name (function
475 | Ast_c.MetaExprListVal args
->
476 pretty_print_c.Pretty_print_c.arg_list args
477 | Ast_c.MetaParamListVal
_ ->
478 failwith
"have meta param list matching meta exp list\n";
479 | _ -> raise
(Impossible
146)
482 | Ast.AsExpr
(expr
,asexpr
) -> loop expr prec
484 | Ast.EComma
(cm
) -> mcode print_string cm
486 | Ast.DisjExpr
(exp_list
) ->
488 then print_disj_list expression exp_list
489 else raise CantBeInPlus
490 | Ast.NestExpr
(starter
,expr_dots
,ender
,Some whencode
,multi
)
492 nest_dots starter ender
expression
493 (function _ -> print_text " when != "; expression whencode
)
495 | Ast.NestExpr
(starter
,expr_dots
,ender
,None
,multi
) when generating
->
496 nest_dots starter ender
expression (function _ -> ()) expr_dots
497 | Ast.NestExpr
_ -> raise CantBeInPlus
498 | Ast.Edots
(dots,Some whencode
)
499 | Ast.Ecircles
(dots,Some whencode
)
500 | Ast.Estars
(dots,Some whencode
) ->
503 (mcode print_string dots;
504 print_text " when != ";
506 else raise CantBeInPlus
507 | Ast.Edots
(dots,None
)
508 | Ast.Ecircles
(dots,None
)
509 | Ast.Estars
(dots,None
) ->
511 then mcode print_string dots
512 else raise CantBeInPlus
514 | Ast.OptExp
(exp
) | Ast.UniqueExp
(exp
) ->
519 and arg_expression e
=
520 match Ast.unwrap e
with
522 (* space is only used by add_newline, and only if not using SMPL
523 spacing. pr_cspace uses a " " in unparse_c.ml. Not so nice... *)
524 mcode (print_string_with_hint (SpaceOrNewline
(ref " "))) cm
527 and unaryOp
= function
528 Ast.GetRef
-> print_string "&"
529 | Ast.GetRefLabel
-> print_string "&&"
530 | Ast.DeRef
-> print_string "*"
531 | Ast.UnPlus
-> print_string "+"
532 | Ast.UnMinus
-> print_string "-"
533 | Ast.Tilde
-> print_string "~"
534 | Ast.Not
-> print_string "!"
536 and assignOp
= function
537 Ast.SimpleAssign
-> print_string "="
538 | Ast.OpAssign
(aop
) ->
539 (function line -> function lcol ->
540 arithOp aop
line lcol; print_string "=" line lcol)
543 Ast.Dec
-> print_string "--"
544 | Ast.Inc
-> print_string "++"
546 and binaryOp
= function
547 Ast.Arith
(aop
) -> arithOp aop
548 | Ast.Logical
(lop
) -> logicalOp lop
550 and arithOp
= function
551 Ast.Plus
-> print_string "+"
552 | Ast.Minus
-> print_string "-"
553 | Ast.Mul
-> print_string "*"
554 | Ast.Div
-> print_string "/"
555 | Ast.Max
-> print_string ">?"
556 | Ast.Min
-> print_string "<?"
557 | Ast.Mod
-> print_string "%"
558 | Ast.DecLeft
-> print_string "<<"
559 | Ast.DecRight
-> print_string ">>"
560 | Ast.And
-> print_string "&"
561 | Ast.Or
-> print_string "|"
562 | Ast.Xor
-> print_string "^"
564 and logicalOp
= function
565 Ast.Inf
-> print_string "<"
566 | Ast.Sup
-> print_string ">"
567 | Ast.InfEq
-> print_string "<="
568 | Ast.SupEq
-> print_string ">="
569 | Ast.Eq
-> print_string "=="
570 | Ast.NotEq
-> print_string "!="
571 | Ast.AndLog
-> print_string "&&"
572 | Ast.OrLog
-> print_string "||"
574 and constant
= function
575 Ast.String
(s
) -> print_string ("\""^s^
"\"")
576 | Ast.Char
(s
) -> print_string ("\'"^s^
"\'")
577 | Ast.Int
(s
) -> print_string s
578 | Ast.Float
(s
) -> print_string s
580 (* --------------------------------------------------------------------- *)
585 match Ast.unwrap ft
with
587 (match Ast.unwrap ty
with
589 typeC ty
; print_option_prespace (mcode const_vol
) cv
590 | _ -> print_option_space (mcode const_vol
) cv
; typeC ty
)
592 | Ast.AsType
(ty
, asty
) -> fullType ty
593 | Ast.DisjType
_ -> failwith
"can't be in plus"
594 | Ast.OptType
(_) | Ast.UniqueType
(_) ->
597 and print_function_pointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) fn =
598 fullType ty
; mcode print_string lp1
; mcode print_string star
; fn();
599 mcode print_string rp1
; mcode print_string lp1
;
600 parameter_list params
; mcode print_string rp2
602 and print_function_type
(ty
,lp1
,params
,rp1
) fn =
603 print_option fullType ty
; fn(); mcode print_string lp1
;
604 parameter_list params
; mcode print_string rp1
607 match Ast.unwrap ty
with
608 Ast.BaseType
(ty
,strings
) ->
609 print_between pr_space
(mcode print_string) strings
610 | Ast.SignedT
(sgn
,ty
) -> mcode sign sgn
; print_option_prespace typeC ty
611 | Ast.Pointer
(ty
,star
) ->
612 fullType ty
; ft_space ty
; mcode print_string star
; eatspace
()
613 | Ast.FunctionPointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
614 print_function_pointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
)
616 | Ast.FunctionType
(am
,ty
,lp1
,params
,rp1
) ->
617 print_function_type
(ty
,lp1
,params
,rp1
) (function _ -> ())
618 | Ast.Array
(ty
,lb
,size
,rb
) ->
619 fullType ty
; mcode print_string lb
; print_option expression size
;
620 mcode print_string rb
621 | Ast.EnumName
(kind
,name) ->
622 mcode print_string kind
;
623 print_option_prespace ident name
624 | Ast.EnumDef
(ty
,lb
,ids
,rb
) ->
625 fullType ty
; ft_space ty
;
626 mcode print_string lb
;
627 dots force_newline expression ids
;
628 mcode print_string rb
629 | Ast.StructUnionName
(kind
,name) ->
630 mcode structUnion kind
; print_option_prespace ident name
631 | Ast.StructUnionDef
(ty
,lb
,decls
,rb
) ->
632 fullType ty
; ft_space ty
;
633 mcode print_string lb
;
634 dots force_newline declaration decls
;
635 mcode print_string rb
636 | Ast.TypeName
(name)-> mcode print_string name
637 | Ast.MetaType
(name,_,_) ->
638 handle_metavar name (function
639 Ast_c.MetaTypeVal exp
->
640 pretty_print_c.Pretty_print_c.ty exp
641 | _ -> raise
(Impossible
147))
643 and baseType
= function
644 Ast.VoidType
-> print_string "void"
645 | Ast.CharType
-> print_string "char"
646 | Ast.ShortType
-> print_string "short"
647 | Ast.ShortIntType
-> print_string "short int"
648 | Ast.IntType
-> print_string "int"
649 | Ast.DoubleType
-> print_string "double"
650 | Ast.LongDoubleType
-> print_string "long double"
651 | Ast.FloatType
-> print_string "float"
652 | Ast.LongType
-> print_string "long"
653 | Ast.LongIntType
-> print_string "long int"
654 | Ast.LongLongType
-> print_string "long long"
655 | Ast.LongLongIntType
-> print_string "long long int"
656 | Ast.SizeType
-> print_string "size_t "
657 | Ast.SSizeType
-> print_string "ssize_t "
658 | Ast.PtrDiffType
-> print_string "ptrdiff_t "
660 and structUnion
= function
661 Ast.Struct
-> print_string "struct"
662 | Ast.Union
-> print_string "union"
665 Ast.Signed
-> print_string "signed"
666 | Ast.Unsigned
-> print_string "unsigned"
669 and const_vol
= function
670 Ast.Const
-> print_string "const"
671 | Ast.Volatile
-> print_string "volatile"
673 (* --------------------------------------------------------------------- *)
674 (* Function declaration *)
676 and storage
= function
677 Ast.Static
-> print_string "static"
678 | Ast.Auto
-> print_string "auto"
679 | Ast.Register
-> print_string "register"
680 | Ast.Extern
-> print_string "extern"
682 (* --------------------------------------------------------------------- *)
683 (* Variable declaration *)
685 and print_named_type ty id
=
686 match Ast.unwrap ty
with
687 Ast.Type
(_,None
,ty1
) ->
688 (match Ast.unwrap ty1
with
689 Ast.FunctionPointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
) ->
690 print_function_pointer
(ty
,lp1
,star
,rp1
,lp2
,params
,rp2
)
691 (function _ -> pr_space
(); ident id
)
692 | Ast.FunctionType
(am
,ty
,lp1
,params
,rp1
) ->
693 print_function_type
(ty
,lp1
,params
,rp1
)
694 (function _ -> pr_space
(); ident id
)
695 | Ast.Array
(_,_,_,_) ->
697 match Ast.unwrap ty
with
698 Ast.Array
(ty
,lb
,size
,rb
) ->
699 (match Ast.unwrap ty
with
701 print_option_space (mcode const_vol
) cv
;
705 mcode print_string lb
;
706 print_option expression size
;
707 mcode print_string rb
)
708 | _ -> failwith
"complex array types not supported")
709 | _ -> typeC ty
; ty_space ty
; ident id
; k
() in
710 loop ty1
(function _ -> ())
711 (*| should have a case here for pointer to array or function type
712 that would put ( * ) around the variable. This makes one wonder
713 why we really need a special case for function pointer *)
714 | _ -> fullType ty
; ft_space ty
; ident id
)
715 | _ -> fullType ty
; ft_space ty
; ident id
718 match Ast.unwrap ty
with
719 Ast.Pointer
(_,_) -> ()
723 match Ast.unwrap ty
with
726 match Ast.unwrap ty
with
727 Ast.Pointer
(_,_) -> true
728 | Ast.MetaType
(name,_,_) ->
729 let (res,name_string
,line,lcol,rcol) = lookup_metavar name in
733 (Printf.sprintf
"variable %s not known on SP line %d\n"
735 | Some
(Ast_c.MetaTypeVal
(tq
,ty
)) ->
736 (match Ast_c.unwrap ty
with
737 Ast_c.Pointer
(_,_) -> true
741 if isptr then () else pr_space
()
745 match Ast.unwrap d
with
746 Ast.MetaDecl
(name,_,_) ->
749 Ast_c.MetaDeclVal d
->
750 pretty_print_c.Pretty_print_c.decl d
751 | _ -> raise
(Impossible
148))
752 | Ast.MetaField
(name,_,_) ->
755 Ast_c.MetaFieldVal f
->
756 pretty_print_c.Pretty_print_c.field f
757 | _ -> raise
(Impossible
149))
759 | Ast.MetaFieldList
(name,_,_,_) ->
762 Ast_c.MetaFieldListVal f
->
763 print_between force_newline pretty_print_c.Pretty_print_c.field f
764 | _ -> raise
(Impossible
150))
766 | Ast.AsDecl
(decl
,asdecl
) -> declaration decl
768 | Ast.Init
(stg
,ty
,id
,eq
,ini
,sem
) ->
769 print_option (mcode storage
) stg
;
770 print_option (function _ -> pr_space
()) stg
;
771 print_named_type ty id
;
772 pr_space
(); mcode print_string eq
;
773 pr_space
(); initialiser
true ini
; mcode print_string sem
774 | Ast.UnInit
(stg
,ty
,id
,sem
) ->
775 print_option (mcode storage
) stg
;
776 print_option (function _ -> pr_space
()) stg
;
777 print_named_type ty id
;
778 mcode print_string sem
779 | Ast.MacroDecl
(name,lp
,args
,rp
,sem
) ->
780 ident name; mcode print_string_box lp
;
781 dots (function _ -> ()) arg_expression args
;
782 close_box(); mcode print_string rp
; mcode print_string sem
783 | Ast.MacroDeclInit
(name,lp
,args
,rp
,eq
,ini
,sem
) ->
784 ident name; mcode print_string_box lp
;
785 dots (function _ -> ()) arg_expression args
;
786 close_box(); mcode print_string rp
;
787 pr_space
(); mcode print_string eq
;
788 pr_space
(); initialiser
true ini
; mcode print_string sem
789 | Ast.TyDecl
(ty
,sem
) -> fullType ty
; mcode print_string sem
790 | Ast.Typedef
(stg
,ty
,id
,sem
) ->
791 mcode print_string stg
;
792 fullType ty
; typeC id
;
793 mcode print_string sem
794 | Ast.DisjDecl
(_) -> raise CantBeInPlus
795 | Ast.Ddots
(_,_) -> raise CantBeInPlus
796 | Ast.OptDecl
(decl
) | Ast.UniqueDecl
(decl
) ->
799 (* --------------------------------------------------------------------- *)
802 and initialiser nlcomma i
=
803 match Ast.unwrap i
with
804 Ast.MetaInit
(name,_,_) ->
805 handle_metavar name (function
806 Ast_c.MetaInitVal ini
->
807 pretty_print_c.Pretty_print_c.init ini
808 | _ -> raise
(Impossible
151))
809 | Ast.MetaInitList
(name,_,_,_) ->
810 handle_metavar name (function
811 Ast_c.MetaInitListVal ini
->
812 pretty_print_c.Pretty_print_c.init_list ini
813 | _ -> raise
(Impossible
152))
814 | Ast.AsInit
(init
,asinit
) -> initialiser nlcomma init
815 | Ast.InitExpr
(exp
) -> expression exp
816 | Ast.ArInitList
(lb
,initlist
,rb
) ->
817 (match Ast.undots initlist
with
818 [] -> mcode print_string lb
; mcode print_string rb
820 mcode print_string lb
; start_block();
821 initialiser_list nlcomma lst
;
822 end_block(); mcode print_string rb
)
823 | Ast.StrInitList
(_,lb
,[],rb
,[]) ->
824 mcode print_string lb
; mcode print_string rb
825 | Ast.StrInitList
(_,lb
,initlist
,rb
,[]) ->
826 mcode print_string lb
; start_block();
827 initialiser_list nlcomma initlist
;
828 end_block(); mcode print_string rb
829 | Ast.StrInitList
(_,lb
,initlist
,rb
,_) ->
830 failwith
"unexpected whencode in plus"
831 | Ast.InitGccExt
(designators
,eq
,ini
) ->
832 List.iter designator designators
; pr_space
();
833 mcode print_string eq
; pr_space
(); initialiser nlcomma ini
834 | Ast.InitGccName
(name,eq
,ini
) ->
835 ident name; mcode print_string eq
; initialiser nlcomma ini
836 | Ast.IComma
(comma
) ->
837 mcode print_string comma
;
838 if nlcomma
then force_newline() else pr_space
()
839 | Ast.Idots
(dots,Some whencode
) ->
842 (mcode print_string dots;
843 print_text " when != ";
844 initialiser nlcomma whencode
)
845 else raise CantBeInPlus
846 | Ast.Idots
(dots,None
) ->
848 then mcode print_string dots
849 else raise CantBeInPlus
850 | Ast.OptIni
(ini
) | Ast.UniqueIni
(ini
) ->
853 and initialiser_list nlcomma
= function
854 (* awkward, because the comma is separate from the initialiser *)
856 | [x
] -> initialiser
false x
857 | x
::xs
-> initialiser nlcomma x
; initialiser_list nlcomma xs
859 and designator
= function
860 Ast.DesignatorField
(dot
,id
) -> mcode print_string dot
; ident id
861 | Ast.DesignatorIndex
(lb
,exp
,rb
) ->
862 mcode print_string lb
; expression exp
; mcode print_string rb
863 | Ast.DesignatorRange
(lb
,min
,dots,max
,rb
) ->
864 mcode print_string lb
; expression min
; mcode print_string dots;
865 expression max
; mcode print_string rb
867 (* --------------------------------------------------------------------- *)
870 and parameterTypeDef p
=
871 match Ast.unwrap p
with
872 Ast.VoidParam
(ty
) -> fullType ty
873 | Ast.Param
(ty
,Some id
) -> print_named_type ty id
874 | Ast.Param
(ty
,None
) -> fullType ty
876 | Ast.MetaParam
(name,_,_) ->
879 Ast_c.MetaParamVal p
->
880 pretty_print_c.Pretty_print_c.param p
881 | _ -> raise
(Impossible
153))
882 | Ast.MetaParamList
(name,_,_,_) ->
885 Ast_c.MetaParamListVal p
->
886 pretty_print_c.Pretty_print_c.paramlist p
887 | _ -> raise
(Impossible
154))
889 | Ast.AsParam
(p
,e
) -> raise CantBeInPlus
891 | Ast.PComma
(cm
) -> mcode print_string cm
892 | Ast.Pdots
(dots) | Ast.Pcircles
(dots) when generating
->
893 mcode print_string dots
894 | Ast.Pdots
(dots) | Ast.Pcircles
(dots) -> raise CantBeInPlus
895 | Ast.OptParam
(param
) | Ast.UniqueParam
(param
) -> raise CantBeInPlus
897 and parameter_list l
=
900 match Ast.unwrap p
with
901 Ast.PComma
(cm
) -> pr_space
()
903 dots (function _ -> ()) comma l
907 (* --------------------------------------------------------------------- *)
910 let rec inc_file = function
912 print_string ("\""^
(String.concat
"/" (List.map inc_elem elems
))^
"\"")
913 | Ast.NonLocal
(elems
) ->
914 print_string ("<"^
(String.concat
"/" (List.map inc_elem elems
))^
">")
916 and inc_elem
= function
918 | Ast.IncDots
-> "..."
920 (* --------------------------------------------------------------------- *)
923 and rule_elem arity re
=
924 match Ast.unwrap re
with
925 Ast.FunHeader
(_,_,fninfo
,name,lp
,params
,rp
) ->
926 pr_arity arity
; List.iter print_fninfo fninfo
;
927 ident name; mcode print_string_box lp
;
928 parameter_list params
; close_box(); mcode print_string rp
;
930 | Ast.Decl
(_,_,decl
) -> pr_arity arity
; declaration decl
932 | Ast.SeqStart
(brace
) ->
933 pr_arity arity
; mcode print_string brace
; start_block()
934 | Ast.SeqEnd
(brace
) ->
935 end_block(); pr_arity arity
; mcode print_string brace
937 | Ast.ExprStatement
(exp
,sem
) ->
938 pr_arity arity
; print_option expression exp
; mcode print_string sem
940 | Ast.IfHeader
(iff
,lp
,exp
,rp
) ->
942 mcode print_string iff
; pr_space
(); mcode print_string_box lp
;
943 expression exp
; close_box(); mcode print_string rp
945 pr_arity arity
; mcode print_string els
947 | Ast.WhileHeader
(whl
,lp
,exp
,rp
) ->
949 mcode print_string whl
; pr_space
(); mcode print_string_box lp
;
950 expression exp
; close_box(); mcode print_string rp
952 pr_arity arity
; mcode print_string d
953 | Ast.WhileTail
(whl
,lp
,exp
,rp
,sem
) ->
955 mcode print_string whl
; pr_space
(); mcode print_string_box lp
;
956 expression exp
; close_box(); mcode print_string rp
;
957 mcode print_string sem
958 | Ast.ForHeader
(fr
,lp
,first
,e2
,sem2
,e3
,rp
) ->
960 mcode print_string fr
; mcode print_string_box lp
; forinfo first
;
961 print_option expression e2
; mcode print_string sem2
;
962 print_option expression e3
; close_box();
963 mcode print_string rp
964 | Ast.IteratorHeader
(nm
,lp
,args
,rp
) ->
966 ident nm
; pr_space
(); mcode print_string_box lp
;
967 dots (function _ -> ()) arg_expression args
; close_box();
968 mcode print_string rp
970 | Ast.SwitchHeader
(switch
,lp
,exp
,rp
) ->
972 mcode print_string switch
; pr_space
(); mcode print_string_box lp
;
973 expression exp
; close_box(); mcode print_string rp
975 | Ast.Break
(br
,sem
) ->
976 pr_arity arity
; mcode print_string br
; mcode print_string sem
977 | Ast.Continue
(cont
,sem
) ->
978 pr_arity arity
; mcode print_string cont
; mcode print_string sem
979 | Ast.Label
(l
,dd
) -> ident l
; mcode print_string dd
980 | Ast.Goto
(goto
,l
,sem
) ->
981 mcode print_string goto
; ident l
; mcode print_string sem
982 | Ast.Return
(ret
,sem
) ->
983 pr_arity arity
; mcode print_string ret
;
984 mcode print_string sem
985 | Ast.ReturnExpr
(ret
,exp
,sem
) ->
986 pr_arity arity
; mcode print_string ret
; pr_space
();
987 expression exp
; mcode print_string sem
989 | Ast.Exp
(exp
) -> pr_arity arity
; expression exp
990 | Ast.TopExp
(exp
) -> pr_arity arity
; expression exp
991 | Ast.Ty
(ty
) -> pr_arity arity
; fullType ty
992 | Ast.TopInit
(init
) -> initialiser
false init
993 | Ast.Include
(inc
,s
) ->
994 mcode print_string inc
; print_text " "; mcode inc_file s
995 | Ast.Undef
(def
,id
) ->
996 mcode print_string def
; pr_space
(); ident id
997 | Ast.DefineHeader
(def
,id
,params
) ->
998 mcode print_string def
; pr_space
(); ident id
;
999 print_define_parameters params
1000 | Ast.Default
(def
,colon
) ->
1001 mcode print_string def
; mcode print_string colon
; pr_space
()
1002 | Ast.Case
(case
,exp
,colon
) ->
1003 mcode print_string case
; pr_space
(); expression exp
;
1004 mcode print_string colon
; pr_space
()
1005 | Ast.DisjRuleElem
(res) ->
1008 (pr_arity arity
; print_text "\n(\n";
1009 print_between (function _ -> print_text "\n|\n") (rule_elem arity
)
1012 else raise CantBeInPlus
1014 | Ast.MetaRuleElem
(name,_,_) ->
1015 raise
(Impossible
155)
1017 | Ast.MetaStmt
(name,_,_,_) ->
1018 handle_metavar name (function
1019 | Ast_c.MetaStmtVal stm
->
1020 pretty_print_c.Pretty_print_c.statement stm
1021 | _ -> raise
(Impossible
156)
1023 | Ast.MetaStmtList
(name,_,_) ->
1025 "MetaStmtList not supported (not even in ast_c metavars binding)"
1027 and forinfo
= function
1028 Ast.ForExp
(e1
,sem1
) ->
1029 print_option expression e1
; mcode print_string sem1
1030 | Ast.ForDecl
(_,_,decl
) -> declaration decl
1032 and print_define_parameters params
=
1033 match Ast.unwrap params
with
1035 | Ast.DParams
(lp
,params
,rp
) ->
1036 mcode print_string lp
;
1037 dots (function _ -> ()) print_define_param params
; mcode print_string rp
1039 and print_define_param param
=
1040 match Ast.unwrap param
with
1041 Ast.DParam
(id
) -> ident id
1042 | Ast.DPComma
(comma) -> mcode print_string comma
1043 | Ast.DPdots
(dots) -> mcode print_string dots
1044 | Ast.DPcircles
(circles
) -> mcode print_string circles
1045 | Ast.OptDParam
(dp
) -> print_text "?"; print_define_param dp
1046 | Ast.UniqueDParam
(dp
) -> print_text "!"; print_define_param dp
1048 and print_fninfo
= function
1049 Ast.FStorage
(stg
) -> mcode storage stg
1050 | Ast.FType
(ty
) -> fullType ty
1051 | Ast.FInline
(inline
) -> mcode print_string inline
; pr_space
()
1052 | Ast.FAttr
(attr
) -> mcode print_string attr
; pr_space
() in
1054 let indent_if_needed s f
=
1056 match Ast.unwrap s
with
1057 Ast.Seq
(lbrace
,body
,rbrace
) -> true
1059 (match Ast.unwrap s
with
1060 | Ast.MetaStmt
(name,_,_,_) ->
1061 let (res,name_string
,line,lcol,rcol) = lookup_metavar name in
1065 (Printf.sprintf
"variable %s not known on SP line %d\n"
1067 | Some
(Ast_c.MetaStmtVal stm
) ->
1068 (match Ast_c.unwrap stm
with
1069 Ast_c.Compound
_ -> true
1071 | _ -> failwith
"bad metavariable value")
1075 then begin pr_space
(); f
() end
1078 (*no newline at the end - someone else will do that*)
1079 start_block(); f
(); unindent
true
1082 let rec statement arity s
=
1083 match Ast.unwrap s
with
1084 Ast.Seq
(lbrace
,body
,rbrace
) ->
1085 rule_elem arity lbrace
;
1086 dots force_newline (statement arity
) body
;
1087 rule_elem arity rbrace
1089 | Ast.IfThen
(header
,branch
,_) ->
1090 rule_elem arity header
;
1091 indent_if_needed branch
(function _ -> statement arity branch
)
1092 | Ast.IfThenElse
(header
,branch1
,els
,branch2
,_) ->
1093 rule_elem arity header
;
1094 indent_if_needed branch1
(function _ -> statement arity branch1
);
1096 rule_elem arity els
;
1097 indent_if_needed branch2
(function _ -> statement arity branch2
)
1098 | Ast.While
(header
,body
,_) ->
1099 rule_elem arity header
;
1100 indent_if_needed body
(function _ -> statement arity body
)
1101 | Ast.Do
(header
,body
,tail
) ->
1102 rule_elem arity header
;
1103 indent_if_needed body
(function _ -> statement arity body
);
1104 rule_elem arity tail
1105 | Ast.For
(header
,body
,_) ->
1106 rule_elem arity header
;
1107 indent_if_needed body
(function _ -> statement arity body
)
1108 | Ast.Iterator
(header
,body
,(_,_,_,aft
)) ->
1109 rule_elem arity header
;
1110 indent_if_needed body
(function _ -> statement arity body
);
1111 mcode (fun _ _ _ -> ()) ((),Ast.no_info
,aft
,[])
1113 | Ast.Switch
(header
,lb
,decls
,cases
,rb
) ->
1114 rule_elem arity header
; pr_space
(); rule_elem arity lb
;
1115 dots force_newline (statement arity
) decls
;
1116 List.iter
(function x
-> case_line arity x
; force_newline()) cases
;
1119 | Ast.Atomic
(re
) -> rule_elem arity re
1121 | Ast.FunDecl
(header
,lbrace
,body
,rbrace
) ->
1122 rule_elem arity header
; rule_elem arity lbrace
;
1123 dots force_newline (statement arity
) body
; rule_elem arity rbrace
1125 | Ast.Define
(header
,body
) ->
1126 rule_elem arity header
; pr_space
();
1127 dots force_newline (statement arity
) body
1129 | Ast.AsStmt
(stmt
,asstmt
) -> statement arity stmt
1131 | Ast.Disj
([stmt_dots
]) ->
1135 dots force_newline (statement arity
) stmt_dots
)
1136 else raise CantBeInPlus
1137 | Ast.Disj
(stmt_dots_list
) -> (* ignores newline directive for readability *)
1140 (pr_arity arity
; print_text "\n(\n";
1141 print_between (function _ -> print_text "\n|\n")
1142 (dots force_newline (statement arity
))
1145 else raise CantBeInPlus
1146 | Ast.Nest
(starter
,stmt_dots
,ender
,whn
,multi
,_,_) when generating
->
1148 nest_dots starter ender
(statement arity
)
1150 print_between force_newline
1151 (whencode
(dots force_newline (statement "")) (statement "")) whn
;
1154 | Ast.Nest
(_) -> raise CantBeInPlus
1155 | Ast.Dots
(d
,whn
,_,_) | Ast.Circles
(d
,whn
,_,_) | Ast.Stars
(d
,whn
,_,_) ->
1158 (pr_arity arity
; mcode print_string d
;
1159 print_between force_newline
1160 (whencode
(dots force_newline (statement "")) (statement "")) whn
;
1162 else raise CantBeInPlus
1164 | Ast.OptStm
(s
) | Ast.UniqueStm
(s
) ->
1167 and whencode notfn alwaysfn
= function
1169 print_text " WHEN != "; notfn a
1170 | Ast.WhenAlways a
->
1171 print_text " WHEN = "; alwaysfn a
1172 | Ast.WhenModifier x
-> print_text " WHEN "; print_when_modif x
1173 | Ast.WhenNotTrue a
->
1174 print_text " WHEN != TRUE "; rule_elem
"" a
1175 | Ast.WhenNotFalse a
->
1176 print_text " WHEN != FALSE "; rule_elem
"" a
1178 and print_when_modif
= function
1179 | Ast.WhenAny
-> print_text "ANY"
1180 | Ast.WhenStrict
-> print_text "STRICT"
1181 | Ast.WhenForall
-> print_text "FORALL"
1182 | Ast.WhenExists
-> print_text "EXISTS"
1184 and case_line arity c
=
1185 match Ast.unwrap c
with
1186 Ast.CaseLine
(header
,code
) ->
1187 rule_elem arity header
; pr_space
();
1188 dots force_newline (statement arity
) code
1189 | Ast.OptCase
(case
) -> raise CantBeInPlus
in
1192 match Ast.unwrap t
with
1193 Ast.FILEINFO
(old_file
,new_file
) -> raise CantBeInPlus
1194 | Ast.NONDECL
(stmt
) -> statement "" stmt
1195 | Ast.CODE
(stmt_dots
) -> dots force_newline (statement "") stmt_dots
1196 | Ast.ERRORWORDS
(exps
) -> raise CantBeInPlus
1201 print_between (function _ -> force_newline(); force_newline()) top_level
1205 let if_open_brace = function "{" -> true | _ -> false in
1207 (* boolean result indicates whether an indent is needed *)
1208 let rec pp_any = function
1209 (* assert: normally there is only CONTEXT NOTHING tokens in any *)
1210 Ast.FullTypeTag
(x
) -> fullType x
; false
1211 | Ast.BaseTypeTag
(x
) -> baseType x
unknown unknown; false
1212 | Ast.StructUnionTag
(x
) -> structUnion x
unknown unknown; false
1213 | Ast.SignTag
(x
) -> sign x
unknown unknown; false
1215 | Ast.IdentTag
(x
) -> ident x
; false
1217 | Ast.ExpressionTag
(x
) -> expression x
; false
1219 | Ast.ConstantTag
(x
) -> constant x
unknown unknown; false
1220 | Ast.UnaryOpTag
(x
) -> unaryOp x
unknown unknown; false
1221 | Ast.AssignOpTag
(x
) -> assignOp x
unknown unknown; false
1222 | Ast.FixOpTag
(x
) -> fixOp x
unknown unknown; false
1223 | Ast.BinaryOpTag
(x
) -> binaryOp x
unknown unknown; false
1224 | Ast.ArithOpTag
(x
) -> arithOp x
unknown unknown; false
1225 | Ast.LogicalOpTag
(x
) -> logicalOp x
unknown unknown; false
1227 | Ast.InitTag
(x
) -> initialiser
false x
; false
1228 | Ast.DeclarationTag
(x
) -> declaration x
; false
1230 | Ast.StorageTag
(x
) -> storage x
unknown unknown; false
1231 | Ast.IncFileTag
(x
) -> inc_file x
unknown unknown; false
1233 | Ast.Rule_elemTag
(x
) -> rule_elem
"" x
; false
1234 | Ast.StatementTag
(x
) -> statement "" x
; false
1235 | Ast.ForInfoTag
(x
) -> forinfo x
; false
1236 | Ast.CaseLineTag
(x
) -> case_line
"" x
; false
1238 | Ast.ConstVolTag
(x
) -> const_vol x
unknown unknown; false
1240 (match xs
with (Ast.Space s
)::_ -> pr_space
() | _ -> ());
1241 let rec loop = function
1243 | [Ast.Noindent s
] -> unindent
false; print_text s
1244 | [Ast.Indent s
] -> print_text s
1245 | (Ast.Space s
) :: (((Ast.Indent
_ | Ast.Noindent
_) :: _) as rest
) ->
1246 print_text s
; force_newline(); loop rest
1247 | (Ast.Space s
) :: rest
-> print_text s
; pr_space
(); loop rest
1248 | Ast.Noindent s
:: rest
->
1249 unindent
false; print_text s
; force_newline(); loop rest
1250 | Ast.Indent s
:: rest
->
1251 print_text s
; force_newline(); loop rest
in
1253 | Ast.Token
(x
,None
) -> print_text x
; if_open_brace x
1254 | Ast.Token
(x
,Some info
) ->
1258 "else" -> force_newline()
1260 print_string x
line lcol)
1261 (let nomcodekind = Ast.CONTEXT
(Ast.DontCarePos
,Ast.NOTHING
) in
1262 (x
,info
,nomcodekind,[]));
1265 | Ast.Code
(x
) -> let _ = top_level x
in false
1267 (* this is not '...', but a list of expr/statement/params, and
1268 normally there should be no '...' inside them *)
1269 | Ast.ExprDotsTag
(x
) ->
1270 let check_comma cm
=
1271 match Ast.unwrap cm
with
1272 Ast.EComma
(cm
) -> pr_space
()
1274 dots check_comma expression x
; false
1275 | Ast.ParamDotsTag
(x
) -> parameter_list x
; false
1276 | Ast.StmtDotsTag
(x
) -> dots force_newline (statement "") x
; false
1277 | Ast.DeclDotsTag
(x
) -> dots force_newline declaration x
; false
1279 | Ast.TypeCTag
(x
) -> typeC x
; false
1280 | Ast.ParamTag
(x
) -> parameterTypeDef x
; false
1281 | Ast.SgrepStartTag
(x
) -> failwith
"unexpected start tag"
1282 | Ast.SgrepEndTag
(x
) -> failwith
"unexpected end tag"
1285 (*Printf.printf "start of the function\n";*)
1287 anything := (function x
-> let _ = pp_any x
in ());
1289 (* todo? imitate what is in pretty_print_cocci ? *)
1293 (* for many tags, we must not do a newline before the first '+' *)
1295 match Ast.unwrap s
with Ast.FunDecl
_ -> true | _ -> false in
1296 let unindent_before = function
1297 (* need to get unindent before newline for } *)
1298 (Ast.Token
("}",_)::_) -> true
1301 (if unindent_before x
then unindent
true);
1303 let newline_before _ =
1306 let hd = List.hd xxs
in
1309 when List.for_all
(function Ast.Space x
-> true | _ -> false) l
->
1311 | (Ast.StatementTag s
::_) when isfn s
->
1312 force_newline(); force_newline()
1314 | (Ast.Rule_elemTag
_::_) | (Ast.StatementTag
_::_)
1315 | (Ast.InitTag
_::_)
1316 | (Ast.DeclarationTag
_::_) | (Ast.Token
("}",_)::_) -> prnl hd
1318 let newline_after _ =
1319 if before
=*= Before
1321 match List.rev
(List.hd(List.rev xxs
)) with
1322 (Ast.StatementTag s
::_) ->
1323 (if isfn s
then force_newline());
1326 | (Ast.Rule_elemTag
_::_) | (Ast.InitTag
_::_)
1327 | (Ast.DeclarationTag
_::_) | (Ast.Token
("{",_)::_) ->
1330 (* print a newline at the beginning, if needed *)
1332 (* print a newline before each of the rest *)
1333 let rec loop leading_newline indent_needed
= function
1338 match (indent_needed
,unindent_before x
) with
1339 (true,true) -> force_newline()
1340 | (true,false) -> force_newline(); indent
()
1341 | (false,true) -> unindent
true; force_newline()
1342 | (false,false) -> force_newline());
1343 let space_needed_before = function
1345 (match Ast.unwrap x
with
1346 Ast.PComma
_ -> false
1348 | Ast.ExpressionTag
(x
) ->
1349 (match Ast.unwrap x
with
1350 Ast.EComma
_ -> false
1353 (match Ast.unwrap x
with
1354 Ast.IComma
_ -> false
1356 | Ast.Token
(t
,_) when List.mem t
[",";";";"(";")";".";"->"] ->
1359 let space_needed_after = function
1361 when List.mem t
["(";".";"->"] -> (*never needed*) false
1362 | Ast.Token
(t
,_) when List.mem t
["if";"for";"while";"do"] ->
1363 (* space always needed *)
1365 | Ast.ExpressionTag
(e
) ->
1366 (match Ast.unwrap e
with
1368 (* space always needed *)
1373 let rec loop space_after
indent_needed = function
1376 (if space_after
&& space_needed_before x
1378 let indent_needed = pp_any x
in
1379 let space_after = space_needed_after x
in
1380 loop space_after indent_needed xs
in
1381 loop false false x
in
1382 loop true indent_needed xs
in
1383 loop false false (x
::xs
);
1384 (* print a newline at the end, if needed *)
1387 let rec pp_list_list_any (envs
, pr
, pr_celem
, pr_cspace
, pr_space
, pr_arity
,
1388 pr_barrier
, indent
, unindent
, eatspace
)
1389 generating xxs before
=
1392 do_all (env
, pr
, pr_celem
, pr_cspace
, pr_space
, pr_arity
, pr_barrier
,
1393 indent
, unindent
, eatspace
)
1394 generating xxs before
)