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