1 (* Yoann Padioleau, Julia Lawall
3 * Copyright (C) 2010, University of Copenhagen DIKU and INRIA.
4 * Copyright (C) 2006, 2007, 2008, 2009 Ecole des Mines de Nantes and DIKU
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.
16 * Modifications by Julia Lawall for better newline handling.
22 module TH
= Token_helpers
25 (* should keep comments and directives in between adjacent deleted terms,
26 but not comments and directives within deleted terms. should use the
27 labels found in the control-flow graph *)
31 (*****************************************************************************)
33 (*****************************************************************************)
34 let pr2, pr2_once
= Common.mk_pr2_wrappers
Flag_parsing_c.verbose_unparsing
36 (*****************************************************************************)
37 (* Types used during the intermediate phases of the unparsing *)
38 (*****************************************************************************)
42 | T1
of Parser_c.token
44 (* The cocci_tag of the token should always be a NOTHING. The mark of
45 * the token can only be OriginTok or ExpandedTok. Why not get rid of
46 * token and get something simpler ? because we need to know if the
47 * info is a TCommentCpp or TCommentSpace, etc for some of the further
48 * analysis so easier to keep with the token.
50 * This type contains the whole information. Have all the tokens with this
54 Min
of (int list
(* match numbers *) * int (* adjacency information *))
58 | T2
of Parser_c.token
* min
*
59 int option (* orig index, abstracting away comments and space *)
61 | Cocci2
of string * int (* line *) * int (* lcol *) * int (* rcol *)
62 * Unparse_cocci.nlhint
option
65 | Unindent_cocci2
of bool (* true for permanent, false for temporary *)
69 | T3
of Parser_c.token
74 (* similar to the tech in parsing_hack *)
75 type token_extended
= {
78 idx
: int option; (* to know if 2 tokens were consecutive in orig file *)
79 mutable new_tokens_before
: token2 list
;
80 mutable remove
: bool;
84 (*****************************************************************************)
86 (*****************************************************************************)
88 let info_of_token1 t
=
91 | T1 tok
-> TH.info_of_tok tok
93 let print_token1 = function
94 T1 tok
-> TH.str_of_tok tok
95 | Fake1 info
-> "fake"
97 let str_of_token2 = function
98 | T2
(t
,_
,_
) -> TH.str_of_tok t
100 | Cocci2
(s
,_
,_
,_
,_
) -> s
102 | Indent_cocci2
-> ""
103 | Unindent_cocci2 _
-> ""
105 let print_token2 = function
110 Printf.sprintf
"-%d[%s]" adj
111 (String.concat
" " (List.map string_of_int index
))
113 "T2:"^
b_str^
TH.str_of_tok t
115 | Cocci2
(s
,_
,lc
,rc
,_
) -> Printf.sprintf
"Cocci2:%d:%d%s" lc rc s
117 | Indent_cocci2
-> "Indent"
118 | Unindent_cocci2 _
-> "Unindent"
120 let simple_print_all_tokens1 l
=
121 List.iter
(function x
-> Printf.printf
"%s " (print_token1 x
)) l
;
124 let simple_print_all_tokens2 l
=
125 List.iter
(function x
-> Printf.printf
"|%s| " (print_token2 x
)) l
;
128 let str_of_token3 = function
129 | T3 t
-> TH.str_of_tok t
130 | Cocci3 s
| C3 s
-> s
134 let mk_token_extended x
=
137 | T2
(_
,_
, idx
) -> idx
141 str
= str_of_token2 x
;
143 new_tokens_before
= [];
147 let rebuild_tokens_extented toks_ext
=
148 let _tokens = ref [] in
149 toks_ext
+> List.iter
(fun tok
->
150 tok
.new_tokens_before
+> List.iter
(fun x
-> push2 x
_tokens);
151 if not tok
.remove
then push2 tok
.tok2
_tokens;
153 let tokens = List.rev
!_tokens in
154 (tokens +> List.map
mk_token_extended)
157 let mcode_contain_plus = function
158 | Ast_cocci.CONTEXT
(_
,Ast_cocci.NOTHING
) -> false
159 | Ast_cocci.CONTEXT _
-> true
160 (* patch: when need full coccinelle transformation *)
161 | Ast_cocci.MINUS
(_
,_
,_
,[]) -> false
162 | Ast_cocci.MINUS
(_
,_
,_
,x
::xs
) -> true
163 | Ast_cocci.PLUS _
-> raise Impossible
165 let contain_plus info
=
166 let mck = Ast_c.mcode_of_info info
in
167 mcode_contain_plus mck
169 (*****************************************************************************)
170 (* Last fix on the ast *)
171 (*****************************************************************************)
173 (* Because of the ugly trick to handle initialiser, I generate fake ','
174 * for the last initializer element, but if there is nothing around it,
175 * I don't want in the end to print it.
178 let remove_useless_fakeInfo_struct program
=
179 let bigf = { Visitor_c.default_visitor_c_s
with
180 Visitor_c.kini_s
= (fun (k
,bigf) ini
->
182 | InitList args
, ii
->
185 | [i1
;i2
;iicommaopt
] ->
186 if (not
(contain_plus iicommaopt
)) && (not
(contain_plus i2
))
187 && (Ast_c.is_fake iicommaopt
)
188 (* sometimes the guy put a normal iicommaopt *)
189 then InitList args
, [i1
;i2
]
190 else InitList args
, [i1
;i2
;iicommaopt
]
191 | [i1
;i2
;iicommaopt
;end_comma_opt
] ->
192 (* only in #define. end_comma_opt canot be fake *)
193 (* not sure if this will be considered ambiguous with a previous
195 if (not
(contain_plus iicommaopt
)) && (not
(contain_plus i2
))
196 && (Ast_c.is_fake iicommaopt
)
197 (* sometimes the guy put a normal iicommaopt *)
198 then InitList args
, [i1
;i2
;end_comma_opt
]
199 else InitList args
, [i1
;i2
;iicommaopt
;end_comma_opt
]
200 | _
-> raise Impossible
205 Visitor_c.vk_toplevel_s
bigf program
208 (*****************************************************************************)
209 (* Tokens1 generation *)
210 (*****************************************************************************)
212 let get_fakeInfo_and_tokens celem toks
=
213 let toks_in = ref toks
in
214 let toks_out = ref [] in
216 (* todo? verify good order of position ? *)
218 match Ast_c.pinfo_of_info info
with
220 Common.push2
(Fake1 info
) toks_out
221 | OriginTok _
| ExpandedTok _
->
222 (* get the associated comments/space/cppcomment tokens *)
223 let (before
, x
, after
) =
224 !toks_in +> Common.split_when
(fun tok
->
225 info
=*= TH.info_of_tok tok
)
227 assert(info
=*= TH.info_of_tok x
);
228 (*old: assert(before +> List.for_all (TH.is_comment)); *)
229 before
+> List.iter
(fun x
->
230 if not
(TH.is_comment x
)
231 then pr2 ("WEIRD: not a comment:" ^
TH.str_of_tok x
)
232 (* case such as int asm d3("x"); not yet in ast *)
234 before
+> List.iter
(fun x
-> Common.push2
(T1 x
) toks_out);
235 push2
(T1 x
) toks_out;
237 | AbstractLineTok _
->
238 (* can be called on type info when for instance use -type_c *)
239 if !Flag_parsing_c.pretty_print_type_info
240 then Common.push2
(Fake1 info
) toks_out
241 else raise Impossible
(* at this stage *)
244 let pr_space _
= () in (* use the spacing that is there already *)
246 Pretty_print_c.pp_program_gen
pr_elem pr_space celem
;
248 if not
(null
!toks_in)
249 then failwith
"WEIRD: unparsing not finished";
253 (* Fake nodes that have BEFORE code should be moved over any subsequent
254 whitespace and newlines, but not any comments, to get as close to the affected
255 code as possible. Similarly, fake nodes that have AFTER code should be moved
256 backwards. No fake nodes should have both before and after code. *)
258 let displace_fake_nodes toks
=
259 let is_fake = function Fake1 _
-> true | _
-> false in
260 let is_whitespace = function
261 T1
(Parser_c.TCommentSpace _
)
263 | T1
(Parser_c.TCommentNewline _
) -> true
267 try Some
(Common.split_when
is_fake toks
)
268 with Not_found
-> None
in
270 Some
(bef
,((Fake1 info
) as fake
),aft
) ->
271 (match !(info
.cocci_tag
) with
274 (Ast_cocci.CONTEXT
(_
,Ast_cocci.BEFORE _
),_
) ->
275 (* move the fake node forwards *)
276 let (whitespace
,rest
) = Common.span
is_whitespace aft
in
277 bef
@ whitespace
@ fake
:: (loop rest
)
278 | (Ast_cocci.CONTEXT
(_
,Ast_cocci.AFTER _
),_
) ->
279 (* move the fake node backwards *)
280 let revbef = List.rev bef
in
281 let (revwhitespace
,revprev
) = Common.span
is_whitespace revbef in
282 let whitespace = List.rev revwhitespace
in
283 let prev = List.rev revprev
in
284 prev @ fake
:: (loop (whitespace @ aft
))
285 | (Ast_cocci.CONTEXT
(_
,Ast_cocci.NOTHING
),_
) ->
286 bef
@ fake
:: (loop aft
)
287 | (Ast_cocci.CONTEXT
(_
,Ast_cocci.BEFOREAFTER _
),_
) ->
288 failwith
"fake node should not be before-after"
289 | _
-> bef
@ fake
:: (loop aft
) (* old: was removed when have simpler yacfe *)
292 bef
@ fake
:: (loop aft
)
295 | _
-> raise Impossible
in
298 (*****************************************************************************)
299 (* Tokens2 generation *)
300 (*****************************************************************************)
302 let comment2t2 = function
304 (* not sure iif the following list is exhaustive or complete *)
305 (Token_c.CppAttr
|Token_c.CppMacro
|Token_c.CppPassingCosWouldGetError
),
306 (info
: Token_c.info
)) ->
308 | (Token_c.TCommentCpp x
,(info
: Token_c.info
)) ->
309 C2
("\n"^info
.Common.str^
"\n")
310 | x
-> failwith
(Printf.sprintf
"unexpected comment %s" (Common.dump x
))
312 let expand_mcode toks
=
313 let toks_out = ref [] in
317 let add_elem t minus
=
320 let str = Ast_c.str_of_info info
in
322 then push2
(Fake2
) toks_out
323 (* perhaps the fake ',' *)
324 else push2
(C2
str) toks_out
328 (*let (a,b) = !((TH.info_of_tok tok).cocci_tag) in*)
329 (* no tag on expandedTok ! *)
330 let modified = function
332 | Some
(Ast_cocci.CONTEXT
(pos
,Ast_cocci.NOTHING
),l
) -> false
334 (if (TH.is_expanded tok
&&
335 modified !((TH.info_of_tok tok
).cocci_tag
)
336 (*!((TH.info_of_tok tok).cocci_tag) <> Ast_c.emptyAnnot*))
340 "expanded token %s on line %d is either modified or stored in a metavariable"
341 (TH.str_of_tok tok
) (TH.line_of_tok tok
)));
343 let tok'
= tok +> TH.visitor_info_of_tok
(fun i
->
344 { i
with cocci_tag
= ref Ast_c.emptyAnnot
; }
348 if TH.is_origin
tok && not
(TH.is_real_comment
tok)
356 push2
(T2
(tok'
, minus
, optindex)) toks_out
361 Ast_c.mcode_and_env_of_cocciref
((info_of_token1 t
).cocci_tag
) in
363 let pr_cocci s ln col rcol hint
=
364 push2
(Cocci2
(s
,ln
,col
,rcol
,hint
)) toks_out in
366 (match Ast_c.pinfo_of_info info
with
367 Ast_c.AbstractLineTok _
->
368 push2
(C2
(Ast_c.str_of_info info
)) toks_out
369 | Ast_c.FakeTok
(s
,_
) ->
370 push2
(C2 s
) toks_out
372 Printf.printf
"line: %s\n" (Common.dump info
);
373 failwith
"not an abstract line");
374 (!(info
.Ast_c.comments_tag
)).Ast_c.mafter
+>
375 List.iter
(fun x
-> Common.push2
(comment2t2 x
) toks_out) in
377 let pr_barrier ln col
= (* marks a position, used around C code *)
378 push2
(Cocci2
("",ln
,col
,col
,None
)) toks_out in
379 let pr_nobarrier ln col
= () in (* not needed for linux spacing *)
381 let pr_cspace _
= push2
(C2
" ") toks_out in
383 let pr_space _
= () (* rely on add_space in cocci code *) in
384 let pr_arity _
= () (* not interested *) in
386 let indent _
= push2 Indent_cocci2
toks_out in
387 let unindent x
= push2
(Unindent_cocci2 x
) toks_out in
390 (env
, pr_cocci, pr_c, pr_cspace,
391 (match !Flag_parsing_c.spacing
with
392 Flag_parsing_c.SMPL
-> pr_space | _
-> pr_cspace),
394 (match !Flag_parsing_c.spacing
with
395 Flag_parsing_c.SMPL
-> pr_barrier | _
-> pr_nobarrier),
398 (* old: when for yacfe with partial cocci:
402 (* patch: when need full coccinelle transformation *)
403 let unparser = Unparse_cocci.pp_list_list_any
args_pp false in
405 | Ast_cocci.MINUS
(_
,inst
,adj
,any_xxs
) ->
406 (* Why adding ? because I want to have all the information, the whole
407 * set of tokens, so I can then process and remove the
408 * is_between_two_minus for instance *)
409 add_elem t
(Min
(inst
,adj
));
410 unparser any_xxs
Unparse_cocci.InPlace
411 | Ast_cocci.CONTEXT
(_
,any_befaft
) ->
412 (match any_befaft
with
413 | Ast_cocci.NOTHING
->
415 | Ast_cocci.BEFORE
(xxs
,_
) ->
416 unparser xxs
Unparse_cocci.Before
;
418 | Ast_cocci.AFTER
(xxs
,_
) ->
420 unparser xxs
Unparse_cocci.After
;
421 | Ast_cocci.BEFOREAFTER
(xxs
, yys
, _
) ->
422 unparser xxs
Unparse_cocci.Before
;
424 unparser yys
Unparse_cocci.After
;
426 | Ast_cocci.PLUS _
-> raise Impossible
430 toks
+> List.iter
expand_info;
434 (*****************************************************************************)
435 (* Tokens2 processing, filtering, adjusting *)
436 (*****************************************************************************)
438 let is_space = function
439 | T2
(Parser_c.TCommentSpace _
,_b
,_i
) -> true (* only whitespace *)
442 let is_newline = function
443 | T2
(Parser_c.TCommentNewline _
,_b
,_i
) -> true
446 let is_whitespace = function
449 | Parser_c.TCommentSpace _
-> true (* only whitespace *)
450 | Parser_c.TCommentNewline _
(* newline plus whitespace *) -> true
455 let is_minusable_comment = function
458 | Parser_c.TCommentSpace _
(* only whitespace *)
459 (* patch: coccinelle *)
460 | Parser_c.TCommentNewline _
(* newline plus whitespace *) -> true
461 | Parser_c.TComment _
when !Flag_parsing_c.keep_comments
-> false
462 | Parser_c.TComment _
463 | Parser_c.TCommentCpp
(Token_c.CppAttr
, _
)
464 | Parser_c.TCommentCpp
(Token_c.CppMacro
, _
)
465 | Parser_c.TCommentCpp
(Token_c.CppDirective
, _
) (* result was false *)
468 | Parser_c.TCommentMisc _
469 | Parser_c.TCommentCpp
(Token_c.CppPassingCosWouldGetError
, _
)
476 let is_minusable_comment_nocpp = function
479 | Parser_c.TCommentSpace _
(* only whitespace *)
480 (* patch: coccinelle *)
481 | Parser_c.TCommentNewline _
(* newline plus whitespace *) -> true
482 | Parser_c.TComment _
when !Flag_parsing_c.keep_comments
-> false
483 | Parser_c.TComment _
-> true
484 | Parser_c.TCommentCpp
(Token_c.CppAttr
, _
)
485 | Parser_c.TCommentCpp
(Token_c.CppMacro
, _
)
486 | Parser_c.TCommentCpp
(Token_c.CppDirective
, _
)
489 | Parser_c.TCommentMisc _
490 | Parser_c.TCommentCpp
(Token_c.CppPassingCosWouldGetError
, _
)
497 let all_coccis = function
498 Cocci2 _
| C2 _
| Indent_cocci2
| Unindent_cocci2 _
-> true
501 (*previously gave up if the first character was a newline, but not clear why*)
502 let is_minusable_comment_or_plus x
= is_minusable_comment x
or all_coccis x
504 let set_minus_comment adj
= function
506 let str = TH.str_of_tok t
in
508 | Parser_c.TCommentSpace _
509 (* patch: coccinelle *)
510 | Parser_c.TCommentNewline _
-> ()
512 | Parser_c.TComment _
513 | Parser_c.TCommentCpp
(Token_c.CppAttr
, _
)
514 | Parser_c.TCommentCpp
(Token_c.CppMacro
, _
)
515 | Parser_c.TCommentCpp
(Token_c.CppDirective
, _
)
517 pr2 (Printf.sprintf
"%d: ERASING_COMMENTS: %s"
518 (TH.line_of_tok t
) str)
519 | _
-> raise Impossible
522 (* patch: coccinelle *)
523 | T2
(t
,Min adj
,idx
) as x
-> x
524 | _
-> raise Impossible
526 let set_minus_comment_or_plus adj
= function
527 Cocci2 _
| C2 _
| Indent_cocci2
| Unindent_cocci2 _
as x
-> x
528 | x
-> set_minus_comment adj x
531 xs
+> Common.exclude
(function
532 | T2
(t
,Min adj
,_
) -> true
536 let remove_minus_and_between_and_expanded_and_fake xs
=
538 (* get rid of exampled and fake tok *)
539 let xs = xs +> Common.exclude
(function
540 | T2
(t
,_
,_
) when TH.is_expanded t
-> true
547 let minus_or_comment = function
548 T2
(_
,Min adj
,_
) -> true
549 | x
-> is_minusable_comment x
in
551 let minus_or_comment_nocpp = function
552 T2
(_
,Min adj
,_
) -> true
553 | x
-> is_minusable_comment_nocpp x
in
555 let common_adj (index1
,adj1
) (index2
,adj2
) =
556 adj1
= adj2
(* same adjacency info *) &&
557 (* non-empty intersection of witness trees *)
558 not
((Common.inter_set index1 index2
) = []) in
560 let rec adjust_around_minus = function
562 | (T2
(Parser_c.TCommentNewline c
,_b
,_i
) as x
)::
563 (((T2
(_
,Min adj
,_
))::_
) as rest
) ->
564 (* an initial newline, as in a replaced statement *)
565 let (between_minus
,rest
) = Common.span
minus_or_comment rest
in
567 [] -> (set_minus_comment adj x
) ::
568 (List.map
(set_minus_comment adj
) between_minus
)
569 | T2
(_
,Ctx
,_
)::_
when is_newline (List.hd
(List.rev between_minus
)) ->
570 (set_minus_comment adj x
)::(adjust_within_minus between_minus
) @
571 (adjust_around_minus rest
)
573 x
:: (adjust_within_minus between_minus
) @
574 (adjust_around_minus rest
))
575 | ((T2
(_
,Min adj
,_
))::_
) as rest
->
576 (* no initial newline, as in a replaced expression *)
577 let (between_minus
,rest
) = Common.span
minus_or_comment rest
in
580 (List.map
(set_minus_comment adj
) between_minus
)
582 (adjust_within_minus between_minus
) @
583 (adjust_around_minus rest
))
584 | x
::xs -> x
::adjust_around_minus xs
585 and adjust_within_minus
= function
587 | (T2
(_
,Min adj1
,_
) as t1
)::xs ->
588 let (between_minus
,rest
) = Common.span
is_minusable_comment xs in
591 (* keep last newline *)
595 Common.split_when
is_newline between_minus
in
597 with Not_found
-> (between_minus
,[]) in
599 List.map
(set_minus_comment_or_plus adj1
) drop
@
601 | (T2
(_
,Min adj2
,_
) as t2
)::rest
when common_adj adj1 adj2
->
603 List.map
(set_minus_comment_or_plus adj1
) between_minus
@
604 adjust_within_minus
(t2
::rest
)
606 t1
::(between_minus
@ adjust_within_minus
(x
::xs)))
607 | _
-> failwith
"only minus and space possible" in
609 (* new idea: collects regions not containing non-space context code
610 if two adjacent adjacent minus tokens satisfy common_adj then delete
611 all spaces, comments etc between them
612 if two adjacent minus tokens do not satisfy common_adj only delete
613 the spaces between them if there are no comments, etc.
614 if the region contain no plus code and is both preceded and followed
615 by a newline, delete the initial newline. *)
617 let rec adjust_around_minus = function
619 | (T2
(Parser_c.TCommentNewline c
,_b
,_i
) as x
)::
620 (T2
(_
,Min adj1
,_
) as t1
)::xs ->
621 let (minus_list
,rest
) = Common.span not_context
(t1
::xs) in
622 let contains_plus = List.exists is_plus minus_list
in
624 match List.rev minus_list
with
625 (T2
(Parser_c.TCommentNewline c
,_b
,_i
))::rest
626 when List.for_all
minus_or_comment minus_list
->
627 set_minus_comment_or_plus adj1
x
629 x :: adjust_within_minus
contains_plus minus_list
@
630 adjust_around_minus rest
631 | (T2
(_
,Min adj1
,_
) as t1
)::xs ->
632 let (minus_list
,rest
) = Common.span not_context
(t1
::xs) in
633 let contains_plus = List.exists is_plus minus_list
in
634 adjust_within_minus
contains_plus minus_list
@ adjust_around_minus rest
635 | x::xs -> x :: adjust_around_minus xs
636 and adjust_within_minus cp
(* contains plus *) = function
637 (T2
(_
,Min adj1
,_
) as t1
)::xs ->
638 let not_minus = function T2
(_
,Min _
,_
) -> false | _
-> true in
639 let (not_minus_list
,rest
) = Common.span
not_minus xs in
642 (T2
(_
,Min adj2
,_
) as t2
)::xs when common_adj adj1 adj2
->
643 (List.map
(set_minus_comment_or_plus adj1
) not_minus_list
)
644 @ (adjust_within_minus cp
(t2
::xs))
645 | (T2
(_
,Min adj2
,_
) as t2
)::xs ->
646 let is_whitespace_or_plus = function
647 (T2 _
) as x -> is_whitespace x
648 | _
-> true (*plus*) in
649 if List.for_all
is_whitespace_or_plus not_minus_list
651 (List.map
(set_minus_comment_or_plus adj1
) not_minus_list
)
652 @ (adjust_within_minus cp
(t2
::xs))
653 else not_minus_list
@ (adjust_within_minus cp
(t2
::xs))
658 let (spaces
,rest
) = Common.span
is_space xs in
659 (List.map
(set_minus_comment_or_plus adj1
) spaces
)
661 | xs -> failwith
"should always start with minus"
662 and not_context
= function
663 (T2
(_
,Ctx
,_
) as x) when not
(is_minusable_comment x) -> false
665 and is_plus
= function
666 C2 _
| Cocci2 _
-> true
669 let xs = adjust_around_minus xs in
671 (* this drops blank lines after a brace introduced by removing code *)
672 let minus_or_comment_nonl = function
673 T2
(_
,Min adj
,_
) -> true
674 | T2
(Parser_c.TCommentNewline _
,_b
,_i
) -> false
675 | x -> is_minusable_comment x in
677 let rec adjust_after_brace = function
679 | ((T2
(_
,Ctx
,_
)) as x)::((T2
(_
,Min adj
,_
)::_
) as xs)
680 when str_of_token2 x =$
= "{" ->
681 let (between_minus
,rest
) = Common.span
minus_or_comment_nonl xs in
682 let is_whitespace = function
683 T2
(Parser_c.TCommentSpace _
,_b
,_i
)
685 | T2
(Parser_c.TCommentNewline _
,_b
,_i
) -> true
687 let (newlines
,rest
) = Common.span
is_whitespace rest
in
688 let (drop_newlines
,last_newline
) =
689 let rec loop = function
691 | ((T2
(Parser_c.TCommentNewline _
,_b
,_i
)) as x) :: rest
->
694 let (drop_newlines
,last_newline
) = loop xs in
695 (drop_newlines
,x::last_newline
) in
696 loop (List.rev newlines
) in
697 x::between_minus
@(List.map
(set_minus_comment adj
) drop_newlines
)@
699 adjust_after_brace rest
700 | x::xs -> x::adjust_after_brace xs in
702 let xs = adjust_after_brace xs in
704 (* search backwards from context } over spaces until reaching a newline.
705 then go back over all minus code until reaching some context or + code.
706 get rid of all intervening spaces, newlines, and comments
708 let rec adjust_before_brace = function
710 | ((T2
(t
,Ctx
,_
)) as x)::xs when str_of_token2 x =$
= "}" or is_newline x ->
711 let (outer_spaces
,rest
) = Common.span
is_space xs in
714 ((T2
(Parser_c.TCommentNewline _
,Ctx
,_i
)) as h
) ::
715 (* the rest of this code is the same as from_newline below
716 but merging them seems to be error prone... *)
717 ((T2
(t
, Min adj
, idx
)) as m
) :: rest
->
718 let (spaces
,rest
) = Common.span
minus_or_comment_nocpp rest
in
720 (List.map
(set_minus_comment adj
) spaces
) @
721 (adjust_before_brace rest
)
722 | _
-> adjust_before_brace rest
)
723 | x::xs -> x :: (adjust_before_brace xs) in
725 let from_newline = function
726 ((T2
(t
, Min adj
, idx
)) as m
) :: rest
->
727 let (spaces
,rest
) = Common.span
minus_or_comment_nocpp rest
in
729 (List.map
(set_minus_comment adj
) spaces
) @
730 (adjust_before_brace rest
)
731 | rest
-> adjust_before_brace rest
in
733 let xs = List.rev
(from_newline (List.rev
xs)) in
734 let xs = drop_minus xs in
737 (* normally, in C code, a semicolon is not preceded by a space or newline *)
738 let adjust_before_semicolon toks
=
739 let toks = List.rev
toks in
740 let rec search_semic = function
742 | ((T2
(_
,Ctx
,_
)) as x)::xs | ((Cocci2 _
) as x)::xs ->
743 if List.mem
(str_of_token2 x) [";";")";","]
744 then x :: search_minus
false xs
745 else x :: search_semic xs
746 | x::xs -> x :: search_semic xs
747 and search_minus seen_minus
xs =
748 let (spaces
, rest
) = Common.span
is_space xs in
749 (* only delete spaces if something is actually deleted *)
751 ((T2
(_
,Min _
,_
)) as a
)::rerest
-> a
:: search_minus
true rerest
752 | _
-> if seen_minus
then rest
else xs in
753 List.rev
(search_semic toks)
755 let is_ident_like s
= s
==~
Common.regexp_alpha
757 let rec add_space xs =
761 | (Cocci2
(sx
,lnx
,_
,rcolx
,_
) as x)::((Cocci2
(sy
,lny
,lcoly
,_
,_
)) as y
)::xs
762 when !Flag_parsing_c.spacing
= Flag_parsing_c.SMPL
&&
763 not
(lnx
= -1) && lnx
= lny
&& not
(rcolx
= -1) && rcolx
< lcoly
->
764 (* this only works within a line. could consider whether
765 something should be done to add newlines too, rather than
766 printing them explicitly in unparse_cocci. *)
767 x::C2
(String.make
(lcoly
-rcolx
) ' '
)::add_space (y
::xs)
769 let sx = str_of_token2 x in
770 let sy = str_of_token2 y
in
771 if is_ident_like sx && is_ident_like sy
772 then x::C2
" "::(add_space (y
::xs))
773 else x::(add_space (y
::xs))
775 (* The following only works for the outermost function call. Stack records
776 the column of all open parentheses. Space_cell contains the most recent
777 comma in the outermost function call. The goal is to decide whether this
778 should be followed by a space or a newline and indent. *)
779 let add_newlines toks tabbing_unit
=
780 let create_indent n
=
782 match tabbing_unit
with
783 Some
("\t",_
) -> ("\t",8)
784 | Some
("",_
) -> ("\t",8) (* not sure why... *)
785 | Some
(s
,_
) -> (s
,String.length s
) (* assuming only spaces *)
786 | None
-> ("\t",8) in
789 then tu ^
loop (seen
+ tlen
)
790 else String.make
(n
-seen
) ' '
in
792 let check_for_newline count
x = function
793 Some
(start
,space_cell
) when count
> Flag_parsing_c.max_width
->
794 space_cell
:= "\n"^
(create_indent x);
795 Some
(x + (count
- start
))
797 (* the following is for strings that may contain newline *)
798 let string_length s count
=
799 let l = list_of_string s
in
807 let rec loop info count
= function
809 | ((T2
(tok,_
,_
)) as a
)::xs ->
810 a
:: loop info
(string_length (TH.str_of_tok
tok) count
) xs
811 | ((Cocci2
(s
,line
,lcol
,rcol
,hint
)) as a
)::xs ->
812 let (stack
,space_cell
) = info
in
815 None
-> loop info
(count
+ (String.length s
)) xs
816 | Some
Unparse_cocci.StartBox
->
817 let count = count + (String.length s
) in
818 loop (count::stack
,space_cell
) count xs
819 | Some
Unparse_cocci.EndBox
->
820 let count = count + (String.length s
) in
823 (match check_for_newline count x space_cell
with
824 Some
count -> loop ([],None
) count xs
825 | None
-> loop ([],None
) count xs)
826 | _
-> loop (List.tl stack
,space_cell
) count xs)
827 | Some
(Unparse_cocci.SpaceOrNewline sp
) ->
828 let count = count + (String.length s
) + 1 (*space*) in
831 (match check_for_newline count x space_cell
with
832 Some
count -> loop (stack
,Some
(x,sp
)) count xs
833 | None
-> loop (stack
,Some
(count,sp
)) count xs)
834 | _
-> loop info
count xs) in
836 | ((C2
(s
)) as a
)::xs -> a
:: loop info
(string_length s
count) xs
837 | Fake2
:: _
| Indent_cocci2
:: _
838 | Unindent_cocci2 _
::_
->
839 failwith
"unexpected fake, indent, or unindent" in
840 let redo_spaces prev = function
841 Cocci2
(s
,line
,lcol
,rcol
,Some
(Unparse_cocci.SpaceOrNewline sp
)) ->
842 C2
!sp
:: Cocci2
(s
,line
,lcol
,rcol
,None
) :: prev
844 (match !Flag_parsing_c.spacing
with
845 Flag_parsing_c.SMPL
-> toks
846 | _
-> List.rev
(List.fold_left
redo_spaces [] (loop ([],None
) 0 toks)))
848 (* When insert some new code, because of a + in a SP, we must add this
849 * code at the right place, with the good indentation. So each time we
850 * encounter some spacing info, with some newline, we maintain the
851 * current indentation level used.
853 * TODO problems: not accurate. ex: TODO
855 * TODO: if in #define region, should add a \ \n
857 let new_tabbing2 space
=
858 (list_of_string space
)
860 +> Common.take_until
(fun c
-> c
=<= '
\n'
)
862 +> List.map string_of_char
866 Common.profile_code
"C unparsing.new_tabbing" (fun () -> new_tabbing2 a
)
869 let rec adjust_indentation xs =
871 let _current_tabbing = ref "" in
872 let tabbing_unit = ref None
in
874 let string_of_list l = String.concat
"" (List.map string_of_char
l) in
876 (* try to pick a tabbing unit for the plus code *)
877 let adjust_tabbing_unit old_tab new_tab
=
878 if !tabbing_unit =*= None
&& String.length new_tab
> String.length old_tab
880 let old_tab = list_of_string
old_tab in
881 let new_tab = list_of_string
new_tab in
882 let rec loop = function
884 tabbing_unit := Some
(string_of_list new_tab,List.rev
new_tab)
885 | (_
,[]) -> failwith
"not possible"
886 | (o
::os
,n
::ns
) -> loop (os
,ns
) in (* could check for equality *)
887 loop (old_tab,new_tab) in
889 let remtab tu current_tab
=
890 let current_tab = List.rev
(list_of_string
current_tab) in
891 let rec loop = function
892 ([],new_tab) -> string_of_list (List.rev
new_tab)
893 | (_
,[]) -> "" (*weird; tabbing unit used up more than the current tab*)
894 | (t
::ts
,n
::ns
) when t
=<= n
-> loop (ts
,ns
)
895 | (_
,ns
) -> (* mismatch; remove what we can *)
896 string_of_list (List.rev ns
) in
897 loop (tu
,current_tab) in
899 let rec find_first_tab started
= function
901 | ((T2
(tok,_
,_
)) as x)::xs when str_of_token2 x =$
= "{" ->
902 find_first_tab true xs
903 (* patch: coccinelle *)
904 | ((T2
(Parser_c.TCommentNewline s
, _
, _
)) as x)::_
906 let s = str_of_token2 x +> new_tabbing in
907 tabbing_unit := Some
(s,List.rev
(list_of_string
s))
908 | x::xs -> find_first_tab started
xs in
909 find_first_tab false xs;
911 let rec aux started
xs =
914 (* patch: coccinelle *)
915 | ((T2
(tok,_
,_
)) as x)::(T2
(Parser_c.TCommentNewline
s, _
, _
))::
916 ((Cocci2
("{",_
,_
,_
,_
)) as a
)::xs
917 when started
&& str_of_token2 x =$
= ")" ->
918 (* to be done for if, etc, but not for a function header *)
919 x::(C2
" ")::a
::(aux started
xs)
920 | ((T2
(Parser_c.TCommentNewline
s, _
, _
)) as x)::xs ->
921 let old_tabbing = !_current_tabbing in
922 str_of_token2 x +> new_tabbing +> (fun s -> _current_tabbing := s);
923 (* only trust the indentation after the first { *)
925 then adjust_tabbing_unit old_tabbing !_current_tabbing);
926 let coccis_rest = Common.span
all_coccis xs in
927 (match coccis_rest with
928 (_
::_
,((T2
(tok,_
,_
)) as y
)::_
) when str_of_token2 y
=$
= "}" ->
929 (* the case where cocci code has been added before a close } *)
930 x::aux started
(Indent_cocci2
::xs)
931 | _
-> x::aux started
xs)
932 | Indent_cocci2
::xs ->
933 (match !tabbing_unit with
934 None
-> aux started
xs
936 _current_tabbing := (!_current_tabbing)^tu
;
937 Cocci2
(tu
,-1,-1,-1,None
)::aux started
xs)
938 | Unindent_cocci2
(permanent
)::xs ->
939 (match !tabbing_unit with
940 None
-> aux started
xs
942 _current_tabbing := remtab tu
(!_current_tabbing);
944 (* border between existing code and cocci code *)
945 | ((T2
(tok,_
,_
)) as x)::((Cocci2
("\n",_
,_
,_
,_
)) as y
)::xs
946 when str_of_token2 x =$
= "{" ->
947 x::aux true (y
::Indent_cocci2
::xs)
948 | ((Cocci2 _
) as x)::((T2
(tok,_
,_
)) as y
)::xs
949 when str_of_token2 y
=$
= "}" ->
950 x::aux started
(y
::Unindent_cocci2
true::xs)
951 (* starting the body of the function *)
952 | ((T2
(tok,_
,_
)) as x)::xs when str_of_token2 x =$
= "{" -> x::aux true xs
953 | ((Cocci2
("{",_
,_
,_
,_
)) as a
)::xs -> a
::aux true xs
954 | ((Cocci2
("\n",_
,_
,_
,_
)) as x)::Unindent_cocci2
(false)::xs ->
956 | ((Cocci2
("\n",_
,_
,_
,_
)) as x)::xs ->
957 (* dont inline in expr because of weird eval order of ocaml *)
958 let s = !_current_tabbing in
959 x::Cocci2
(s,-1,-1,-1,None
)::aux started
xs
960 | x::xs -> x::aux started
xs in
961 (aux false xs,!tabbing_unit)
964 let rec find_paren_comma = function
967 (* do nothing if was like this in original file *)
968 | ({ str = "("; idx
= Some p1
} as _x1
)::({ str = ","; idx
= Some p2
} as x2
)
969 ::xs when p2
=|= p1
+ 1 ->
970 find_paren_comma (x2
::xs)
972 | ({ str = ","; idx
= Some p1
} as _x1
)::({ str = ","; idx
= Some p2
} as x2
)
973 ::xs when p2
=|= p1
+ 1 ->
974 find_paren_comma (x2
::xs)
976 | ({ str = ","; idx
= Some p1
} as _x1
)::({ str = ")"; idx
= Some p2
} as x2
)
977 ::xs when p2
=|= p1
+ 1 ->
978 find_paren_comma (x2
::xs)
980 (* otherwise yes can adjust *)
981 | ({ str = "(" } as _x1
)::({ str = ","} as x2
)::xs ->
983 find_paren_comma (x2
::xs)
984 | ({ str = "," } as x1
)::({ str = ","} as x2
)::xs ->
986 find_paren_comma (x2
::xs)
988 | ({ str = "," } as x1
)::({ str = ")"} as x2
)::xs ->
990 find_paren_comma (x2
::xs)
996 let fix_tokens toks =
997 let toks = toks +> List.map
mk_token_extended in
999 let cleaner = toks +> Common.exclude
(function
1000 | {tok2
= T2
(t
,_
,_
)} -> TH.is_real_comment t
(* I want the ifdef *)
1003 find_paren_comma cleaner;
1005 let toks = rebuild_tokens_extented toks in
1006 toks +> List.map
(fun x -> x.tok2
)
1010 (*****************************************************************************)
1011 (* Final unparsing (and debugging support) *)
1012 (*****************************************************************************)
1015 type kind_token2
= KFake
| KCocci
| KC
| KExpanded
| KOrigin
1017 let kind_of_token2 = function
1019 | Cocci2 _
-> KCocci
1022 (match TH.pinfo_of_tok t
with
1023 | ExpandedTok _
-> KExpanded
1024 | OriginTok _
-> KOrigin
1025 | FakeTok _
-> raise Impossible
(* now a Fake2 *)
1026 | AbstractLineTok _
-> raise Impossible
(* now a KC *)
1028 | Unindent_cocci2 _
| Indent_cocci2
-> raise Impossible
1032 let start_mark = function
1036 | KExpanded
-> "!E!"
1039 let print_all_tokens2 pr
xs =
1040 if !Flag_parsing_c.debug_unparsing
1042 let current_kind = ref KOrigin
in
1043 xs +> List.iter
(fun t
->
1044 let newkind = kind_of_token2 t
in
1045 if newkind =*= !current_kind
1046 then pr
(str_of_token2 t
)
1049 pr
(start_mark newkind);
1050 pr
(str_of_token2 t
);
1051 current_kind := newkind
1055 xs +> List.iter
(fun x -> pr
(str_of_token2 x))
1060 (*****************************************************************************)
1062 (*****************************************************************************)
1064 (* old: PPviatok was made in the beginning to allow to pretty print a
1065 * complete C file, including a modified C file by transformation.ml,
1066 * even if we don't handle yet in pretty_print_c.ml, ast_to_flow (and
1067 * maybe flow_to_ast) all the cases. Indeed we don't need to do some
1068 * fancy stuff when a function was not modified at all. Just need to
1069 * print the list of token as-is. But now pretty_print_c.ml handles
1070 * almost everything so maybe less useful. Maybe PPviatok allows to
1071 * optimize a little the pretty printing.
1073 * update: now have PPviastr which goes even faster than PPviatok, so
1074 * PPviatok has disappeared.
1077 type ppmethod
= PPnormal
| PPviastr
1082 (* The pp_program function will call pretty_print_c.ml with a special
1083 * function to print the leaf components, the tokens. When we want to
1084 * print a token, we need to print also maybe the space and comments that
1085 * were close to it in the original file (and that was omitted during the
1086 * parsing phase), and honor what the cocci-info attached to the token says.
1087 * Maybe we will not print the token if it's a MINUS-token, and maybe we will
1088 * print it and also print some cocci-code attached in a PLUS to it.
1089 * So we will also maybe call unparse_cocci. Because the cocci-code may
1090 * contain metavariables, unparse_cocci will in fact sometimes call back
1091 * pretty_print_c (which will this time don't call back again unparse_cocci)
1094 let pp_program2 xs outfile
=
1095 Common.with_open_outfile outfile
(fun (pr
,chan
) ->
1097 if !Flag_parsing_c.debug_unparsing
1098 then begin pr2_no_nl
s; flush stderr
end
1101 (* Common.pr2 ("UNPARSING: >" ^ s ^ "<"); *)
1104 xs +> List.iter
(fun ((e
,(str, toks_e
)), ppmethod
) ->
1105 (* here can still work on ast *)
1106 let e = remove_useless_fakeInfo_struct e in
1110 (* now work on tokens *)
1112 (* phase1: just get all the tokens, all the information *)
1113 assert(toks_e
+> List.for_all
(fun t
->
1114 TH.is_origin t
or TH.is_expanded t
1116 let toks = get_fakeInfo_and_tokens e toks_e
in
1117 let toks = displace_fake_nodes toks in
1118 (* assert Origin;ExpandedTok;Faketok *)
1119 let toks = expand_mcode toks in
1120 (* assert Origin;ExpandedTok; + Cocci + C (was AbstractLineTok)
1121 * and no tag information, just NOTHING. *)
1124 if !Flag.sgrep_mode2
1125 then drop_minus toks (* nothing to do for sgrep *)
1127 (* phase2: can now start to filter and adjust *)
1128 let (toks,tu
) = adjust_indentation toks in
1129 let toks = adjust_before_semicolon toks in(*before remove minus*)
1130 let toks = remove_minus_and_between_and_expanded_and_fake toks in
1131 (* assert Origin + Cocci + C and no minus *)
1132 let toks = add_space toks in
1133 let toks = add_newlines toks tu
in
1134 let toks = fix_tokens toks in
1137 (* in theory here could reparse and rework the ast! or
1138 * apply some SP. Not before cos julia may have generated
1139 * not parsable file. Need do unparsing_tricks call before being
1140 * ready to reparse. *)
1141 print_all_tokens2 pr toks;
1143 | PPviastr
-> pr str
1147 let pp_program a b
=
1148 Common.profile_code
"C unparsing" (fun () -> pp_program2 a b
)
1151 let pp_program_default xs outfile
=
1152 let xs'
= xs +> List.map
(fun x -> x, PPnormal
) in
1153 pp_program xs' outfile