Commit | Line | Data |
---|---|---|
485bce71 | 1 | (* Copyright (C) 2006, 2007, 2008 Yoann Padioleau |
34e49164 C |
2 | * |
3 | * This program is free software; you can redistribute it and/or | |
4 | * modify it under the terms of the GNU General Public License (GPL) | |
5 | * version 2 as published by the Free Software Foundation. | |
6 | * | |
7 | * This program is distributed in the hope that it will be useful, | |
8 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
9 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
10 | * file license.txt for more details. | |
11 | *) | |
12 | open Common | |
13 | ||
14 | open Ast_c | |
15 | ||
16 | type pr_elem_func = Ast_c.info -> unit | |
17 | type pr_space_func = unit -> unit | |
18 | ||
485bce71 C |
19 | module F = Control_flow_c |
20 | ||
34e49164 C |
21 | (*****************************************************************************) |
22 | ||
23 | (* This module is used by unparse_c, but because unparse_c have also | |
24 | * the list of tokens, pretty_print_c could be useless in the futur | |
25 | * (except that the ast_c have some fake tokens not present in the list | |
26 | * of tokens so it's still useful). But this module is also useful to | |
27 | * unparse C when you don't have the ordered list of tokens separately, | |
28 | * or tokens without position information, for instance when you want | |
29 | * to pretty print some piece of C that was generated, or some | |
30 | * abstract-lined piece of code, etc. *) | |
31 | ||
32 | let rec pp_expression_gen pr_elem pr_space = | |
33 | (* subtil: dont try to shorten the def of pp_statement by omitting e, | |
34 | otherwise get infinite funcall and huge memory consumption *) | |
485bce71 C |
35 | let _pp_statement e = pp_statement_gen pr_elem pr_space e in |
36 | ||
34e49164 C |
37 | let rec pp_expression = fun ((exp, typ), ii) -> |
38 | (match exp, ii with | |
39 | | Ident (c), [i] -> pr_elem i | |
40 | (* only a MultiString can have multiple ii *) | |
41 | | Constant (MultiString), is -> is +> List.iter pr_elem | |
42 | | Constant (c), [i] -> pr_elem i | |
43 | | FunCall (e, es), [i1;i2] -> | |
44 | pp_expression e; pr_elem i1; | |
45 | es +> List.iter (fun (e, opt) -> | |
46 | assert (List.length opt <= 1); (* opt must be a comma? *) | |
47 | opt +> List.iter (function x -> pr_elem x; pr_space()); | |
48 | pp_argument_gen pr_elem pr_space e; | |
49 | ); | |
50 | pr_elem i2; | |
51 | ||
52 | | CondExpr (e1, e2, e3), [i1;i2] -> | |
53 | pp_expression e1; pr_space(); pr_elem i1; pr_space(); | |
54 | do_option (function x -> pp_expression x; pr_space()) e2; pr_elem i2; | |
55 | pp_expression e3 | |
56 | | Sequence (e1, e2), [i] -> | |
57 | pp_expression e1; pr_elem i; pr_space(); pp_expression e2 | |
58 | | Assignment (e1, op, e2), [i] -> | |
59 | pp_expression e1; pr_space(); pr_elem i; pr_space(); pp_expression e2 | |
60 | ||
61 | | Postfix (e, op), [i] -> pp_expression e; pr_elem i; | |
62 | | Infix (e, op), [i] -> pr_elem i; pp_expression e; | |
63 | | Unary (e, op), [i] -> pr_elem i; pp_expression e | |
64 | | Binary (e1, op, e2), [i] -> | |
65 | pp_expression e1; pr_space(); pr_elem i; pr_space(); pp_expression e2 | |
66 | ||
67 | | ArrayAccess (e1, e2), [i1;i2] -> | |
68 | pp_expression e1; pr_elem i1; pp_expression e2; pr_elem i2 | |
69 | | RecordAccess (e, s), [i1;i2] -> | |
70 | pp_expression e; pr_elem i1; pr_elem i2 | |
71 | | RecordPtAccess (e, s), [i1;i2] -> | |
72 | pp_expression e; pr_elem i1; pr_elem i2 | |
73 | ||
74 | | SizeOfExpr (e), [i] -> pr_elem i; pp_expression e | |
75 | | SizeOfType (t), [i1;i2;i3] -> | |
76 | pr_elem i1; pr_elem i2; pp_type_gen pr_elem pr_space t; | |
77 | pr_elem i3 | |
78 | | Cast (t, e), [i1;i2] -> | |
79 | pr_elem i1; pp_type_gen pr_elem pr_space t; pr_elem i2; | |
80 | pp_expression e | |
81 | ||
82 | | StatementExpr (statxs, [ii1;ii2]), [i1;i2] -> | |
83 | pr_elem i1; | |
84 | pr_elem ii1; | |
485bce71 | 85 | statxs +> List.iter (pp_statement_seq_gen pr_elem pr_space); |
34e49164 C |
86 | pr_elem ii2; |
87 | pr_elem i2; | |
88 | | Constructor (t, xs), lp::rp::i1::i2::iicommaopt -> | |
89 | pr_elem lp; | |
90 | pp_type_gen pr_elem pr_space t; | |
91 | pr_elem rp; | |
92 | pr_elem i1; | |
93 | xs +> List.iter (fun (x, ii) -> | |
94 | assert (List.length ii <= 1); | |
95 | ii +> List.iter (function x -> pr_elem x; pr_space()); | |
96 | pp_init_gen pr_elem pr_space x | |
97 | ); | |
98 | iicommaopt +> List.iter pr_elem; | |
99 | pr_elem i2; | |
100 | ||
101 | ||
102 | ||
103 | | ParenExpr (e), [i1;i2] -> pr_elem i1; pp_expression e; pr_elem i2; | |
104 | ||
105 | | (Ident (_) | Constant _ | FunCall (_,_) | CondExpr (_,_,_) | |
106 | | Sequence (_,_) | |
107 | | Assignment (_,_,_) | |
108 | | Postfix (_,_) | Infix (_,_) | Unary (_,_) | Binary (_,_,_) | |
109 | | ArrayAccess (_,_) | RecordAccess (_,_) | RecordPtAccess (_,_) | |
110 | | SizeOfExpr (_) | SizeOfType (_) | Cast (_,_) | |
111 | | StatementExpr (_) | Constructor _ | |
112 | | ParenExpr (_) | |
113 | ),_ -> raise Impossible | |
114 | ); | |
485bce71 | 115 | |
34e49164 C |
116 | if !Flag_parsing_c.pretty_print_type_info |
117 | then begin | |
118 | pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "/*"); | |
119 | !typ +> | |
120 | (fun (ty,_test) -> ty +> | |
121 | Common.do_option | |
122 | (fun (x,l) -> pp_type_gen pr_elem pr_space x; | |
123 | let s = match l with | |
124 | Ast_c.LocalVar _ -> ", local" | |
125 | | _ -> "" in | |
126 | pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str s))); | |
127 | pr_elem (Ast_c.fakeInfo() +> Ast_c.rewrap_str "*/"); | |
128 | end | |
129 | ||
130 | in | |
131 | pp_expression | |
132 | ||
133 | ||
134 | and pp_argument_gen pr_elem pr_space argument = | |
135 | let rec pp_action = function | |
136 | | (ActMisc ii) -> ii +> List.iter pr_elem | |
137 | in | |
138 | match argument with | |
139 | | Left e -> pp_expression_gen pr_elem pr_space e | |
140 | | Right wierd -> | |
141 | (match wierd with | |
142 | | ArgType param -> pp_param_gen pr_elem pr_space param | |
143 | | ArgAction action -> pp_action action | |
144 | ) | |
145 | ||
146 | ||
147 | ||
148 | ||
149 | ||
150 | (* ---------------------- *) | |
151 | and pp_statement_gen pr_elem pr_space = | |
152 | let pp_expression e = pp_expression_gen pr_elem pr_space e in | |
153 | let rec pp_statement = function | |
154 | | Labeled (Label (s, st)), [i1;i2] -> | |
155 | pr_elem i1; pr_elem i2; pp_statement st | |
156 | | Labeled (Case (e, st)), [i1;i2] -> | |
157 | pr_elem i1; pp_expression e; pr_elem i2; pp_statement st | |
158 | | Labeled (CaseRange (e, e2, st)), [i1;i2;i3] -> | |
159 | pr_elem i1; pp_expression e; pr_elem i2; pp_expression e2; pr_elem i3; | |
160 | pp_statement st | |
161 | | Labeled (Default st), [i1;i2] -> pr_elem i1; pr_elem i2; pp_statement st | |
162 | | Compound statxs, [i1;i2] -> | |
485bce71 C |
163 | pr_elem i1; |
164 | statxs +> List.iter (pp_statement_seq_gen pr_elem pr_space); | |
165 | pr_elem i2; | |
34e49164 C |
166 | |
167 | | ExprStatement (None), [i] -> pr_elem i; | |
168 | | ExprStatement (None), [] -> () | |
169 | | ExprStatement (Some e), [i] -> pp_expression e; pr_elem i | |
170 | (* the last ExprStatement of a for does not have a trailing | |
171 | ';' hence the [] for ii *) | |
172 | | ExprStatement (Some e), [] -> pp_expression e; | |
173 | | Selection (If (e, st1, st2)), i1::i2::i3::is -> | |
174 | pr_elem i1; pr_elem i2; pp_expression e; pr_elem i3; pp_statement st1; | |
175 | (match (st2, is) with | |
176 | | ((ExprStatement None, []), []) -> () | |
177 | | ((ExprStatement None, []), [iifakend]) -> pr_elem iifakend | |
178 | | st2, [i4;iifakend] -> pr_elem i4; pp_statement st2; pr_elem iifakend | |
179 | | x -> raise Impossible | |
180 | ) | |
181 | | Selection (Switch (e, st)), [i1;i2;i3;iifakend] -> | |
182 | pr_elem i1; pr_elem i2; pp_expression e; pr_elem i3; pp_statement st; | |
183 | pr_elem iifakend | |
184 | | Iteration (While (e, st)), [i1;i2;i3;iifakend] -> | |
185 | pr_elem i1; pr_elem i2; pp_expression e; pr_elem i3; pp_statement st; | |
186 | pr_elem iifakend | |
187 | | Iteration (DoWhile (st, e)), [i1;i2;i3;i4;i5;iifakend] -> | |
188 | pr_elem i1; pp_statement st; pr_elem i2; pr_elem i3; pp_expression e; | |
189 | pr_elem i4; pr_elem i5; | |
190 | pr_elem iifakend | |
191 | ||
192 | ||
193 | | Iteration (For ((e1opt,il1),(e2opt,il2),(e3opt, il3),st)), | |
194 | [i1;i2;i3;iifakend] -> | |
195 | ||
196 | pr_elem i1; | |
197 | pr_elem i2; | |
198 | pp_statement (ExprStatement e1opt, il1); | |
199 | pp_statement (ExprStatement e2opt, il2); | |
200 | assert (null il3); | |
201 | pp_statement (ExprStatement e3opt, il3); | |
202 | pr_elem i3; | |
203 | pp_statement st; | |
204 | pr_elem iifakend | |
205 | ||
206 | | Iteration (MacroIteration (s,es,st)), [i1;i2;i3;iifakend] -> | |
207 | pr_elem i1; | |
208 | pr_elem i2; | |
209 | ||
210 | es +> List.iter (fun (e, opt) -> | |
211 | assert (List.length opt <= 1); | |
212 | opt +> List.iter pr_elem; | |
213 | pp_argument_gen pr_elem pr_space e; | |
214 | ); | |
215 | ||
216 | pr_elem i3; | |
217 | pp_statement st; | |
218 | pr_elem iifakend | |
219 | ||
220 | | Jump (Goto s), [i1;i2;i3] -> | |
221 | pr_elem i1; pr_space(); pr_elem i2; pr_elem i3; | |
222 | | Jump ((Continue|Break|Return)), [i1;i2] -> pr_elem i1; pr_elem i2; | |
223 | | Jump (ReturnExpr e), [i1;i2] -> | |
224 | pr_elem i1; pr_space(); pp_expression e; pr_elem i2 | |
225 | | Jump (GotoComputed e), [i1;i2;i3] -> | |
226 | pr_elem i1; pr_elem i2; pp_expression e; pr_elem i3 | |
227 | ||
228 | | Decl decl, [] -> pp_decl_gen pr_elem pr_space decl | |
229 | | Asm asmbody, ii -> | |
230 | (match ii with | |
231 | | [iasm;iopar;icpar;iptvirg] -> | |
232 | pr_elem iasm; pr_elem iopar; | |
233 | pp_asmbody_gen pr_elem pr_space asmbody; | |
234 | pr_elem icpar; pr_elem iptvirg | |
235 | | [iasm;ivolatile;iopar;icpar;iptvirg] -> | |
236 | pr_elem iasm; pr_elem ivolatile; pr_elem iopar; | |
237 | pp_asmbody_gen pr_elem pr_space asmbody; | |
238 | pr_elem icpar; pr_elem iptvirg | |
239 | | _ -> raise Impossible | |
240 | ) | |
241 | ||
242 | | NestedFunc def, ii -> | |
243 | assert (null ii); | |
244 | pp_def_gen pr_elem pr_space def | |
245 | | MacroStmt, ii -> | |
246 | ii +> List.iter pr_elem ; | |
247 | ||
34e49164 C |
248 | | ( Labeled (Label (_,_)) | Labeled (Case (_,_)) |
249 | | Labeled (CaseRange (_,_,_)) | Labeled (Default _) | |
250 | | Compound _ | ExprStatement _ | |
251 | | Selection (If (_, _, _)) | Selection (Switch (_, _)) | |
252 | | Iteration (While (_, _)) | Iteration (DoWhile (_, _)) | |
253 | | Iteration (For ((_,_), (_,_), (_, _), _)) | |
254 | | Iteration (MacroIteration (_,_,_)) | |
255 | | Jump (Goto _) | Jump ((Continue|Break|Return)) | Jump (ReturnExpr _) | |
256 | | Jump (GotoComputed _) | |
485bce71 | 257 | | Decl _ |
34e49164 C |
258 | ), _ -> raise Impossible |
259 | ||
260 | in | |
261 | pp_statement | |
262 | ||
485bce71 C |
263 | and pp_statement_seq_gen pr_elem pr_space stseq = |
264 | match stseq with | |
265 | | StmtElem st -> | |
266 | pp_statement_gen pr_elem pr_space st | |
267 | | IfdefStmt ifdef -> pp_ifdef_gen pr_elem pr_space ifdef | |
268 | | CppDirectiveStmt cpp -> pp_directive_gen pr_elem pr_space cpp | |
269 | | IfdefStmt2 (ifdef, xxs) -> | |
270 | pp_ifdef_tree_sequence pr_elem pr_space ifdef xxs | |
271 | ||
272 | (* ifdef XXX elsif YYY elsif ZZZ endif *) | |
273 | and pp_ifdef_tree_sequence pr_elem pr_space ifdef xxs = | |
274 | match ifdef with | |
275 | | if1::ifxs -> | |
276 | pp_ifdef_gen pr_elem pr_space if1; | |
277 | pp_ifdef_tree_sequence_aux pr_elem pr_space ifxs xxs | |
278 | | _ -> raise Impossible | |
279 | ||
280 | (* XXX elsif YYY elsif ZZZ endif *) | |
281 | and pp_ifdef_tree_sequence_aux pr_elem pr_space ifdefs xxs = | |
282 | Common.zip ifdefs xxs +> List.iter (fun (ifdef, xs) -> | |
283 | xs +> List.iter (pp_statement_seq_gen pr_elem pr_space); | |
284 | pp_ifdef_gen pr_elem pr_space ifdef; | |
285 | ) | |
286 | ||
287 | ||
288 | ||
34e49164 | 289 | |
485bce71 C |
290 | |
291 | (* ---------------------- *) | |
34e49164 C |
292 | and pp_asmbody_gen pr_elem pr_space (string_list, colon_list) = |
293 | string_list +> List.iter pr_elem ; | |
294 | colon_list +> List.iter (fun (Colon xs, ii) -> | |
295 | ii +> List.iter pr_elem; | |
296 | xs +> List.iter (fun (x,iicomma) -> | |
297 | assert ((List.length iicomma) <= 1); | |
298 | iicomma +> List.iter (function x -> pr_elem x; pr_space()); | |
299 | (match x with | |
300 | | ColonMisc, ii -> ii +> List.iter pr_elem; | |
301 | | ColonExpr e, [istring;iopar;icpar] -> | |
302 | pr_elem istring; | |
303 | pr_elem iopar; | |
304 | pp_expression_gen pr_elem pr_space e; | |
305 | pr_elem icpar | |
485bce71 | 306 | | (ColonExpr _), _ -> raise Impossible |
34e49164 C |
307 | ) |
308 | )) | |
309 | ||
310 | ||
311 | (* ---------------------- *) | |
485bce71 C |
312 | |
313 | (* | |
314 | pp_type_with_ident_gen | |
315 | pp_base_type_gen | |
316 | pp_type_with_ident_rest_gen | |
317 | pp_type_left_gen | |
318 | pp_type_right_gen | |
319 | pp_type_gen | |
320 | ||
321 | pp_decl_gen | |
322 | *) | |
34e49164 C |
323 | and (pp_type_with_ident_gen: |
324 | pr_elem_func -> pr_space_func -> | |
485bce71 C |
325 | (string * info) option -> (storage * il) option -> |
326 | fullType -> attribute list -> | |
327 | unit) = | |
34e49164 | 328 | fun pr_elem pr_space -> |
485bce71 | 329 | fun ident sto ((qu, iiqu), (ty, iity)) attrs -> |
34e49164 C |
330 | pp_base_type_gen pr_elem pr_space ((qu, iiqu), (ty, iity)) sto; |
331 | pp_type_with_ident_rest_gen pr_elem pr_space ident | |
485bce71 | 332 | ((qu, iiqu), (ty, iity)) attrs |
34e49164 C |
333 | |
334 | ||
335 | and (pp_base_type_gen: | |
336 | pr_elem_func -> pr_space_func -> fullType -> | |
337 | (storage * il) option -> unit) = | |
338 | fun pr_elem pr_space -> | |
339 | let pp_expression e = pp_expression_gen pr_elem pr_space e in | |
340 | ||
341 | let rec pp_base_type = | |
342 | fun (qu, (ty, iity)) sto -> | |
343 | let get_sto sto = | |
344 | match sto with | |
345 | | None -> [] | Some (s, iis) -> (*assert (List.length iis = 1);*) iis | |
346 | in | |
347 | let print_sto_qu (sto, (qu, iiqu)) = | |
348 | let all_ii = get_sto sto ++ iiqu in | |
349 | all_ii | |
350 | +> List.sort Ast_c.compare_pos | |
351 | +> List.iter pr_elem; | |
352 | ||
353 | in | |
354 | let print_sto_qu_ty (sto, (qu, iiqu), iity) = | |
355 | let all_ii = get_sto sto ++ iiqu ++ iity in | |
356 | let all_ii2 = all_ii +> List.sort Ast_c.compare_pos in | |
357 | ||
358 | if all_ii <> all_ii2 | |
359 | then begin | |
360 | (* TODO in fact for pointer, the qualifier is after the type | |
361 | * cf -test strangeorder | |
362 | *) | |
363 | pr2 "STRANGEORDER"; | |
364 | all_ii2 +> List.iter pr_elem | |
365 | end | |
366 | else all_ii2 +> List.iter pr_elem | |
367 | in | |
368 | ||
369 | match ty, iity with | |
370 | | (Pointer t, [i]) -> pp_base_type t sto | |
371 | | (ParenType t, _) -> pp_base_type t sto | |
372 | | (Array (eopt, t), [i1;i2]) -> pp_base_type t sto | |
373 | | (FunctionType (returnt, paramst), [i1;i2]) -> | |
374 | pp_base_type returnt sto | |
375 | ||
376 | ||
377 | | (StructUnion (su, sopt, fields),iis) -> | |
378 | print_sto_qu (sto, qu); | |
379 | ||
380 | (match sopt,iis with | |
381 | | Some s , [i1;i2;i3;i4] -> | |
382 | pr_elem i1; pr_elem i2; pr_elem i3; | |
383 | | None, [i1;i2;i3] -> | |
384 | pr_elem i1; pr_elem i2; | |
385 | | x -> raise Impossible | |
386 | ); | |
387 | ||
388 | fields +> List.iter | |
485bce71 | 389 | (fun (xfield, iipttvirg_when_emptyfield) -> |
34e49164 C |
390 | |
391 | match xfield with | |
485bce71 | 392 | | DeclarationField (FieldDeclList (onefield_multivars, iiptvirg)) -> |
34e49164 C |
393 | (match onefield_multivars with |
394 | | x::xs -> | |
395 | (* handling the first var. Special case, with the | |
396 | first var, we print the whole type *) | |
397 | ||
398 | (match x with | |
399 | | (Simple (sopt, typ), iis), iivirg -> | |
400 | (* first var cant have a preceding ',' *) | |
401 | assert (List.length iivirg = 0); | |
402 | let identinfo = | |
403 | (match sopt, iis with | |
404 | None,_ -> None | |
405 | | (Some s, [iis]) -> Some (s, iis) | |
406 | | x -> raise Impossible) | |
407 | in | |
408 | pp_type_with_ident_gen pr_elem pr_space | |
485bce71 | 409 | identinfo None typ Ast_c.noattr; |
34e49164 C |
410 | |
411 | | (BitField (sopt, typ, expr), ii), iivirg -> | |
412 | (* first var cant have a preceding ',' *) | |
413 | assert (List.length iivirg = 0); | |
414 | (match sopt, ii with | |
415 | | (None , [idot]) -> | |
416 | pp_type_gen pr_elem pr_space typ; | |
417 | pr_elem idot; | |
418 | pp_expression expr | |
419 | | (Some s, [is;idot]) -> | |
420 | pp_type_with_ident_gen | |
485bce71 C |
421 | pr_elem pr_space |
422 | (Some (s, is)) None typ Ast_c.noattr; | |
34e49164 C |
423 | pr_elem idot; |
424 | pp_expression expr | |
425 | | x -> raise Impossible | |
426 | ) | |
485bce71 | 427 | ); (* match x, first onefield_multivars *) |
34e49164 C |
428 | |
429 | (* for other vars *) | |
430 | xs +> List.iter (function | |
431 | | (Simple (sopt, typ), iis), iivirg -> | |
432 | iivirg +> List.iter pr_elem; | |
433 | let identinfo = | |
434 | (match sopt, iis with | |
435 | | None,_ -> None | |
436 | | (Some s, [iis]) -> Some (s, iis) | |
437 | | x -> raise Impossible) | |
438 | in | |
439 | pp_type_with_ident_rest_gen pr_elem pr_space | |
485bce71 | 440 | identinfo typ Ast_c.noattr; |
34e49164 C |
441 | |
442 | | (BitField (sopt, typ, expr), ii), iivirg -> | |
443 | iivirg +> List.iter pr_elem; | |
444 | (match sopt, ii with | |
445 | | (Some s, [is;idot]) -> | |
446 | pp_type_with_ident_rest_gen | |
485bce71 C |
447 | pr_elem pr_space |
448 | (Some (s, is)) typ Ast_c.noattr; | |
34e49164 C |
449 | pr_elem idot; |
450 | pp_expression expr | |
451 | | x -> raise Impossible | |
452 | ); | |
453 | ||
485bce71 C |
454 | ); (* iter other vars *) |
455 | ||
456 | | [] -> raise Impossible | |
457 | ); (* onefield_multivars *) | |
458 | assert (List.length iiptvirg = 1); | |
459 | iiptvirg +> List.iter pr_elem; | |
460 | ||
461 | ||
462 | | MacroStructDeclTodo -> pr2 "MacroTodo" | |
463 | ||
34e49164 | 464 | |
485bce71 C |
465 | | EmptyField -> |
466 | iipttvirg_when_emptyfield +> List.iter pr_elem | |
467 | ||
468 | | CppDirectiveStruct cpp -> pp_directive_gen pr_elem pr_space cpp | |
469 | | IfdefStruct ifdef -> pp_ifdef_gen pr_elem pr_space ifdef | |
34e49164 C |
470 | ); |
471 | ||
472 | (match sopt,iis with | |
473 | | Some s , [i1;i2;i3;i4] -> pr_elem i4 | |
474 | | None, [i1;i2;i3] -> pr_elem i3; | |
475 | | x -> raise Impossible | |
476 | ); | |
477 | ||
478 | ||
479 | ||
480 | | (Enum (sopt, enumt), iis) -> | |
481 | print_sto_qu (sto, qu); | |
482 | ||
483 | (match sopt, iis with | |
484 | | (Some s, ([i1;i2;i3;i4]|[i1;i2;i3;i4;_])) -> | |
485 | pr_elem i1; pr_elem i2; pr_elem i3; | |
486 | | (None, ([i1;i2;i3]|[i1;i2;i3;_])) -> | |
487 | pr_elem i1; pr_elem i2 | |
488 | | x -> raise Impossible | |
489 | ); | |
490 | ||
491 | enumt +> List.iter (fun (((s, eopt),ii_s_eq), iicomma) -> | |
492 | assert (List.length iicomma <= 1); | |
493 | iicomma +> List.iter (function x -> pr_elem x; pr_space()); | |
494 | (match eopt, ii_s_eq with | |
495 | | None, [is] -> pr_elem is; | |
496 | | Some e, [is;ieq] -> pr_elem is; pr_elem ieq; pp_expression e | |
497 | | _ -> raise Impossible | |
498 | ) | |
499 | ||
500 | ); | |
501 | ||
502 | (match sopt, iis with | |
503 | | (Some s, [i1;i2;i3;i4]) -> pr_elem i4 | |
504 | | (Some s, [i1;i2;i3;i4;i5]) -> | |
505 | pr_elem i5; pr_elem i4 (* trailing comma *) | |
506 | | (None, [i1;i2;i3]) -> pr_elem i3 | |
507 | | (None, [i1;i2;i3;i4]) -> | |
508 | pr_elem i4; pr_elem i3 (* trailing comma *) | |
509 | ||
510 | ||
511 | | x -> raise Impossible | |
512 | ); | |
513 | ||
514 | ||
515 | | (BaseType _, iis) -> | |
516 | print_sto_qu_ty (sto, qu, iis); | |
517 | ||
518 | | (StructUnionName (s, structunion), iis) -> | |
519 | assert (List.length iis = 2); | |
520 | print_sto_qu_ty (sto, qu, iis); | |
521 | ||
522 | | (EnumName s, iis) -> | |
523 | assert (List.length iis = 2); | |
524 | print_sto_qu_ty (sto, qu, iis); | |
525 | ||
526 | | (TypeName (s,_typ), iis) -> | |
527 | assert (List.length iis = 1); | |
528 | print_sto_qu_ty (sto, qu, iis); | |
529 | ||
530 | | (TypeOfExpr (e), iis) -> | |
531 | print_sto_qu (sto, qu); | |
532 | (match iis with | |
533 | | [itypeof;iopar;icpar] -> | |
534 | pr_elem itypeof; pr_elem iopar; | |
535 | pp_expression_gen pr_elem pr_space e; | |
536 | pr_elem icpar; | |
537 | | _ -> raise Impossible | |
538 | ) | |
539 | ||
540 | | (TypeOfType (t), iis) -> | |
541 | print_sto_qu (sto, qu); | |
542 | (match iis with | |
543 | | [itypeof;iopar;icpar] -> | |
544 | pr_elem itypeof; pr_elem iopar; | |
545 | pp_type_gen pr_elem pr_space t; | |
546 | pr_elem icpar; | |
547 | | _ -> raise Impossible | |
548 | ) | |
549 | ||
485bce71 C |
550 | | (Pointer _ | (*ParenType _ |*) Array _ | FunctionType _ |
551 | (* | StructUnion _ | Enum _ | BaseType _ *) | |
552 | (* | StructUnionName _ | EnumName _ | TypeName _ *) | |
553 | (* | TypeOfExpr _ | TypeOfType _ *) | |
554 | ), _ -> raise Impossible | |
555 | ||
556 | ||
34e49164 | 557 | |
34e49164 C |
558 | in |
559 | pp_base_type | |
560 | ||
561 | ||
562 | (* used because of DeclList, in int i,*j[23]; we dont print anymore the | |
563 | int before *j *) | |
564 | and (pp_type_with_ident_rest_gen: | |
565 | pr_elem_func -> pr_space_func -> | |
485bce71 C |
566 | (string * info) option -> |
567 | fullType -> attribute list -> | |
568 | unit) = | |
34e49164 | 569 | fun pr_elem pr_space -> |
485bce71 C |
570 | |
571 | fun ident (((qu, iiqu), (ty, iity)) as fullt) attrs -> | |
572 | let print_ident ident = Common.do_option (fun (s, iis) -> | |
573 | (* XXX attrs +> pp_attributes pr_elem pr_space; *) | |
574 | pr_elem iis | |
575 | ) ident | |
34e49164 C |
576 | in |
577 | ||
578 | match ty, iity with | |
579 | (* the work is to do in base_type !! *) | |
580 | | (BaseType _, iis) -> print_ident ident | |
581 | | (Enum (sopt, enumt), iis) -> print_ident ident | |
582 | | (StructUnion (_, sopt, fields),iis) -> print_ident ident | |
583 | | (StructUnionName (s, structunion), iis) -> print_ident ident | |
584 | | (EnumName s, iis) -> print_ident ident | |
585 | | (TypeName (s,_typ), iis) -> print_ident ident | |
586 | | (TypeOfExpr (e), iis) -> print_ident ident | |
587 | | (TypeOfType (e), iis) -> print_ident ident | |
588 | ||
589 | ||
590 | ||
591 | | (Pointer t, [i]) -> | |
592 | (* subtil: void ( *done)(int i) is a Pointer | |
593 | (FunctionType (return=void, params=int i) *) | |
594 | (*WRONG I THINK, use left & right function *) | |
595 | (* bug: pp_type_with_ident_rest None t; print_ident ident *) | |
596 | pr_elem i; | |
597 | iiqu +> List.iter pr_elem; (* le const est forcement apres le '*' *) | |
485bce71 | 598 | pp_type_with_ident_rest_gen pr_elem pr_space ident t attrs; |
34e49164 C |
599 | |
600 | (* ugly special case ... todo? maybe sufficient in practice *) | |
601 | | (ParenType (q1, (Pointer (q2, (FunctionType t, ii3)) , | |
602 | [ipointer]) ), [i1;i2]) -> | |
603 | pp_type_left_gen pr_elem pr_space (q2, (FunctionType t, ii3)); | |
604 | pr_elem i1; | |
605 | pr_elem ipointer; | |
606 | print_ident ident; | |
607 | pr_elem i2; | |
608 | pp_type_right_gen pr_elem pr_space (q2, (FunctionType t, ii3)); | |
609 | ||
610 | (* another ugly special case *) | |
611 | | (ParenType | |
612 | (q1, (Array (eopt, | |
613 | (q2, (Pointer | |
614 | (q3, (FunctionType t, iifunc)), | |
615 | [ipointer]))), | |
616 | [iarray1;iarray2])), [i1;i2]) -> | |
617 | pp_type_left_gen pr_elem pr_space (q3, (FunctionType t, iifunc)); | |
618 | pr_elem i1; | |
619 | pr_elem ipointer; | |
620 | print_ident ident; | |
621 | pr_elem iarray1; | |
622 | do_option (pp_expression_gen pr_elem pr_space) eopt; | |
623 | pr_elem iarray2; | |
624 | pr_elem i2; | |
625 | pp_type_right_gen pr_elem pr_space (q3, (FunctionType t, iifunc)) | |
626 | ||
627 | ||
628 | ||
629 | | (ParenType t, [i1;i2]) -> | |
630 | pr2 "PB PARENTYPE ZARB, I forget about the ()"; | |
485bce71 | 631 | pp_type_with_ident_rest_gen pr_elem pr_space ident t attrs; |
34e49164 C |
632 | |
633 | ||
634 | | (Array (eopt, t), [i1;i2]) -> | |
635 | pp_type_left_gen pr_elem pr_space fullt; | |
636 | ||
637 | iiqu +> List.iter pr_elem; | |
638 | print_ident ident; | |
639 | ||
640 | pp_type_right_gen pr_elem pr_space fullt; | |
641 | ||
642 | ||
643 | | (FunctionType (returnt, paramst), [i1;i2]) -> | |
644 | pp_type_left_gen pr_elem pr_space fullt; | |
645 | ||
646 | iiqu +> List.iter pr_elem; | |
647 | print_ident ident; | |
648 | ||
649 | pp_type_right_gen pr_elem pr_space fullt; | |
485bce71 | 650 | |
34e49164 | 651 | |
485bce71 C |
652 | | (FunctionType _ | Array _ | ParenType _ | Pointer _ |
653 | ), _ -> raise Impossible | |
34e49164 C |
654 | |
655 | ||
656 | and (pp_type_left_gen: pr_elem_func -> pr_space_func -> fullType -> unit) = | |
657 | fun pr_elem pr_space -> | |
658 | let rec pp_type_left = fun ((qu, iiqu), (ty, iity)) -> | |
659 | match ty, iity with | |
660 | | (Pointer t, [i]) -> | |
661 | pr_elem i; | |
662 | iiqu +> List.iter pr_elem; (* le const est forcement apres le '*' *) | |
663 | pp_type_left t | |
664 | ||
665 | | (Array (eopt, t), [i1;i2]) -> pp_type_left t | |
666 | | (FunctionType (returnt, paramst), [i1;i2]) -> pp_type_left returnt | |
667 | ||
668 | | (ParenType t, _) -> failwith "parenType" | |
669 | ||
670 | ||
671 | | (BaseType _, iis) -> () | |
672 | | (Enum (sopt, enumt), iis) -> () | |
673 | | (StructUnion (_, sopt, fields),iis) -> () | |
674 | | (StructUnionName (s, structunion), iis) -> () | |
675 | | (EnumName s, iis) -> () | |
676 | | (TypeName (s,_typ), iis) -> () | |
485bce71 C |
677 | |
678 | | TypeOfType _, _ -> () | |
679 | | TypeOfExpr _, _ -> () | |
680 | ||
681 | | (FunctionType _ | Array _ | Pointer _ | |
682 | ), _ -> raise Impossible | |
34e49164 C |
683 | in |
684 | pp_type_left | |
685 | ||
686 | ||
687 | and pp_param_gen pr_elem pr_space = fun ((b, sopt, t), ii_b_s) -> | |
688 | match b, sopt, ii_b_s with | |
689 | | false, None, [] -> | |
690 | pp_type_gen pr_elem pr_space t | |
691 | | true, None, [i1] -> | |
692 | pr_elem i1; | |
693 | pp_type_gen pr_elem pr_space t | |
694 | ||
695 | | false, Some s, [i1] -> | |
485bce71 C |
696 | pp_type_with_ident_gen pr_elem pr_space |
697 | (Some (s, i1)) None t Ast_c.noattr; | |
34e49164 C |
698 | | true, Some s, [i1;i2] -> |
699 | pr_elem i1; | |
485bce71 C |
700 | pp_type_with_ident_gen pr_elem pr_space |
701 | (Some (s, i2)) None t Ast_c.noattr; | |
34e49164 C |
702 | | _ -> raise Impossible |
703 | ||
704 | ||
705 | and (pp_type_right_gen: pr_elem_func -> pr_space_func -> fullType -> unit) = | |
706 | fun pr_elem pr_space -> | |
707 | let rec pp_type_right = fun ((qu, iiqu), (ty, iity)) -> | |
708 | match ty, iity with | |
709 | | (Pointer t, [i]) -> pp_type_right t | |
710 | ||
711 | | (Array (eopt, t), [i1;i2]) -> | |
712 | pr_elem i1; | |
713 | eopt +> do_option (fun e -> pp_expression_gen pr_elem pr_space e); | |
714 | pr_elem i2; | |
715 | pp_type_right t | |
716 | ||
717 | | (ParenType t, _) -> failwith "parenType" | |
718 | | (FunctionType (returnt, paramst), [i1;i2]) -> | |
719 | pr_elem i1; | |
720 | (match paramst with | |
721 | | (ts, (b, iib)) -> | |
722 | ts +> List.iter (fun (param,iicomma) -> | |
723 | assert ((List.length iicomma) <= 1); | |
724 | iicomma +> List.iter (function x -> pr_elem x; pr_space()); | |
725 | ||
726 | pp_param_gen pr_elem pr_space param; | |
727 | ); | |
728 | iib +> List.iter pr_elem; | |
729 | ); | |
730 | pr_elem i2; | |
731 | ||
732 | ||
733 | ||
734 | ||
735 | | (BaseType _, iis) -> () | |
736 | | (Enum (sopt, enumt), iis) -> () | |
737 | | (StructUnion (_, sopt, fields),iis)-> () | |
738 | | (StructUnionName (s, structunion), iis) -> () | |
739 | | (EnumName s, iis) -> () | |
740 | | (TypeName (s,_typ), iis) -> () | |
485bce71 C |
741 | |
742 | | TypeOfType _, _ -> () | |
743 | | TypeOfExpr _, _ -> () | |
744 | ||
745 | | (FunctionType _ | Array _ | Pointer _ | |
746 | ), _ -> raise Impossible | |
747 | ||
34e49164 C |
748 | in |
749 | pp_type_right | |
750 | ||
751 | and pp_type_gen pr_elem pr_space t = | |
485bce71 C |
752 | pp_type_with_ident_gen pr_elem pr_space |
753 | None None t Ast_c.noattr | |
34e49164 C |
754 | |
755 | (* ---------------------- *) | |
756 | and pp_decl_gen pr_elem pr_space = function | |
485bce71 C |
757 | | DeclList ((({v_namei = var; v_type = returnType; |
758 | v_storage = storage; v_attr = attrs; | |
759 | },[])::xs), | |
34e49164 C |
760 | iivirg::ifakestart::iisto) -> |
761 | ||
762 | pr_elem ifakestart; | |
763 | ||
764 | (* old: iisto +> List.iter pr_elem; *) | |
765 | ||
766 | ||
767 | (* handling the first var. Special case, we print the whole type *) | |
768 | (match var with | |
769 | | Some ((s, ini), iis::iini) -> | |
770 | pp_type_with_ident_gen pr_elem pr_space | |
771 | (Some (s, iis)) (Some (storage, iisto)) | |
485bce71 | 772 | returnType attrs; |
34e49164 C |
773 | ini +> do_option (fun init -> |
774 | List.iter pr_elem iini; pp_init_gen pr_elem pr_space init); | |
775 | | None -> pp_type_gen pr_elem pr_space returnType | |
776 | | _ -> raise Impossible | |
777 | ); | |
778 | ||
779 | (* for other vars, we just call pp_type_with_ident_rest. *) | |
780 | xs +> List.iter (function | |
485bce71 C |
781 | | ({v_namei = Some ((s, ini), iis::iini); |
782 | v_type = returnType; | |
783 | v_storage = storage2; | |
784 | v_attr = attrs; | |
785 | }, iivirg) -> | |
786 | ||
34e49164 C |
787 | assert (storage2 = storage); |
788 | iivirg +> List.iter pr_elem; | |
789 | pp_type_with_ident_rest_gen pr_elem pr_space | |
485bce71 | 790 | (Some (s, iis)) returnType attrs; |
34e49164 C |
791 | ini +> do_option (fun (init) -> |
792 | List.iter pr_elem iini; pp_init_gen pr_elem pr_space init); | |
793 | ||
794 | ||
795 | | x -> raise Impossible | |
796 | ); | |
797 | ||
798 | pr_elem iivirg; | |
799 | ||
800 | | MacroDecl ((s, es), iis::lp::rp::iiend::ifakestart::iisto) -> | |
801 | pr_elem ifakestart; | |
802 | iisto +> List.iter pr_elem; (* static and const *) | |
803 | pr_elem iis; | |
804 | pr_elem lp; | |
805 | es +> List.iter (fun (e, opt) -> | |
806 | assert (List.length opt <= 1); | |
807 | opt +> List.iter pr_elem; | |
808 | pp_argument_gen pr_elem pr_space e; | |
809 | ); | |
810 | ||
811 | pr_elem rp; | |
812 | pr_elem iiend; | |
813 | ||
485bce71 | 814 | | (DeclList (_, _) | (MacroDecl _)) -> raise Impossible |
34e49164 C |
815 | |
816 | ||
817 | (* ---------------------- *) | |
818 | and pp_init_gen = fun pr_elem pr_space -> | |
819 | let pp_expression e = pp_expression_gen pr_elem pr_space e in | |
820 | let rec pp_init = fun (init, iinit) -> | |
821 | match init, iinit with | |
822 | | InitExpr e, [] -> pp_expression e; | |
823 | | InitList xs, i1::i2::iicommaopt -> | |
824 | pr_elem i1; | |
825 | xs +> List.iter (fun (x, ii) -> | |
826 | assert (List.length ii <= 1); | |
827 | ii +> List.iter pr_elem; | |
828 | pp_init x | |
829 | ); | |
830 | iicommaopt +> List.iter pr_elem; | |
831 | pr_elem i2; | |
832 | ||
833 | | InitDesignators (xs, initialiser), [i1] -> (* : *) | |
834 | xs +> List.iter (pp_designator pr_elem pr_space); | |
835 | pr_elem i1; | |
836 | pp_init initialiser | |
837 | ||
838 | (* no use of '=' in the "Old" style *) | |
839 | | InitFieldOld (string, initialiser), [i1;i2] -> (* label: in oldgcc *) | |
840 | pr_elem i1; pr_elem i2; pp_init initialiser | |
841 | | InitIndexOld (expression, initialiser), [i1;i2] -> (* [1] in oldgcc *) | |
842 | pr_elem i1; pp_expression expression; pr_elem i2; | |
843 | pp_init initialiser | |
485bce71 C |
844 | |
845 | | (InitIndexOld _ | InitFieldOld _ | InitDesignators _ | |
846 | | InitList _ | InitExpr _ | |
847 | ), _ -> raise Impossible | |
34e49164 C |
848 | in |
849 | pp_init | |
850 | ||
851 | ||
852 | ||
853 | and pp_designator pr_elem pr_space design = | |
854 | let pp_expression e = pp_expression_gen pr_elem pr_space e in | |
855 | match design with | |
856 | | DesignatorField (s), [i1; i2] -> | |
857 | pr_elem i1; pr_elem i2; | |
858 | | DesignatorIndex (expression), [i1;i2] -> | |
859 | pr_elem i1; pp_expression expression; pr_elem i2; | |
860 | ||
861 | | DesignatorRange (e1, e2), [iocro;iellipsis;iccro] -> | |
862 | pr_elem iocro; pp_expression e1; pr_elem iellipsis; | |
863 | pp_expression e2; pr_elem iccro; | |
34e49164 | 864 | |
485bce71 C |
865 | | (DesignatorField _ | DesignatorIndex _ | DesignatorRange _ |
866 | ), _ -> raise Impossible | |
867 | ||
34e49164 | 868 | |
485bce71 C |
869 | (* ---------------------- *) |
870 | and pp_attributes pr_elem pr_space attrs = | |
871 | attrs +> List.iter (fun (attr, ii) -> | |
872 | ii +> List.iter pr_elem; | |
873 | ); | |
34e49164 C |
874 | |
875 | (* ---------------------- *) | |
876 | and pp_def_gen pr_elem pr_space def = | |
485bce71 C |
877 | let defbis, ii = def in |
878 | match ii with | |
879 | | is::iifunc1::iifunc2::i1::i2::ifakestart::isto -> | |
880 | ||
881 | let {f_name = s; | |
882 | f_type = (returnt, (paramst, (b, iib))); | |
883 | f_storage = sto; | |
884 | f_body = statxs; | |
885 | f_attr = attrs; | |
886 | } = defbis | |
887 | in | |
34e49164 C |
888 | |
889 | pr_elem ifakestart; | |
890 | ||
891 | pp_type_with_ident_gen pr_elem pr_space None (Some (sto, isto)) | |
485bce71 C |
892 | returnt Ast_c.noattr; |
893 | ||
894 | pp_attributes pr_elem pr_space attrs; | |
34e49164 | 895 | pr_elem is; |
485bce71 C |
896 | |
897 | ||
34e49164 C |
898 | pr_elem iifunc1; |
899 | ||
900 | (* not anymore, cf tests/optional_name_parameter and | |
901 | macro_parameter_shortcut.c | |
902 | (match paramst with | |
903 | | [(((bool, None, t), ii_b_s), iicomma)] -> | |
904 | assert | |
905 | (match t with | |
906 | | qu, (BaseType Void, ii) -> true | |
907 | | _ -> true | |
908 | ); | |
909 | assert (null iicomma); | |
910 | assert (null ii_b_s); | |
911 | pp_type_with_ident_gen pr_elem pr_space None None t | |
912 | ||
913 | | paramst -> | |
914 | paramst +> List.iter (fun (((bool, s, t), ii_b_s), iicomma) -> | |
915 | iicomma +> List.iter pr_elem; | |
916 | ||
917 | (match b, s, ii_b_s with | |
918 | | false, Some s, [i1] -> | |
919 | pp_type_with_ident_gen | |
920 | pr_elem pr_space (Some (s, i1)) None t; | |
921 | | true, Some s, [i1;i2] -> | |
922 | pr_elem i1; | |
923 | pp_type_with_ident_gen | |
924 | pr_elem pr_space (Some (s, i2)) None t; | |
925 | ||
926 | (* in definition we have name for params, except when f(void) *) | |
927 | | _, None, _ -> raise Impossible | |
928 | | false, None, [] -> | |
929 | ||
930 | | _ -> raise Impossible | |
931 | ) | |
932 | ); | |
933 | ); | |
934 | ||
935 | (* normally ii represent the ",..." but it is also abused | |
936 | with the f(void) case *) | |
937 | (* assert (List.length iib <= 2);*) | |
938 | iib +> List.iter pr_elem; | |
939 | ||
940 | *) | |
941 | paramst +> List.iter (fun (param,iicomma) -> | |
942 | assert ((List.length iicomma) <= 1); | |
943 | iicomma +> List.iter (function x -> pr_elem x; pr_space()); | |
944 | ||
945 | pp_param_gen pr_elem pr_space param; | |
946 | ); | |
947 | iib +> List.iter pr_elem; | |
948 | ||
949 | ||
950 | pr_elem iifunc2; | |
951 | pr_elem i1; | |
485bce71 | 952 | statxs +> List.iter (pp_statement_seq_gen pr_elem pr_space); |
34e49164 C |
953 | pr_elem i2; |
954 | | _ -> raise Impossible | |
955 | ||
956 | ||
957 | ||
485bce71 C |
958 | (* ---------------------- *) |
959 | ||
960 | and pp_ifdef_gen pr_elem pr_space ifdef = | |
961 | match ifdef with | |
962 | | IfdefDirective (ifdef, ii) -> | |
963 | List.iter pr_elem ii | |
34e49164 | 964 | |
34e49164 | 965 | |
485bce71 C |
966 | and pp_directive_gen pr_elem pr_space directive = |
967 | match directive with | |
968 | | Include {i_include = (s, ii);} -> | |
969 | let (i1,i2) = Common.tuple_of_list2 ii in | |
34e49164 | 970 | pr_elem i1; pr_elem i2 |
485bce71 C |
971 | | Define ((s,ii), (defkind, defval)) -> |
972 | let (idefine,iident,ieol) = Common.tuple_of_list3 ii in | |
34e49164 C |
973 | pr_elem idefine; |
974 | pr_elem iident; | |
975 | ||
976 | let define_val = function | |
977 | | DefineExpr e -> pp_expression_gen pr_elem pr_space e | |
978 | | DefineStmt st -> pp_statement_gen pr_elem pr_space st | |
485bce71 | 979 | | DefineDoWhileZero ((st,e), ii) -> |
34e49164 | 980 | (match ii with |
485bce71 | 981 | | [ido;iwhile;iopar;icpar] -> |
34e49164 C |
982 | pr_elem ido; |
983 | pp_statement_gen pr_elem pr_space st; | |
485bce71 C |
984 | pr_elem iwhile; pr_elem iopar; |
985 | pp_expression_gen pr_elem pr_space e; | |
986 | pr_elem icpar | |
34e49164 C |
987 | | _ -> raise Impossible |
988 | ) | |
989 | | DefineFunction def -> pp_def_gen pr_elem pr_space def | |
990 | ||
991 | | DefineType ty -> pp_type_gen pr_elem pr_space ty | |
992 | | DefineText (s, ii) -> List.iter pr_elem ii | |
993 | | DefineEmpty -> () | |
485bce71 C |
994 | | DefineInit ini -> |
995 | pp_init_gen pr_elem pr_space ini | |
996 | ||
997 | | DefineTodo -> pr2 "DefineTodo" | |
34e49164 C |
998 | in |
999 | (match defkind with | |
1000 | | DefineVar -> () | |
1001 | | DefineFunc (params, ii) -> | |
1002 | let (i1,i2) = tuple_of_list2 ii in | |
1003 | pr_elem i1; | |
1004 | params +> List.iter (fun ((s,iis), iicomma) -> | |
1005 | assert (List.length iicomma <= 1); | |
1006 | iicomma +> List.iter pr_elem; | |
1007 | iis +> List.iter pr_elem; | |
1008 | ); | |
1009 | pr_elem i2; | |
1010 | ); | |
1011 | define_val defval; | |
1012 | pr_elem ieol | |
1013 | ||
485bce71 C |
1014 | | Undef (s, ii) -> |
1015 | List.iter pr_elem ii | |
1016 | | PragmaAndCo (ii) -> | |
1017 | List.iter pr_elem ii | |
1018 | ||
1019 | ||
1020 | ||
1021 | ||
1022 | let pp_program_gen pr_elem pr_space progelem = | |
1023 | match progelem with | |
1024 | | Declaration decl -> pp_decl_gen pr_elem pr_space decl | |
1025 | | Definition def -> pp_def_gen pr_elem pr_space def | |
1026 | ||
1027 | | CppTop directive -> pp_directive_gen pr_elem pr_space directive | |
1028 | ||
34e49164 C |
1029 | |
1030 | | MacroTop (s, es, [i1;i2;i3;i4]) -> | |
1031 | pr_elem i1; | |
1032 | pr_elem i2; | |
1033 | es +> List.iter (fun (e, opt) -> | |
1034 | assert (List.length opt <= 1); | |
1035 | opt +> List.iter pr_elem; | |
1036 | pp_argument_gen pr_elem pr_space e; | |
1037 | ); | |
1038 | pr_elem i3; | |
1039 | pr_elem i4; | |
1040 | ||
1041 | ||
1042 | | EmptyDef ii -> ii +> List.iter pr_elem | |
1043 | | NotParsedCorrectly ii -> | |
1044 | assert (List.length ii >= 1); | |
1045 | ii +> List.iter pr_elem | |
1046 | | FinalDef info -> pr_elem (Ast_c.rewrap_str "" info) | |
485bce71 C |
1047 | |
1048 | | IfdefTop ifdefdir -> | |
1049 | pp_ifdef_gen pr_elem pr_space ifdefdir | |
1050 | ||
1051 | | (MacroTop _) | |
1052 | -> raise Impossible | |
34e49164 | 1053 | |
485bce71 C |
1054 | |
1055 | ||
1056 | ||
1057 | let pp_flow_gen pr_elem pr_space n = | |
1058 | match F.unwrap n with | |
1059 | | F.FunHeader ({f_name =idb; | |
1060 | f_type = (rett, (paramst,(isvaargs,iidotsb))); | |
1061 | f_storage = stob; | |
1062 | f_body = body; | |
1063 | f_attr = attrs},ii) -> | |
1064 | ||
1065 | assert(null body); | |
1066 | (* | |
1067 | iif ii; | |
1068 | iif iidotsb; | |
1069 | attrs +> List.iter (vk_attribute bigf); | |
1070 | vk_type bigf rett; | |
1071 | paramst +> List.iter (fun (param, iicomma) -> | |
1072 | vk_param bigf param; | |
1073 | iif iicomma; | |
1074 | ); | |
1075 | *) | |
1076 | pr2 "Def"; | |
1077 | ||
1078 | ||
1079 | | F.Decl decl -> | |
1080 | (* vk_decl bigf decl *) | |
1081 | pr2 "Decl" | |
1082 | ||
1083 | | F.ExprStatement (st, (eopt, ii)) -> | |
1084 | pp_statement_gen pr_elem pr_space (ExprStatement eopt, ii) | |
1085 | ||
1086 | | F.IfHeader (_, (e,ii)) | |
1087 | | F.SwitchHeader (_, (e,ii)) | |
1088 | | F.WhileHeader (_, (e,ii)) | |
1089 | | F.DoWhileTail (e,ii) -> | |
1090 | (* | |
1091 | iif ii; | |
1092 | vk_expr bigf e | |
1093 | *) | |
1094 | pr2 "XXX"; | |
1095 | ||
1096 | ||
1097 | | F.ForHeader (_st, (((e1opt,i1), (e2opt,i2), (e3opt,i3)), ii)) -> | |
1098 | (* | |
1099 | iif i1; iif i2; iif i3; | |
1100 | iif ii; | |
1101 | e1opt +> do_option (vk_expr bigf); | |
1102 | e2opt +> do_option (vk_expr bigf); | |
1103 | e3opt +> do_option (vk_expr bigf); | |
1104 | *) | |
1105 | pr2 "XXX"; | |
1106 | ||
1107 | | F.MacroIterHeader (_s, ((s,es), ii)) -> | |
1108 | (* | |
1109 | iif ii; | |
1110 | vk_argument_list bigf es; | |
1111 | *) | |
1112 | pr2 "XXX"; | |
1113 | ||
1114 | ||
1115 | | F.ReturnExpr (_st, (e,ii)) -> | |
1116 | (* iif ii; vk_expr bigf e*) | |
1117 | pr2 "XXX"; | |
1118 | ||
1119 | ||
1120 | | F.Case (_st, (e,ii)) -> | |
1121 | (* iif ii; vk_expr bigf e *) | |
1122 | pr2 "XXX"; | |
1123 | ||
1124 | | F.CaseRange (_st, ((e1, e2),ii)) -> | |
1125 | (* iif ii; vk_expr bigf e1; vk_expr bigf e2 *) | |
1126 | pr2 "XXX"; | |
1127 | ||
1128 | ||
1129 | ||
1130 | | F.CaseNode i -> () | |
1131 | ||
1132 | | F.DefineExpr e -> | |
1133 | (* vk_expr bigf e *) | |
1134 | pr2 "XXX"; | |
1135 | ||
1136 | | F.DefineType ft -> | |
1137 | (* vk_type bigf ft *) | |
1138 | pr2 "XXX"; | |
1139 | ||
1140 | | F.DefineHeader ((s,ii), (defkind)) -> | |
1141 | (* | |
1142 | iif ii; | |
1143 | vk_define_kind bigf defkind; | |
1144 | *) | |
1145 | pr2 "XXX"; | |
1146 | ||
1147 | ||
1148 | | F.DefineDoWhileZeroHeader (((),ii)) -> | |
1149 | (* iif ii *) | |
1150 | pr2 "XXX"; | |
1151 | ||
1152 | ||
1153 | | F.Include {i_include = (s, ii);} -> | |
1154 | (* iif ii; *) | |
1155 | pr2 "XXX"; | |
1156 | ||
1157 | ||
1158 | | F.MacroTop (s, args, ii) -> | |
1159 | (* iif ii; | |
1160 | vk_argument_list bigf args *) | |
1161 | pr2 "XXX"; | |
1162 | ||
1163 | ||
1164 | | F.Break (st,((),ii)) -> | |
1165 | (* iif ii *) | |
1166 | pr2 "XXX"; | |
1167 | | F.Continue (st,((),ii)) -> | |
1168 | (* iif ii *) | |
1169 | pr2 "XXX"; | |
1170 | | F.Default (st,((),ii)) -> | |
1171 | (* iif ii *) | |
1172 | pr2 "XXX"; | |
1173 | | F.Return (st,((),ii)) -> | |
1174 | (* iif ii *) | |
1175 | pr2 "XXX"; | |
1176 | | F.Goto (st, (s,ii)) -> | |
1177 | (* iif ii *) | |
1178 | pr2 "XXX"; | |
1179 | | F.Label (st, (s,ii)) -> | |
1180 | (* iif ii *) | |
1181 | pr2 "XXX"; | |
1182 | | F.EndStatement iopt -> | |
1183 | (* do_option infof iopt *) | |
1184 | pr2 "XXX"; | |
1185 | | F.DoHeader (st, info) -> | |
1186 | (* infof info *) | |
1187 | pr2 "XXX"; | |
1188 | | F.Else info -> | |
1189 | (* infof info *) | |
1190 | pr2 "XXX"; | |
1191 | | F.SeqEnd (i, info) -> | |
1192 | (* infof info *) | |
1193 | pr2 "XXX"; | |
1194 | | F.SeqStart (st, i, info) -> | |
1195 | (* infof info *) | |
1196 | pr2 "XXX"; | |
1197 | ||
1198 | | F.MacroStmt (st, ((),ii)) -> | |
1199 | (* iif ii *) | |
1200 | pr2 "XXX"; | |
1201 | | F.Asm (st, (asmbody,ii)) -> | |
1202 | (* | |
1203 | iif ii; | |
1204 | vk_asmbody bigf asmbody | |
1205 | *) | |
1206 | pr2 "XXX"; | |
1207 | ||
1208 | ||
1209 | | F.IfdefHeader (info) -> | |
1210 | pp_ifdef_gen pr_elem pr_space info | |
1211 | | F.IfdefElse (info) -> | |
1212 | pp_ifdef_gen pr_elem pr_space info | |
1213 | | F.IfdefEndif (info) -> | |
1214 | pp_ifdef_gen pr_elem pr_space info | |
1215 | ||
1216 | ||
1217 | | ( | |
1218 | F.TopNode|F.EndNode| | |
1219 | F.ErrorExit|F.Exit|F.Enter| | |
1220 | F.FallThroughNode|F.AfterNode|F.FalseNode|F.TrueNode|F.InLoopNode| | |
1221 | F.Fake | |
1222 | ) -> | |
1223 | pr2 "YYY" | |
1224 | ||
1225 | ||
1226 | ||
1227 | ||
1228 | ||
34e49164 C |
1229 | |
1230 | ||
1231 | ||
1232 | (*****************************************************************************) | |
1233 | ||
1234 | (* Here we do not use (mcode, env). It is a simple C pretty printer. *) | |
1235 | let pr_elem info = | |
1236 | let s = Ast_c.str_of_info info in | |
1237 | pp s | |
1238 | ||
1239 | let pr_space _ = Format.print_space() | |
1240 | ||
1241 | let pp_expression_simple = pp_expression_gen pr_elem pr_space | |
1242 | let pp_statement_simple = pp_statement_gen pr_elem pr_space | |
1243 | let pp_type_simple = pp_type_gen pr_elem pr_space | |
485bce71 C |
1244 | let pp_toplevel_simple = pp_program_gen pr_elem pr_space |
1245 | let pp_flow_simple = pp_flow_gen pr_elem pr_space | |
1246 |