Release coccinelle-0.1.4
[bpt/coccinelle.git] / parsing_c / visitor_c.ml
CommitLineData
faf9a90c 1(* Copyright (C) 2006, 2007, 2008 Ecole des Mines de Nantes
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 *)
12open Common
13
14
15open Ast_c
16module F = Control_flow_c
17
91eba41f
C
18(*****************************************************************************)
19(* Prelude *)
20(*****************************************************************************)
21
22(* todo? dont go in Include. Have a visitor flag ? disable_go_include ?
23 * disable_go_type_annotation ?
24 *)
25
34e49164
C
26(*****************************************************************************)
27(* Functions to visit the Ast, and now also the CFG nodes *)
28(*****************************************************************************)
29
30
31(* Visitor based on continuation. Cleaner than the one based on mutable
485bce71
C
32 * pointer functions that I had before.
33 * src: based on a (vague) idea from Remy Douence.
34e49164
C
34 *
35 *
36 *
37 * Diff with Julia's visitor ? She does:
38 *
39 * let ident r k i =
40 * ...
41 * let expression r k e =
42 * ...
43 * ... (List.map r.V0.combiner_expression expr_list) ...
44 * ...
45 * let res = V0.combiner bind option_default
46 * mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
47 * donothing donothing donothing donothing
48 * ident expression typeC donothing parameter declaration statement
49 * donothing in
50 * ...
51 * collect_unitary_nonunitary
52 * (List.concat (List.map res.V0.combiner_top_level t))
53 *
54 *
55 *
56 * So she has to remember at which position you must put the 'expression'
57 * function. I use record which is easier.
58 *
59 * When she calls recursively, her res.V0.combiner_xxx does not take bigf
60 * in param whereas I do
61 * | F.Decl decl -> Visitor_c.vk_decl bigf decl
62 * And with the record she gets, she does not have to do my
63 * multiple defs of function such as 'let al_type = V0.vk_type_s bigf'
64 *
65 * The code of visitor.ml is cleaner with julia because mutual recursive calls
66 * are clean such as ... 'expression e' ... and not 'f (k, bigf) e'
67 * or 'vk_expr bigf e'.
68 *
69 * So it is very dual:
70 * - I give a record but then I must handle bigf.
71 * - She gets a record, and gives a list of function
72 *
73 *)
74
75
76(* old: first version (only visiting expr)
77
78let (iter_expr:((expression -> unit) -> expression -> unit) -> expression -> unit)
79 = fun f expr ->
80 let rec k e =
81 match e with
82 | Constant c -> ()
83 | FunCall (e, es) -> f k e; List.iter (f k) es
84 | CondExpr (e1, e2, e3) -> f k e1; f k e2; f k e3
85 | Sequence (e1, e2) -> f k e1; f k e2;
86 | Assignment (e1, op, e2) -> f k e1; f k e2;
87
88 | Postfix (e, op) -> f k e
89 | Infix (e, op) -> f k e
90 | Unary (e, op) -> f k e
91 | Binary (e1, op, e2) -> f k e1; f k e2;
92
93 | ArrayAccess (e1, e2) -> f k e1; f k e2;
94 | RecordAccess (e, s) -> f k e
95 | RecordPtAccess (e, s) -> f k e
96
97 | SizeOfExpr e -> f k e
98 | SizeOfType t -> ()
99 | _ -> failwith "to complete"
100
101 in f k expr
102
103let ex1 = Sequence (Sequence (Constant (Ident "1"), Constant (Ident "2")),
104 Constant (Ident "4"))
105let test =
106 iter_expr (fun k e -> match e with
107 | Constant (Ident x) -> Common.pr2 x
108 | rest -> k rest
109 ) ex1
110==>
1111
1122
1134
114
115*)
116
117(*****************************************************************************)
118(* Side effect style visitor *)
119(*****************************************************************************)
120
121(* Visitors for all langage concept, not just for expression.
122 *
123 * Note that I don't visit necesserally in the order of the token
124 * found in the original file. So don't assume such hypothesis!
485bce71
C
125 *
126 * todo? parameter ? onedecl ?
34e49164
C
127 *)
128type visitor_c =
129 {
130 kexpr: (expression -> unit) * visitor_c -> expression -> unit;
131 kstatement: (statement -> unit) * visitor_c -> statement -> unit;
132 ktype: (fullType -> unit) * visitor_c -> fullType -> unit;
133
134 kdecl: (declaration -> unit) * visitor_c -> declaration -> unit;
135 kdef: (definition -> unit) * visitor_c -> definition -> unit;
136 kini: (initialiser -> unit) * visitor_c -> initialiser -> unit;
137
485bce71
C
138 kcppdirective: (cpp_directive -> unit) * visitor_c -> cpp_directive -> unit;
139 kdefineval : (define_val -> unit) * visitor_c -> define_val -> unit;
140 kstatementseq: (statement_sequencable -> unit) * visitor_c -> statement_sequencable -> unit;
34e49164
C
141
142 (* CFG *)
143 knode: (F.node -> unit) * visitor_c -> F.node -> unit;
144 (* AST *)
145 ktoplevel: (toplevel -> unit) * visitor_c -> toplevel -> unit;
485bce71
C
146
147 kinfo: (info -> unit) * visitor_c -> info -> unit;
34e49164
C
148 }
149
150let default_visitor_c =
151 { kexpr = (fun (k,_) e -> k e);
152 kstatement = (fun (k,_) st -> k st);
153 ktype = (fun (k,_) t -> k t);
154 kdecl = (fun (k,_) d -> k d);
155 kdef = (fun (k,_) d -> k d);
156 kini = (fun (k,_) ie -> k ie);
157 kinfo = (fun (k,_) ii -> k ii);
158 knode = (fun (k,_) n -> k n);
159 ktoplevel = (fun (k,_) p -> k p);
485bce71
C
160 kcppdirective = (fun (k,_) p -> k p);
161 kdefineval = (fun (k,_) p -> k p);
162 kstatementseq = (fun (k,_) p -> k p);
34e49164
C
163 }
164
485bce71
C
165
166(* ------------------------------------------------------------------------ *)
167
168
34e49164
C
169let rec vk_expr = fun bigf expr ->
170 let iif ii = vk_ii bigf ii in
171
172 let rec exprf e = bigf.kexpr (k,bigf) e
91eba41f 173 (* !!! dont go in _typ !!! *)
34e49164
C
174 and k ((e,_typ), ii) =
175 iif ii;
176 match e with
177 | Ident (s) -> ()
178 | Constant (c) -> ()
179 | FunCall (e, es) ->
180 exprf e;
485bce71 181 vk_argument_list bigf es;
34e49164
C
182 | CondExpr (e1, e2, e3) ->
183 exprf e1; do_option (exprf) e2; exprf e3
184 | Sequence (e1, e2) -> exprf e1; exprf e2;
185 | Assignment (e1, op, e2) -> exprf e1; exprf e2;
186
187 | Postfix (e, op) -> exprf e
188 | Infix (e, op) -> exprf e
189 | Unary (e, op) -> exprf e
190 | Binary (e1, op, e2) -> exprf e1; exprf e2;
191
192 | ArrayAccess (e1, e2) -> exprf e1; exprf e2;
193 | RecordAccess (e, s) -> exprf e
194 | RecordPtAccess (e, s) -> exprf e
195
196 | SizeOfExpr (e) -> exprf e
197 | SizeOfType (t) -> vk_type bigf t
198 | Cast (t, e) -> vk_type bigf t; exprf e
199
200 (* old: | StatementExpr (((declxs, statxs), is)), is2 ->
201 * List.iter (vk_decl bigf) declxs;
202 * List.iter (vk_statement bigf) statxs
203 *)
204 | StatementExpr ((statxs, is)) ->
205 iif is;
485bce71 206 statxs +> List.iter (vk_statement_sequencable bigf);
34e49164
C
207
208 (* TODO, we will certainly have to then do a special visitor for
209 * initializer
210 *)
211 | Constructor (t, initxs) ->
212 vk_type bigf t;
213 initxs +> List.iter (fun (ini, ii) ->
214 vk_ini bigf ini;
215 vk_ii bigf ii;
216 )
217
218 | ParenExpr (e) -> exprf e
219
220
221 in exprf expr
222
34e49164
C
223
224
225
226
485bce71 227and vk_statement = fun bigf (st: Ast_c.statement) ->
34e49164
C
228 let iif ii = vk_ii bigf ii in
229
230 let rec statf x = bigf.kstatement (k,bigf) x
231 and k st =
232 let (unwrap_st, ii) = st in
233 iif ii;
234 match unwrap_st with
235 | Labeled (Label (s, st)) -> statf st;
236 | Labeled (Case (e, st)) -> vk_expr bigf e; statf st;
237 | Labeled (CaseRange (e, e2, st)) ->
238 vk_expr bigf e; vk_expr bigf e2; statf st;
239 | Labeled (Default st) -> statf st;
240
485bce71
C
241 | Compound statxs ->
242 statxs +> List.iter (vk_statement_sequencable bigf)
34e49164
C
243 | ExprStatement (eopt) -> do_option (vk_expr bigf) eopt;
244
245 | Selection (If (e, st1, st2)) ->
246 vk_expr bigf e; statf st1; statf st2;
34e49164
C
247 | Selection (Switch (e, st)) ->
248 vk_expr bigf e; statf st;
249 | Iteration (While (e, st)) ->
250 vk_expr bigf e; statf st;
251 | Iteration (DoWhile (st, e)) -> statf st; vk_expr bigf e;
252 | Iteration (For ((e1opt,i1), (e2opt,i2), (e3opt,i3), st)) ->
253 statf (ExprStatement (e1opt),i1);
254 statf (ExprStatement (e2opt),i2);
255 statf (ExprStatement (e3opt),i3);
256 statf st;
257
258 | Iteration (MacroIteration (s, es, st)) ->
485bce71 259 vk_argument_list bigf es;
34e49164
C
260 statf st;
261
262 | Jump (Goto s) -> ()
263 | Jump ((Continue|Break|Return)) -> ()
264 | Jump (ReturnExpr e) -> vk_expr bigf e;
265 | Jump (GotoComputed e) -> vk_expr bigf e;
266
267 | Decl decl -> vk_decl bigf decl
268 | Asm asmbody -> vk_asmbody bigf asmbody
269 | NestedFunc def -> vk_def bigf def
270 | MacroStmt -> ()
271
272 in statf st
273
485bce71
C
274and vk_statement_sequencable = fun bigf stseq ->
275 let f = bigf.kstatementseq in
276
277 let rec k stseq =
278 match stseq with
279 | StmtElem st -> vk_statement bigf st
280 | CppDirectiveStmt directive ->
281 vk_cpp_directive bigf directive
282 | IfdefStmt ifdef ->
283 vk_ifdef_directive bigf ifdef
284 | IfdefStmt2 (ifdef, xxs) ->
285 ifdef +> List.iter (vk_ifdef_directive bigf);
286 xxs +> List.iter (fun xs ->
287 xs +> List.iter (vk_statement_sequencable bigf)
288 )
289
290 in f (k, bigf) stseq
291
34e49164 292
34e49164
C
293
294and vk_type = fun bigf t ->
295 let iif ii = vk_ii bigf ii in
296
297 let rec typef x = bigf.ktype (k, bigf) x
298 and k t =
299 let (q, t) = t in
300 let (unwrap_q, iiq) = q in
301 let (unwrap_t, iit) = t in
302 iif iiq;
303 iif iit;
304 match unwrap_t with
305 | BaseType _ -> ()
306 | Pointer t -> typef t
307 | Array (eopt, t) ->
308 do_option (vk_expr bigf) eopt;
309 typef t
310 | FunctionType (returnt, paramst) ->
311 typef returnt;
312 (match paramst with
313 | (ts, (b,iihas3dots)) ->
314 iif iihas3dots;
485bce71 315 vk_param_list bigf ts
34e49164
C
316 )
317
318 | Enum (sopt, enumt) ->
319 enumt +> List.iter (fun (((s, eopt),ii_s_eq), iicomma) ->
320 iif ii_s_eq; iif iicomma;
321 eopt +> do_option (vk_expr bigf)
322 );
323
324 | StructUnion (sopt, _su, fields) ->
325 vk_struct_fields bigf fields
326
327 | StructUnionName (s, structunion) -> ()
328 | EnumName s -> ()
329
330 (* dont go in _typ *)
331 | TypeName (s, _typ) -> ()
332
333 | ParenType t -> typef t
334 | TypeOfExpr e -> vk_expr bigf e
335 | TypeOfType t -> typef t
336
337 in typef t
338
485bce71
C
339
340and vk_attribute = fun bigf attr ->
341 let iif ii = vk_ii bigf ii in
342 match attr with
343 | Attribute s, ii ->
344 iif ii
345
346
347(* ------------------------------------------------------------------------ *)
348
34e49164
C
349and vk_decl = fun bigf d ->
350 let iif ii = vk_ii bigf ii in
351
352 let f = bigf.kdecl in
353 let rec k decl =
354 match decl with
91eba41f
C
355 | DeclList (xs,ii) -> xs +> List.iter (fun (x,ii) ->
356 iif ii;
357 vk_onedecl bigf x;
358 );
34e49164
C
359 | MacroDecl ((s, args),ii) ->
360 iif ii;
485bce71 361 vk_argument_list bigf args;
91eba41f
C
362 in f (k, bigf) d
363
364
365and vk_onedecl = fun bigf onedecl ->
366 let iif ii = vk_ii bigf ii in
367 match onedecl with
368 | ({v_namei = var; v_type = t;
369 v_storage = _sto; v_attr = attrs}) ->
34e49164 370
34e49164 371 vk_type bigf t;
485bce71 372 attrs +> List.iter (vk_attribute bigf);
34e49164
C
373 var +> do_option (fun ((s, ini), ii_s_ini) ->
374 iif ii_s_ini;
375 ini +> do_option (vk_ini bigf)
376 );
34e49164
C
377
378and vk_ini = fun bigf ini ->
379 let iif ii = vk_ii bigf ii in
380
381 let rec inif x = bigf.kini (k, bigf) x
382 and k (ini, iini) =
383 iif iini;
384 match ini with
385 | InitExpr e -> vk_expr bigf e
386 | InitList initxs ->
387 initxs +> List.iter (fun (ini, ii) ->
388 inif ini;
389 iif ii;
390 )
391 | InitDesignators (xs, e) ->
392 xs +> List.iter (vk_designator bigf);
393 inif e
394
395 | InitFieldOld (s, e) -> inif e
396 | InitIndexOld (e1, e) ->
397 vk_expr bigf e1; inif e
398
485bce71 399
34e49164
C
400 in inif ini
401
402
403and vk_designator = fun bigf design ->
404 let iif ii = vk_ii bigf ii in
405 let (designator, ii) = design in
406 iif ii;
407 match designator with
408 | DesignatorField s -> ()
409 | DesignatorIndex e -> vk_expr bigf e
410 | DesignatorRange (e1, e2) -> vk_expr bigf e1; vk_expr bigf e2
411
485bce71
C
412
413(* ------------------------------------------------------------------------ *)
414
34e49164
C
415and vk_struct_fields = fun bigf fields ->
416 let iif ii = vk_ii bigf ii in
417
418 fields +> List.iter (fun (xfield, ii) ->
419 iif ii;
420 match xfield with
485bce71
C
421 | DeclarationField
422 (FieldDeclList (onefield_multivars, iiptvirg)) ->
423 vk_struct_fieldkinds bigf onefield_multivars;
424 iif iiptvirg;
34e49164 425 | EmptyField -> ()
485bce71 426 | MacroStructDeclTodo ->
91eba41f 427 pr2_once "MacroStructDeclTodo";
485bce71
C
428 ()
429
430 | CppDirectiveStruct directive ->
431 vk_cpp_directive bigf directive
432 | IfdefStruct ifdef ->
433 vk_ifdef_directive bigf ifdef
434
34e49164
C
435 )
436
485bce71 437and vk_struct_fieldkinds = fun bigf onefield_multivars ->
34e49164
C
438 let iif ii = vk_ii bigf ii in
439 onefield_multivars +> List.iter (fun (field, iicomma) ->
440 iif iicomma;
441 match field with
442 | Simple (s, t), ii -> iif ii; vk_type bigf t;
443 | BitField (sopt, t, expr), ii ->
444 iif ii;
445 vk_expr bigf expr;
446 vk_type bigf t
447 )
448
485bce71 449(* ------------------------------------------------------------------------ *)
34e49164
C
450
451
452and vk_def = fun bigf d ->
453 let iif ii = vk_ii bigf ii in
454
455 let f = bigf.kdef in
456 let rec k d =
457 match d with
485bce71
C
458 | {f_name = s;
459 f_type = (returnt, (paramst, (b, iib)));
460 f_storage = sto;
461 f_body = statxs;
462 f_attr = attrs;
91eba41f 463 f_old_c_style = oldstyle;
485bce71
C
464 }, ii
465 ->
34e49164
C
466 iif ii;
467 iif iib;
485bce71 468 attrs +> List.iter (vk_attribute bigf);
34e49164
C
469 vk_type bigf returnt;
470 paramst +> List.iter (fun (param,iicomma) ->
471 vk_param bigf param;
472 iif iicomma;
473 );
91eba41f
C
474 oldstyle +> Common.do_option (fun decls ->
475 decls +> List.iter (vk_decl bigf);
476 );
477
485bce71 478 statxs +> List.iter (vk_statement_sequencable bigf)
34e49164
C
479 in f (k, bigf) d
480
481
482
483
484and vk_toplevel = fun bigf p ->
485 let f = bigf.ktoplevel in
486 let iif ii = vk_ii bigf ii in
487 let rec k p =
488 match p with
489 | Declaration decl -> (vk_decl bigf decl)
490 | Definition def -> (vk_def bigf def)
491 | EmptyDef ii -> iif ii
492 | MacroTop (s, xs, ii) ->
485bce71
C
493 vk_argument_list bigf xs;
494 iif ii
495
496 | CppTop top -> vk_cpp_directive bigf top
497 | IfdefTop ifdefdir -> vk_ifdef_directive bigf ifdefdir
34e49164 498
485bce71
C
499 | NotParsedCorrectly ii -> iif ii
500 | FinalDef info -> vk_info bigf info
501 in f (k, bigf) p
502
503and vk_program = fun bigf xs ->
504 xs +> List.iter (vk_toplevel bigf)
505
506and vk_ifdef_directive bigf directive =
507 let iif ii = vk_ii bigf ii in
508 match directive with
509 | IfdefDirective (ifkind, ii) -> iif ii
510
511
512and vk_cpp_directive bigf directive =
513 let iif ii = vk_ii bigf ii in
514 let f = bigf.kcppdirective in
515 let rec k directive =
516 match directive with
517 | Include {i_include = (s, ii);
518 i_content = copt;
519 }
520 ->
91eba41f
C
521 (* go inside ? yes, can be useful, for instance for type_annotater.
522 * The only pb may be that when we want to unparse the code we
523 * don't want to unparse the included file but the unparser
524 * and pretty_print do not use visitor_c so no problem.
525 *)
485bce71
C
526 iif ii;
527 copt +> Common.do_option (fun (file, asts) ->
528 vk_program bigf asts
529 );
34e49164
C
530 | Define ((s,ii), (defkind, defval)) ->
531 iif ii;
532 vk_define_kind bigf defkind;
533 vk_define_val bigf defval
485bce71
C
534 | Undef (s, ii) ->
535 iif ii
536 | PragmaAndCo (ii) ->
537 iif ii
538 in f (k, bigf) directive
34e49164 539
34e49164
C
540
541and vk_define_kind bigf defkind =
542 match defkind with
543 | DefineVar -> ()
544 | DefineFunc (params, ii) ->
545 vk_ii bigf ii;
546 params +> List.iter (fun ((s,iis), iicomma) ->
547 vk_ii bigf iis;
548 vk_ii bigf iicomma;
549 )
550
551and vk_define_val bigf defval =
485bce71
C
552 let f = bigf.kdefineval in
553
554 let rec k defval =
34e49164
C
555 match defval with
556 | DefineExpr e ->
557 vk_expr bigf e
558 | DefineStmt stmt -> vk_statement bigf stmt
485bce71 559 | DefineDoWhileZero ((stmt, e), ii) ->
34e49164 560 vk_statement bigf stmt;
485bce71 561 vk_expr bigf e;
34e49164
C
562 vk_ii bigf ii
563 | DefineFunction def -> vk_def bigf def
564 | DefineType ty -> vk_type bigf ty
565 | DefineText (s, ii) -> vk_ii bigf ii
566 | DefineEmpty -> ()
485bce71
C
567 | DefineInit ini -> vk_ini bigf ini
568
569 | DefineTodo ->
91eba41f 570 pr2_once "DefineTodo";
485bce71
C
571 ()
572 in f (k, bigf) defval
573
34e49164
C
574
575
576
577(* ------------------------------------------------------------------------ *)
578(* Now keep fullstatement inside the control flow node,
579 * so that can then get in a MetaStmtVar the fullstatement to later
580 * pp back when the S is in a +. But that means that
581 * Exp will match an Ifnode even if there is no such exp
582 * inside the condition of the Ifnode (because the exp may
583 * be deeper, in the then branch). So have to not visit
584 * all inside a node anymore.
585 *
485bce71 586 * update: j'ai choisi d'accrocher au noeud du CFG a la
34e49164
C
587 * fois le fullstatement et le partialstatement et appeler le
588 * visiteur que sur le partialstatement.
589 *)
590
591and vk_node = fun bigf node ->
592 let iif ii = vk_ii bigf ii in
593 let infof info = vk_info bigf info in
594
595 let f = bigf.knode in
596 let rec k n =
597 match F.unwrap n with
598
91eba41f
C
599 | F.FunHeader (def) ->
600 assert(null (fst def).f_body);
601 vk_def bigf def;
34e49164
C
602
603 | F.Decl decl -> vk_decl bigf decl
604 | F.ExprStatement (st, (eopt, ii)) ->
605 iif ii;
606 eopt +> do_option (vk_expr bigf)
607
608 | F.IfHeader (_, (e,ii))
609 | F.SwitchHeader (_, (e,ii))
610 | F.WhileHeader (_, (e,ii))
611 | F.DoWhileTail (e,ii) ->
612 iif ii;
613 vk_expr bigf e
614
615 | F.ForHeader (_st, (((e1opt,i1), (e2opt,i2), (e3opt,i3)), ii)) ->
616 iif i1; iif i2; iif i3;
617 iif ii;
618 e1opt +> do_option (vk_expr bigf);
619 e2opt +> do_option (vk_expr bigf);
620 e3opt +> do_option (vk_expr bigf);
621 | F.MacroIterHeader (_s, ((s,es), ii)) ->
622 iif ii;
485bce71 623 vk_argument_list bigf es;
34e49164
C
624
625 | F.ReturnExpr (_st, (e,ii)) -> iif ii; vk_expr bigf e
626
627 | F.Case (_st, (e,ii)) -> iif ii; vk_expr bigf e
628 | F.CaseRange (_st, ((e1, e2),ii)) ->
629 iif ii; vk_expr bigf e1; vk_expr bigf e2
630
631
632 | F.CaseNode i -> ()
633
634 | F.DefineExpr e -> vk_expr bigf e
635 | F.DefineType ft -> vk_type bigf ft
636 | F.DefineHeader ((s,ii), (defkind)) ->
637 iif ii;
638 vk_define_kind bigf defkind;
639
640 | F.DefineDoWhileZeroHeader (((),ii)) -> iif ii
485bce71 641 | F.DefineTodo ->
91eba41f 642 pr2_once "DefineTodo";
485bce71
C
643 ()
644
34e49164 645
485bce71 646 | F.Include {i_include = (s, ii);} -> iif ii;
34e49164
C
647
648 | F.MacroTop (s, args, ii) ->
649 iif ii;
485bce71 650 vk_argument_list bigf args
34e49164 651
485bce71
C
652 | F.IfdefHeader (info) -> vk_ifdef_directive bigf info
653 | F.IfdefElse (info) -> vk_ifdef_directive bigf info
654 | F.IfdefEndif (info) -> vk_ifdef_directive bigf info
34e49164
C
655
656 | F.Break (st,((),ii)) -> iif ii
657 | F.Continue (st,((),ii)) -> iif ii
658 | F.Default (st,((),ii)) -> iif ii
659 | F.Return (st,((),ii)) -> iif ii
660 | F.Goto (st, (s,ii)) -> iif ii
661 | F.Label (st, (s,ii)) -> iif ii
485bce71 662
34e49164 663 | F.DoHeader (st, info) -> infof info
485bce71 664
34e49164 665 | F.Else info -> infof info
485bce71
C
666 | F.EndStatement iopt -> do_option infof iopt
667
34e49164
C
668 | F.SeqEnd (i, info) -> infof info
669 | F.SeqStart (st, i, info) -> infof info
670
671 | F.MacroStmt (st, ((),ii)) -> iif ii
672 | F.Asm (st, (asmbody,ii)) ->
673 iif ii;
674 vk_asmbody bigf asmbody
675
676 | (
677 F.TopNode|F.EndNode|
678 F.ErrorExit|F.Exit|F.Enter|
679 F.FallThroughNode|F.AfterNode|F.FalseNode|F.TrueNode|F.InLoopNode|
680 F.Fake
681 ) -> ()
682
683
684
685 in
686 f (k, bigf) node
687
688(* ------------------------------------------------------------------------ *)
689and vk_info = fun bigf info ->
690 let rec infof ii = bigf.kinfo (k, bigf) ii
691 and k i = ()
692 in
693 infof info
694
695and vk_ii = fun bigf ii ->
696 List.iter (vk_info bigf) ii
697
698
485bce71
C
699(* ------------------------------------------------------------------------ *)
700and vk_argument = fun bigf arg ->
701 let rec do_action = function
702 | (ActMisc ii) -> vk_ii bigf ii
703 in
704 match arg with
705 | Left e -> (vk_expr bigf) e
706 | Right (ArgType param) -> vk_param bigf param
707 | Right (ArgAction action) -> do_action action
708
709and vk_argument_list = fun bigf es ->
710 let iif ii = vk_ii bigf ii in
711 es +> List.iter (fun (e, ii) ->
712 iif ii;
713 vk_argument bigf e
714 )
715
716
717
34e49164
C
718and vk_param = fun bigf (((b, s, t), ii_b_s)) ->
719 let iif ii = vk_ii bigf ii in
720 iif ii_b_s;
721 vk_type bigf t
722
485bce71
C
723and vk_param_list = fun bigf ts ->
724 let iif ii = vk_ii bigf ii in
725 ts +> List.iter (fun (param,iicomma) ->
726 vk_param bigf param;
727 iif iicomma;
728 )
729
730
731
732(* ------------------------------------------------------------------------ *)
733and vk_asmbody = fun bigf (string_list, colon_list) ->
734 let iif ii = vk_ii bigf ii in
735
736 iif string_list;
737 colon_list +> List.iter (fun (Colon xs, ii) ->
738 iif ii;
739 xs +> List.iter (fun (x,iicomma) ->
740 iif iicomma;
741 (match x with
742 | ColonMisc, ii -> iif ii
743 | ColonExpr e, ii ->
744 vk_expr bigf e;
745 iif ii
746 )
747 ))
748
34e49164 749
485bce71 750(* ------------------------------------------------------------------------ *)
34e49164
C
751let vk_args_splitted = fun bigf args_splitted ->
752 let iif ii = vk_ii bigf ii in
753 args_splitted +> List.iter (function
754 | Left arg -> vk_argument bigf arg
755 | Right ii -> iif ii
756 )
757
758
759let vk_define_params_splitted = fun bigf args_splitted ->
760 let iif ii = vk_ii bigf ii in
761 args_splitted +> List.iter (function
762 | Left (s, iis) -> vk_ii bigf iis
763 | Right ii -> iif ii
764 )
765
766
767
768let vk_params_splitted = fun bigf args_splitted ->
769 let iif ii = vk_ii bigf ii in
770 args_splitted +> List.iter (function
771 | Left arg -> vk_param bigf arg
772 | Right ii -> iif ii
773 )
774
485bce71 775(* ------------------------------------------------------------------------ *)
34e49164
C
776let vk_cst = fun bigf (cst, ii) ->
777 let iif ii = vk_ii bigf ii in
778 iif ii;
779 (match cst with
780 | Left cst -> ()
781 | Right s -> ()
782 )
783
784
785
786
787(*****************************************************************************)
788(* "syntetisized attributes" style *)
789(*****************************************************************************)
485bce71
C
790
791(* TODO port the xxs_s to new cpp construct too *)
792
34e49164
C
793type 'a inout = 'a -> 'a
794
795(* _s for synthetizized attributes
796 *
797 * Note that I don't visit necesserally in the order of the token
798 * found in the original file. So don't assume such hypothesis!
799 *)
800type visitor_c_s = {
801 kexpr_s: (expression inout * visitor_c_s) -> expression inout;
802 kstatement_s: (statement inout * visitor_c_s) -> statement inout;
803 ktype_s: (fullType inout * visitor_c_s) -> fullType inout;
34e49164
C
804
805 kdecl_s: (declaration inout * visitor_c_s) -> declaration inout;
806 kdef_s: (definition inout * visitor_c_s) -> definition inout;
807
485bce71 808 kini_s: (initialiser inout * visitor_c_s) -> initialiser inout;
34e49164 809
485bce71 810 kcppdirective_s: (cpp_directive inout * visitor_c_s) -> cpp_directive inout;
34e49164 811 kdefineval_s: (define_val inout * visitor_c_s) -> define_val inout;
485bce71
C
812 kstatementseq_s: (statement_sequencable inout * visitor_c_s) -> statement_sequencable inout;
813 kstatementseq_list_s: (statement_sequencable list inout * visitor_c_s) -> statement_sequencable list inout;
814
815 knode_s: (F.node inout * visitor_c_s) -> F.node inout;
34e49164 816
485bce71
C
817
818 ktoplevel_s: (toplevel inout * visitor_c_s) -> toplevel inout;
34e49164
C
819 kinfo_s: (info inout * visitor_c_s) -> info inout;
820 }
821
822let default_visitor_c_s =
823 { kexpr_s = (fun (k,_) e -> k e);
824 kstatement_s = (fun (k,_) st -> k st);
825 ktype_s = (fun (k,_) t -> k t);
826 kdecl_s = (fun (k,_) d -> k d);
827 kdef_s = (fun (k,_) d -> k d);
828 kini_s = (fun (k,_) d -> k d);
829 ktoplevel_s = (fun (k,_) p -> k p);
830 knode_s = (fun (k,_) n -> k n);
831 kinfo_s = (fun (k,_) i -> k i);
832 kdefineval_s = (fun (k,_) x -> k x);
485bce71
C
833 kstatementseq_s = (fun (k,_) x -> k x);
834 kstatementseq_list_s = (fun (k,_) x -> k x);
835 kcppdirective_s = (fun (k,_) x -> k x);
34e49164
C
836 }
837
838let rec vk_expr_s = fun bigf expr ->
839 let iif ii = vk_ii_s bigf ii in
840 let rec exprf e = bigf.kexpr_s (k, bigf) e
841 and k e =
842 let ((unwrap_e, typ), ii) = e in
91eba41f 843 (* !!! don't analyse optional type !!!
34e49164
C
844 * old: typ +> map_option (vk_type_s bigf) in
845 *)
846 let typ' = typ in
847 let e' =
848 match unwrap_e with
849 | Ident (s) -> Ident (s)
850 | Constant (c) -> Constant (c)
851 | FunCall (e, es) ->
852 FunCall (exprf e,
853 es +> List.map (fun (e,ii) ->
854 vk_argument_s bigf e, iif ii
855 ))
856
faf9a90c 857 | CondExpr (e1, e2, e3) -> CondExpr (exprf e1, fmap exprf e2, exprf e3)
34e49164
C
858 | Sequence (e1, e2) -> Sequence (exprf e1, exprf e2)
859 | Assignment (e1, op, e2) -> Assignment (exprf e1, op, exprf e2)
860
861 | Postfix (e, op) -> Postfix (exprf e, op)
862 | Infix (e, op) -> Infix (exprf e, op)
863 | Unary (e, op) -> Unary (exprf e, op)
864 | Binary (e1, op, e2) -> Binary (exprf e1, op, exprf e2)
865
866 | ArrayAccess (e1, e2) -> ArrayAccess (exprf e1, exprf e2)
867 | RecordAccess (e, s) -> RecordAccess (exprf e, s)
868 | RecordPtAccess (e, s) -> RecordPtAccess (exprf e, s)
869
870 | SizeOfExpr (e) -> SizeOfExpr (exprf e)
871 | SizeOfType (t) -> SizeOfType (vk_type_s bigf t)
872 | Cast (t, e) -> Cast (vk_type_s bigf t, exprf e)
873
874 | StatementExpr (statxs, is) ->
875 StatementExpr (
485bce71 876 vk_statement_sequencable_list_s bigf statxs,
34e49164
C
877 iif is)
878 | Constructor (t, initxs) ->
879 Constructor
880 (vk_type_s bigf t,
881 (initxs +> List.map (fun (ini, ii) ->
882 vk_ini_s bigf ini, vk_ii_s bigf ii)
883 ))
884
885 | ParenExpr (e) -> ParenExpr (exprf e)
886
887 in
888 (e', typ'), (iif ii)
889 in exprf expr
890
891and vk_argument_s bigf argument =
892 let iif ii = vk_ii_s bigf ii in
893 let rec do_action = function
894 | (ActMisc ii) -> ActMisc (iif ii)
895 in
896 (match argument with
897 | Left e -> Left (vk_expr_s bigf e)
898 | Right (ArgType param) -> Right (ArgType (vk_param_s bigf param))
899 | Right (ArgAction action) -> Right (ArgAction (do_action action))
900 )
901
902
903
904
905
906
907and vk_statement_s = fun bigf st ->
908 let rec statf st = bigf.kstatement_s (k, bigf) st
909 and k st =
910 let (unwrap_st, ii) = st in
911 let st' =
912 match unwrap_st with
913 | Labeled (Label (s, st)) ->
914 Labeled (Label (s, statf st))
915 | Labeled (Case (e, st)) ->
916 Labeled (Case ((vk_expr_s bigf) e , statf st))
917 | Labeled (CaseRange (e, e2, st)) ->
918 Labeled (CaseRange ((vk_expr_s bigf) e,
919 (vk_expr_s bigf) e2,
920 statf st))
921 | Labeled (Default st) -> Labeled (Default (statf st))
922 | Compound statxs ->
485bce71 923 Compound (vk_statement_sequencable_list_s bigf statxs)
34e49164
C
924 | ExprStatement (None) -> ExprStatement (None)
925 | ExprStatement (Some e) -> ExprStatement (Some ((vk_expr_s bigf) e))
926 | Selection (If (e, st1, st2)) ->
927 Selection (If ((vk_expr_s bigf) e, statf st1, statf st2))
34e49164
C
928 | Selection (Switch (e, st)) ->
929 Selection (Switch ((vk_expr_s bigf) e, statf st))
930 | Iteration (While (e, st)) ->
931 Iteration (While ((vk_expr_s bigf) e, statf st))
932 | Iteration (DoWhile (st, e)) ->
933 Iteration (DoWhile (statf st, (vk_expr_s bigf) e))
934 | Iteration (For ((e1opt,i1), (e2opt,i2), (e3opt,i3), st)) ->
935 let e1opt' = statf (ExprStatement (e1opt),i1) in
936 let e2opt' = statf (ExprStatement (e2opt),i2) in
937 let e3opt' = statf (ExprStatement (e3opt),i3) in
938 (match (e1opt', e2opt', e3opt') with
939 | ((ExprStatement x1,i1), (ExprStatement x2,i2), ((ExprStatement x3,i3))) ->
940 Iteration (For ((x1,i1), (x2,i2), (x3,i3), statf st))
941 | x -> failwith "cant be here if iterator keep ExprStatement as is"
942 )
943
944 | Iteration (MacroIteration (s, es, st)) ->
945 Iteration
946 (MacroIteration
947 (s,
948 es +> List.map (fun (e, ii) ->
949 vk_argument_s bigf e, vk_ii_s bigf ii
950 ),
951 statf st
952 ))
953
954
955 | Jump (Goto s) -> Jump (Goto s)
956 | Jump (((Continue|Break|Return) as x)) -> Jump (x)
957 | Jump (ReturnExpr e) -> Jump (ReturnExpr ((vk_expr_s bigf) e))
958 | Jump (GotoComputed e) -> Jump (GotoComputed (vk_expr_s bigf e));
959
960 | Decl decl -> Decl (vk_decl_s bigf decl)
961 | Asm asmbody -> Asm (vk_asmbody_s bigf asmbody)
962 | NestedFunc def -> NestedFunc (vk_def_s bigf def)
963 | MacroStmt -> MacroStmt
964 in
965 st', vk_ii_s bigf ii
966 in statf st
967
485bce71
C
968
969and vk_statement_sequencable_s = fun bigf stseq ->
970 let f = bigf.kstatementseq_s in
971 let k stseq =
972
973 match stseq with
974 | StmtElem st ->
975 StmtElem (vk_statement_s bigf st)
976 | CppDirectiveStmt directive ->
977 CppDirectiveStmt (vk_cpp_directive_s bigf directive)
978 | IfdefStmt ifdef ->
979 IfdefStmt (vk_ifdef_directive_s bigf ifdef)
980 | IfdefStmt2 (ifdef, xxs) ->
981 let ifdef' = List.map (vk_ifdef_directive_s bigf) ifdef in
982 let xxs' = xxs +> List.map (fun xs ->
983 xs +> List.map (vk_statement_sequencable_s bigf)
984 )
985 in
986 IfdefStmt2(ifdef', xxs')
987 in f (k, bigf) stseq
988
989and vk_statement_sequencable_list_s = fun bigf statxs ->
990 let f = bigf.kstatementseq_list_s in
991 let k xs =
992 xs +> List.map (vk_statement_sequencable_s bigf)
993 in
994 f (k, bigf) statxs
995
996
997
34e49164
C
998and vk_asmbody_s = fun bigf (string_list, colon_list) ->
999 let iif ii = vk_ii_s bigf ii in
1000
1001 iif string_list,
1002 colon_list +> List.map (fun (Colon xs, ii) ->
1003 Colon
1004 (xs +> List.map (fun (x, iicomma) ->
1005 (match x with
1006 | ColonMisc, ii -> ColonMisc, iif ii
1007 | ColonExpr e, ii -> ColonExpr (vk_expr_s bigf e), iif ii
1008 ), iif iicomma
1009 )),
1010 iif ii
1011 )
1012
1013
1014
1015
1016and vk_type_s = fun bigf t ->
1017 let rec typef t = bigf.ktype_s (k,bigf) t
1018 and iif ii = vk_ii_s bigf ii
1019 and k t =
1020 let (q, t) = t in
1021 let (unwrap_q, iiq) = q in
faf9a90c
C
1022 (* strip_info_visitor needs iiq to be processed before iit *)
1023 let iif_iiq = iif iiq in
34e49164
C
1024 let q' = unwrap_q in (* todo? a visitor for qualifier *)
1025 let (unwrap_t, iit) = t in
1026 let t' =
1027 match unwrap_t with
1028 | BaseType x -> BaseType x
1029 | Pointer t -> Pointer (typef t)
1030 | Array (eopt, t) -> Array (fmap (vk_expr_s bigf) eopt, typef t)
1031 | FunctionType (returnt, paramst) ->
1032 FunctionType
1033 (typef returnt,
1034 (match paramst with
1035 | (ts, (b, iihas3dots)) ->
1036 (ts +> List.map (fun (param,iicomma) ->
1037 (vk_param_s bigf param, iif iicomma)),
1038 (b, iif iihas3dots))
1039 ))
1040
1041 | Enum (sopt, enumt) ->
1042 Enum (sopt,
1043 enumt +> List.map (fun (((s, eopt),ii_s_eq), iicomma) ->
1044 ((s, fmap (vk_expr_s bigf) eopt), iif ii_s_eq),
1045 iif iicomma
1046 )
1047 )
1048 | StructUnion (sopt, su, fields) ->
1049 StructUnion (sopt, su, vk_struct_fields_s bigf fields)
1050
1051
1052 | StructUnionName (s, structunion) -> StructUnionName (s, structunion)
1053 | EnumName s -> EnumName s
1054 | TypeName (s, typ) -> TypeName (s, typ)
1055
1056 | ParenType t -> ParenType (typef t)
1057 | TypeOfExpr e -> TypeOfExpr (vk_expr_s bigf e)
1058 | TypeOfType t -> TypeOfType (typef t)
1059 in
faf9a90c
C
1060 (q', iif_iiq),
1061 (t', iif iit)
34e49164
C
1062
1063
1064 in typef t
1065
485bce71
C
1066and vk_attribute_s = fun bigf attr ->
1067 let iif ii = vk_ii_s bigf ii in
1068 match attr with
1069 | Attribute s, ii ->
1070 Attribute s, iif ii
1071
1072
1073
34e49164
C
1074and vk_decl_s = fun bigf d ->
1075 let f = bigf.kdecl_s in
1076 let iif ii = vk_ii_s bigf ii in
1077 let rec k decl =
1078 match decl with
1079 | DeclList (xs, ii) ->
1080 DeclList (List.map aux xs, iif ii)
1081 | MacroDecl ((s, args),ii) ->
1082 MacroDecl
1083 ((s,
1084 args +> List.map (fun (e,ii) -> vk_argument_s bigf e, iif ii)
1085 ),
1086 iif ii)
1087
1088
485bce71
C
1089 and aux ({v_namei = var; v_type = t;
1090 v_storage = sto; v_local= local; v_attr = attrs}, iicomma) =
1091 {v_namei =
1092 (var +> map_option (fun ((s, ini), ii_s_ini) ->
34e49164
C
1093 (s, ini +> map_option (fun init -> vk_ini_s bigf init)),
1094 iif ii_s_ini
485bce71
C
1095 )
1096 );
1097 v_type = vk_type_s bigf t;
1098 v_storage = sto;
1099 v_local = local;
1100 v_attr = attrs +> List.map (vk_attribute_s bigf);
1101 },
1102 iif iicomma
34e49164
C
1103
1104 in f (k, bigf) d
1105
1106and vk_ini_s = fun bigf ini ->
1107 let rec inif ini = bigf.kini_s (k,bigf) ini
1108 and k ini =
1109 let (unwrap_ini, ii) = ini in
1110 let ini' =
1111 match unwrap_ini with
1112 | InitExpr e -> InitExpr (vk_expr_s bigf e)
1113 | InitList initxs ->
1114 InitList (initxs +> List.map (fun (ini, ii) ->
1115 inif ini, vk_ii_s bigf ii)
1116 )
1117
1118
1119 | InitDesignators (xs, e) ->
1120 InitDesignators
1121 (xs +> List.map (vk_designator_s bigf),
1122 inif e
1123 )
1124
1125 | InitFieldOld (s, e) -> InitFieldOld (s, inif e)
1126 | InitIndexOld (e1, e) -> InitIndexOld (vk_expr_s bigf e1, inif e)
1127
485bce71 1128
34e49164
C
1129 in ini', vk_ii_s bigf ii
1130 in inif ini
1131
1132
1133and vk_designator_s = fun bigf design ->
1134 let iif ii = vk_ii_s bigf ii in
1135 let (designator, ii) = design in
1136 (match designator with
1137 | DesignatorField s -> DesignatorField s
1138 | DesignatorIndex e -> DesignatorIndex (vk_expr_s bigf e)
1139 | DesignatorRange (e1, e2) ->
1140 DesignatorRange (vk_expr_s bigf e1, vk_expr_s bigf e2)
1141 ), iif ii
1142
1143
1144
1145
485bce71
C
1146and vk_struct_fieldkinds_s = fun bigf onefield_multivars ->
1147 let iif ii = vk_ii_s bigf ii in
1148
1149 onefield_multivars +> List.map (fun (field, iicomma) ->
1150 (match field with
1151 | Simple (s, t), iis -> Simple (s, vk_type_s bigf t), iif iis
1152 | BitField (sopt, t, expr), iis ->
1153 BitField (sopt, vk_type_s bigf t, vk_expr_s bigf expr),
1154 iif iis
1155 ), iif iicomma
1156 )
1157
34e49164
C
1158and vk_struct_fields_s = fun bigf fields ->
1159
1160 let iif ii = vk_ii_s bigf ii in
1161
1162 fields +> List.map (fun (xfield, iiptvirg) ->
1163
1164 (match xfield with
485bce71
C
1165 | (DeclarationField (FieldDeclList (onefield_multivars, iiptvirg))) ->
1166 DeclarationField
1167 (FieldDeclList
1168 (vk_struct_fieldkinds_s bigf onefield_multivars, iif iiptvirg))
34e49164 1169 | EmptyField -> EmptyField
485bce71 1170 | MacroStructDeclTodo ->
91eba41f 1171 pr2_once "MacroStructDeclTodo";
485bce71
C
1172 MacroStructDeclTodo
1173
1174 | CppDirectiveStruct directive ->
1175 CppDirectiveStruct (vk_cpp_directive_s bigf directive)
1176 | IfdefStruct ifdef ->
1177 IfdefStruct (vk_ifdef_directive_s bigf ifdef)
1178
34e49164
C
1179 ), iif iiptvirg
1180 )
1181
1182
1183and vk_def_s = fun bigf d ->
1184 let f = bigf.kdef_s in
1185 let iif ii = vk_ii_s bigf ii in
1186 let rec k d =
1187 match d with
485bce71
C
1188 | {f_name = s;
1189 f_type = (returnt, (paramst, (b, iib)));
1190 f_storage = sto;
1191 f_body = statxs;
1192 f_attr = attrs;
91eba41f 1193 f_old_c_style = oldstyle;
485bce71
C
1194 }, ii
1195 ->
1196 {f_name = s;
1197 f_type =
1198 (vk_type_s bigf returnt,
1199 (paramst +> List.map (fun (param, iicomma) ->
1200 (vk_param_s bigf param, iif iicomma)
1201 ), (b, iif iib)));
1202 f_storage = sto;
1203 f_body =
1204 vk_statement_sequencable_list_s bigf statxs;
1205 f_attr =
91eba41f
C
1206 attrs +> List.map (vk_attribute_s bigf);
1207 f_old_c_style =
1208 oldstyle +> Common.map_option (fun decls ->
1209 decls +> List.map (vk_decl_s bigf)
1210 );
485bce71 1211 },
34e49164
C
1212 iif ii
1213
1214 in f (k, bigf) d
1215
1216and vk_toplevel_s = fun bigf p ->
1217 let f = bigf.ktoplevel_s in
1218 let iif ii = vk_ii_s bigf ii in
1219 let rec k p =
1220 match p with
1221 | Declaration decl -> Declaration (vk_decl_s bigf decl)
1222 | Definition def -> Definition (vk_def_s bigf def)
1223 | EmptyDef ii -> EmptyDef (iif ii)
1224 | MacroTop (s, xs, ii) ->
1225 MacroTop
1226 (s,
1227 xs +> List.map (fun (elem, iicomma) ->
1228 vk_argument_s bigf elem, iif iicomma
1229 ),
1230 iif ii
1231 )
485bce71
C
1232 | CppTop top -> CppTop (vk_cpp_directive_s bigf top)
1233 | IfdefTop ifdefdir -> IfdefTop (vk_ifdef_directive_s bigf ifdefdir)
34e49164
C
1234
1235 | NotParsedCorrectly ii -> NotParsedCorrectly (iif ii)
1236 | FinalDef info -> FinalDef (vk_info_s bigf info)
1237 in f (k, bigf) p
1238
485bce71
C
1239and vk_program_s = fun bigf xs ->
1240 xs +> List.map (vk_toplevel_s bigf)
1241
1242
1243and vk_cpp_directive_s = fun bigf top ->
1244 let iif ii = vk_ii_s bigf ii in
1245 let f = bigf.kcppdirective_s in
1246 let rec k top =
1247 match top with
1248 (* go inside ? *)
1249 | Include {i_include = (s, ii);
1250 i_rel_pos = h_rel_pos;
1251 i_is_in_ifdef = b;
1252 i_content = copt;
1253 }
1254 -> Include {i_include = (s, iif ii);
1255 i_rel_pos = h_rel_pos;
1256 i_is_in_ifdef = b;
1257 i_content = copt +> Common.map_option (fun (file, asts) ->
1258 file, vk_program_s bigf asts
1259 );
1260 }
1261 | Define ((s,ii), (defkind, defval)) ->
1262 Define ((s, iif ii),
1263 (vk_define_kind_s bigf defkind, vk_define_val_s bigf defval))
1264 | Undef (s, ii) -> Undef (s, iif ii)
1265 | PragmaAndCo (ii) -> PragmaAndCo (iif ii)
1266
1267 in f (k, bigf) top
1268
1269and vk_ifdef_directive_s = fun bigf ifdef ->
1270 let iif ii = vk_ii_s bigf ii in
1271 match ifdef with
1272 | IfdefDirective (ifkind, ii) -> IfdefDirective (ifkind, iif ii)
1273
1274
1275
34e49164
C
1276and vk_define_kind_s = fun bigf defkind ->
1277 match defkind with
1278 | DefineVar -> DefineVar
1279 | DefineFunc (params, ii) ->
1280 DefineFunc
1281 (params +> List.map (fun ((s,iis),iicomma) ->
1282 ((s, vk_ii_s bigf iis), vk_ii_s bigf iicomma)
1283 ),
1284 vk_ii_s bigf ii
1285 )
1286
1287
1288and vk_define_val_s = fun bigf x ->
1289 let f = bigf.kdefineval_s in
1290 let iif ii = vk_ii_s bigf ii in
1291 let rec k x =
1292 match x with
1293 | DefineExpr e -> DefineExpr (vk_expr_s bigf e)
1294 | DefineStmt st -> DefineStmt (vk_statement_s bigf st)
485bce71
C
1295 | DefineDoWhileZero ((st,e),ii) ->
1296 let st' = vk_statement_s bigf st in
1297 let e' = vk_expr_s bigf e in
1298 DefineDoWhileZero ((st',e'), iif ii)
34e49164
C
1299 | DefineFunction def -> DefineFunction (vk_def_s bigf def)
1300 | DefineType ty -> DefineType (vk_type_s bigf ty)
1301 | DefineText (s, ii) -> DefineText (s, iif ii)
1302 | DefineEmpty -> DefineEmpty
485bce71
C
1303 | DefineInit ini -> DefineInit (vk_ini_s bigf ini)
1304
1305 | DefineTodo ->
91eba41f 1306 pr2_once "DefineTodo";
485bce71 1307 DefineTodo
34e49164
C
1308 in
1309 f (k, bigf) x
1310
1311
1312and vk_info_s = fun bigf info ->
1313 let rec infof ii = bigf.kinfo_s (k, bigf) ii
1314 and k i = i
1315 in
1316 infof info
1317
1318and vk_ii_s = fun bigf ii ->
1319 List.map (vk_info_s bigf) ii
1320
1321(* ------------------------------------------------------------------------ *)
1322and vk_node_s = fun bigf node ->
1323 let iif ii = vk_ii_s bigf ii in
1324 let infof info = vk_info_s bigf info in
1325
1326 let rec nodef n = bigf.knode_s (k, bigf) n
1327 and k node =
1328 F.rewrap node (
1329 match F.unwrap node with
91eba41f
C
1330 | F.FunHeader (def) ->
1331 assert (null (fst def).f_body);
1332 F.FunHeader (vk_def_s bigf def)
34e49164
C
1333
1334 | F.Decl declb -> F.Decl (vk_decl_s bigf declb)
1335 | F.ExprStatement (st, (eopt, ii)) ->
1336 F.ExprStatement (st, (eopt +> map_option (vk_expr_s bigf), iif ii))
1337
1338 | F.IfHeader (st, (e,ii)) ->
1339 F.IfHeader (st, (vk_expr_s bigf e, iif ii))
1340 | F.SwitchHeader (st, (e,ii)) ->
1341 F.SwitchHeader(st, (vk_expr_s bigf e, iif ii))
1342 | F.WhileHeader (st, (e,ii)) ->
1343 F.WhileHeader (st, (vk_expr_s bigf e, iif ii))
1344 | F.DoWhileTail (e,ii) ->
1345 F.DoWhileTail (vk_expr_s bigf e, iif ii)
1346
1347 | F.ForHeader (st, (((e1opt,i1), (e2opt,i2), (e3opt,i3)), ii)) ->
1348 F.ForHeader (st,
1349 (((e1opt +> Common.map_option (vk_expr_s bigf), iif i1),
1350 (e2opt +> Common.map_option (vk_expr_s bigf), iif i2),
1351 (e3opt +> Common.map_option (vk_expr_s bigf), iif i3)),
1352 iif ii))
1353
1354 | F.MacroIterHeader (st, ((s,es), ii)) ->
1355 F.MacroIterHeader
1356 (st,
1357 ((s, es +> List.map (fun (e, ii) -> vk_argument_s bigf e, iif ii)),
1358 iif ii))
1359
1360
1361 | F.ReturnExpr (st, (e,ii)) ->
1362 F.ReturnExpr (st, (vk_expr_s bigf e, iif ii))
1363
1364 | F.Case (st, (e,ii)) -> F.Case (st, (vk_expr_s bigf e, iif ii))
1365 | F.CaseRange (st, ((e1, e2),ii)) ->
1366 F.CaseRange (st, ((vk_expr_s bigf e1, vk_expr_s bigf e2), iif ii))
1367
1368 | F.CaseNode i -> F.CaseNode i
1369
1370 | F.DefineHeader((s,ii), (defkind)) ->
1371 F.DefineHeader ((s, iif ii), (vk_define_kind_s bigf defkind))
1372
1373 | F.DefineExpr e -> F.DefineExpr (vk_expr_s bigf e)
1374 | F.DefineType ft -> F.DefineType (vk_type_s bigf ft)
1375 | F.DefineDoWhileZeroHeader ((),ii) ->
1376 F.DefineDoWhileZeroHeader ((),iif ii)
485bce71
C
1377 | F.DefineTodo -> F.DefineTodo
1378
1379 | F.Include {i_include = (s, ii);
1380 i_rel_pos = h_rel_pos;
1381 i_is_in_ifdef = b;
1382 i_content = copt;
1383 }
1384 ->
1385 assert (copt = None);
1386 F.Include {i_include = (s, iif ii);
1387 i_rel_pos = h_rel_pos;
1388 i_is_in_ifdef = b;
1389 i_content = copt;
1390 }
34e49164 1391
34e49164
C
1392 | F.MacroTop (s, args, ii) ->
1393 F.MacroTop
1394 (s,
1395 args +> List.map (fun (e, ii) -> vk_argument_s bigf e, iif ii),
1396 iif ii)
1397
1398
1399 | F.MacroStmt (st, ((),ii)) -> F.MacroStmt (st, ((),iif ii))
1400 | F.Asm (st, (body,ii)) -> F.Asm (st, (vk_asmbody_s bigf body,iif ii))
1401
1402 | F.Break (st,((),ii)) -> F.Break (st,((),iif ii))
1403 | F.Continue (st,((),ii)) -> F.Continue (st,((),iif ii))
1404 | F.Default (st,((),ii)) -> F.Default (st,((),iif ii))
1405 | F.Return (st,((),ii)) -> F.Return (st,((),iif ii))
1406 | F.Goto (st, (s,ii)) -> F.Goto (st, (s,iif ii))
1407 | F.Label (st, (s,ii)) -> F.Label (st, (s,iif ii))
1408 | F.EndStatement iopt -> F.EndStatement (map_option infof iopt)
1409 | F.DoHeader (st, info) -> F.DoHeader (st, infof info)
1410 | F.Else info -> F.Else (infof info)
1411 | F.SeqEnd (i, info) -> F.SeqEnd (i, infof info)
1412 | F.SeqStart (st, i, info) -> F.SeqStart (st, i, infof info)
1413
485bce71
C
1414 | F.IfdefHeader (info) -> F.IfdefHeader (vk_ifdef_directive_s bigf info)
1415 | F.IfdefElse (info) -> F.IfdefElse (vk_ifdef_directive_s bigf info)
1416 | F.IfdefEndif (info) -> F.IfdefEndif (vk_ifdef_directive_s bigf info)
1417
34e49164
C
1418 | (
1419 (
1420 F.TopNode|F.EndNode|
1421 F.ErrorExit|F.Exit|F.Enter|
1422 F.FallThroughNode|F.AfterNode|F.FalseNode|F.TrueNode|F.InLoopNode|
1423 F.Fake
1424 ) as x) -> x
1425
1426
1427 )
1428 in
1429 nodef node
1430
1431(* ------------------------------------------------------------------------ *)
1432and vk_param_s = fun bigf ((b, s, t), ii_b_s) ->
1433 let iif ii = vk_ii_s bigf ii in
1434 ((b, s, vk_type_s bigf t), iif ii_b_s)
faf9a90c 1435
34e49164
C
1436let vk_args_splitted_s = fun bigf args_splitted ->
1437 let iif ii = vk_ii_s bigf ii in
1438 args_splitted +> List.map (function
1439 | Left arg -> Left (vk_argument_s bigf arg)
1440 | Right ii -> Right (iif ii)
1441 )
1442
1443let vk_arguments_s = fun bigf args ->
1444 let iif ii = vk_ii_s bigf ii in
1445 args +> List.map (fun (e, ii) -> vk_argument_s bigf e, iif ii)
1446
1447
1448let vk_params_splitted_s = fun bigf args_splitted ->
1449 let iif ii = vk_ii_s bigf ii in
1450 args_splitted +> List.map (function
1451 | Left arg -> Left (vk_param_s bigf arg)
1452 | Right ii -> Right (iif ii)
1453 )
1454
1455let vk_params_s = fun bigf args ->
1456 let iif ii = vk_ii_s bigf ii in
1457 args +> List.map (fun (p,ii) -> vk_param_s bigf p, iif ii)
1458
1459let vk_define_params_splitted_s = fun bigf args_splitted ->
1460 let iif ii = vk_ii_s bigf ii in
1461 args_splitted +> List.map (function
1462 | Left (s, iis) -> Left (s, vk_ii_s bigf iis)
1463 | Right ii -> Right (iif ii)
1464 )
1465
1466let vk_cst_s = fun bigf (cst, ii) ->
1467 let iif ii = vk_ii_s bigf ii in
1468 (match cst with
1469 | Left cst -> Left cst
1470 | Right s -> Right s
1471 ), iif ii