File: lib_parsing_c.ml

package info (click to toggle)
coccinelle 1.0.8.deb-5
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 26,148 kB
  • sloc: ml: 136,392; ansic: 23,594; sh: 2,189; makefile: 2,157; perl: 1,576; lisp: 840; python: 823; awk: 70; csh: 12
file content (439 lines) | stat: -rw-r--r-- 15,791 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
(* Yoann Padioleau
 *
 * Copyright (C) 2010, University of Copenhagen DIKU and INRIA.
 * Copyright (C) 2007, 2008, 2009 Ecole des Mines de Nantes
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License (GPL)
 * version 2 as published by the Free Software Foundation.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * file license.txt for more details.
 *)
open Common

(*****************************************************************************)
(* Wrappers *)
(*****************************************************************************)
let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_parsing

(*****************************************************************************)
(* Abstract line *)
(*****************************************************************************)

(* todo?: al_expr doit enlever les infos de type ? et doit remettre en
 *  emptyAnnot ?

No!  Keeping the type information is important to ensuring that variables
of different type and declared in different places do not seem to match
each other.  On the other hand, we don't want to keep around the
information about whether the expression is a test expression, because a
term that is a test expression should match one that is not.  The test
information is only useful for matching to the CTL.

 *)

(* drop all info information *)

let strip_info_visitor _ =
  let drop_test ty =
    let (ty,_) = !ty in
    ref (ty,Ast_c.NotTest) in

  { Visitor_c.default_visitor_c_s with
    Visitor_c.kinfo_s =
    (* traversal should be deterministic... *)
    (let ctr = ref 0 in
    (function (k,_) ->
    function i -> ctr := !ctr + 1; Ast_c.al_info_cpp !ctr i));

    Visitor_c.kexpr_s = (fun (k,_) e ->
      let (e', ty), ii' = k e in
      (e', drop_test ty), ii' (* keep type - jll *)
    );

(*
    Visitor_c.ktype_s = (fun (k,_) ft ->
      let ft' = k ft in
      match Ast_c.unwrap_typeC ft' with
      | Ast_c.TypeName (s,_typ) ->
          Ast_c.TypeName (s, Ast_c.noTypedefDef()) +> Ast_c.rewrap_typeC ft'
      | _ -> ft'

    );
*)

  }

let al_expr      x = Visitor_c.vk_expr_s      (strip_info_visitor()) x
let al_declaration x = Visitor_c.vk_decl_s    (strip_info_visitor()) x
let al_field     x = Visitor_c.vk_struct_field_s (strip_info_visitor()) x
let al_statement x = Visitor_c.vk_statement_s (strip_info_visitor()) x
let al_statement_seq_list x =
  Visitor_c.vk_statement_sequencable_list_s (strip_info_visitor()) x
let al_type      x = Visitor_c.vk_type_s      (strip_info_visitor()) x
let al_init      x = Visitor_c.vk_ini_s       (strip_info_visitor()) x
let al_inits     x = Visitor_c.vk_inis_s      (strip_info_visitor()) x
let al_param     x = Visitor_c.vk_param_s     (strip_info_visitor()) x
let al_params    x = Visitor_c.vk_params_s    (strip_info_visitor()) x
let al_define_params x =
  Visitor_c.vk_define_params_s (strip_info_visitor()) x
let al_arguments x = Visitor_c.vk_arguments_s (strip_info_visitor()) x
let al_fields    x = Visitor_c.vk_struct_fields_s (strip_info_visitor()) x
let al_name      x = Visitor_c.vk_name_s      (strip_info_visitor()) x
let al_string_format x = Visitor_c.vk_string_format_s (strip_info_visitor()) x
let al_string_fragments x =
  Visitor_c.vk_string_fragments_s (strip_info_visitor()) x

let al_node      x = Visitor_c.vk_node_s      (strip_info_visitor()) x

let al_program  x = List.map (Visitor_c.vk_toplevel_s (strip_info_visitor())) x
let al_ii    x = Visitor_c.vk_ii_s (strip_info_visitor()) x




let strip_inh_info_visitor _ =  (* for inherited metavariables *)
  let drop_test_lv ty bigf =
    let (ty,_) = !ty in
    let ty =
      match ty with
	None -> None
      |	Some (ty,_) ->
	  let ty = Visitor_c.vk_type_s bigf ty in
	  Some (ty,Ast_c.NotLocalVar) in
    ref ((ty,Ast_c.NotTest) : Ast_c.exp_info) in

  { Visitor_c.default_visitor_c_s with
    Visitor_c.kinfo_s =
    (* traversal should be deterministic... *)
    (let ctr = ref 0 in
    (function (k,_) ->
    function i -> ctr := !ctr + 1; Ast_c.al_info_cpp !ctr i));

    Visitor_c.kexpr_s = (fun (k,bigf) e ->
      let (e', ty), ii' = k e in
      (e', drop_test_lv ty bigf), ii' (* keep type, but process it - jll *)
    );

(*
    Visitor_c.ktype_s = (fun (k,_) ft ->
      let ft' = k ft in
      match Ast_c.unwrap_typeC ft' with
      | Ast_c.TypeName (s,_typ) ->
          Ast_c.TypeName (s, Ast_c.noTypedefDef()) +> Ast_c.rewrap_typeC ft'
      | _ -> ft'

    );
*)

  }

let al_inh_expr      x = Visitor_c.vk_expr_s      (strip_inh_info_visitor()) x
let al_inh_declaration x = Visitor_c.vk_decl_s    (strip_inh_info_visitor()) x
let al_inh_field    x = Visitor_c.vk_struct_field_s (strip_inh_info_visitor()) x
let al_inh_field_list x =
  Visitor_c.vk_struct_fields_s (strip_inh_info_visitor()) x
let al_inh_statement x = Visitor_c.vk_statement_s (strip_inh_info_visitor()) x
let al_inh_statement_seq_list x =
  Visitor_c.vk_statement_sequencable_list_s (strip_inh_info_visitor()) x
let al_inh_type      x = Visitor_c.vk_type_s      (strip_inh_info_visitor()) x
let al_inh_init      x = Visitor_c.vk_ini_s       (strip_inh_info_visitor()) x
let al_inh_inits     x = Visitor_c.vk_inis_s      (strip_inh_info_visitor()) x
let al_inh_arguments x = Visitor_c.vk_arguments_s (strip_inh_info_visitor()) x
let al_inh_string_format x =
  Visitor_c.vk_string_format_s (strip_inh_info_visitor()) x
let al_inh_string_fragments x =
  Visitor_c.vk_string_fragments_s (strip_inh_info_visitor()) x



let semi_strip_info_visitor = (* keep position information *)
  let drop_test ty =
    let (ty,_) = !ty in
    ref (ty,Ast_c.NotTest) in

  { Visitor_c.default_visitor_c_s with
    Visitor_c.kinfo_s = (fun (k,_) i -> Ast_c.semi_al_info_cpp i);

    Visitor_c.kexpr_s = (fun (k,_) e ->
      let (e', ty),ii' = k e in
      (e', drop_test ty), ii' (* keep type - jll *)
    );

  }

let semi_al_expr      = Visitor_c.vk_expr_s      semi_strip_info_visitor
let semi_al_declaration = Visitor_c.vk_decl_s    semi_strip_info_visitor
let semi_al_field = Visitor_c.vk_struct_field_s  semi_strip_info_visitor
let semi_al_fields = Visitor_c.vk_struct_fields_s semi_strip_info_visitor
let semi_al_statement = Visitor_c.vk_statement_s semi_strip_info_visitor
let semi_al_statement_seq_list =
  Visitor_c.vk_statement_sequencable_list_s semi_strip_info_visitor
let semi_al_type      = Visitor_c.vk_type_s      semi_strip_info_visitor
let semi_al_init      = Visitor_c.vk_ini_s       semi_strip_info_visitor
let semi_al_inits     = Visitor_c.vk_inis_s      semi_strip_info_visitor
let semi_al_param     = Visitor_c.vk_param_s     semi_strip_info_visitor
let semi_al_params    = Visitor_c.vk_params_s    semi_strip_info_visitor
let semi_al_define_params =
  Visitor_c.vk_define_params_s semi_strip_info_visitor
let semi_al_arguments = Visitor_c.vk_arguments_s semi_strip_info_visitor
let semi_al_string_format =
  Visitor_c.vk_string_format_s semi_strip_info_visitor
let semi_al_string_fragments =
  Visitor_c.vk_string_fragments_s semi_strip_info_visitor

let semi_al_program =
  List.map (Visitor_c.vk_toplevel_s semi_strip_info_visitor)




(* really strip, do not keep position nor anything specificities, true
 * abstracted form. This is used outside coccinelle in Yacfe and aComment *)
let real_strip_info_visitor _ =
  { Visitor_c.default_visitor_c_s with
    Visitor_c.kinfo_s = (fun (k,_) i ->
      Ast_c.real_al_info_cpp false i
    );

    Visitor_c.kexpr_s = (fun (k,_) e ->
      let (e', ty),ii' = k e in
      (e', Ast_c.noType()), ii'
    );

(*
    Visitor_c.ktype_s = (fun (k,_) ft ->
      let ft' = k ft in
      match Ast_c.unwrap_typeC ft' with
      | Ast_c.TypeName (s,_typ) ->
          Ast_c.TypeName (s, Ast_c.noTypedefDef()) +> Ast_c.rewrap_typeC ft'
      | _ -> ft'

    );
*)

  }

let real_al_expr      x = Visitor_c.vk_expr_s   (real_strip_info_visitor()) x
let real_al_arguments x = Visitor_c.vk_arguments_s (real_strip_info_visitor()) x
let real_al_node      x = Visitor_c.vk_node_s   (real_strip_info_visitor()) x
let real_al_type      x = Visitor_c.vk_type_s   (real_strip_info_visitor()) x
let real_al_binop     x = Visitor_c.vk_binaryOp_s (real_strip_info_visitor()) x
let real_al_assignop  x = Visitor_c.vk_assignOp_s (real_strip_info_visitor()) x
let real_al_decl      x = Visitor_c.vk_decl_s   (real_strip_info_visitor()) x
let real_al_init      x = Visitor_c.vk_ini_s    (real_strip_info_visitor()) x
let real_al_inits     x = Visitor_c.vk_inis_s   (real_strip_info_visitor()) x
let real_al_statement x =
  Visitor_c.vk_statement_s (real_strip_info_visitor()) x
let real_al_statement_seq_list x =
  Visitor_c.vk_statement_sequencable_list_s (real_strip_info_visitor()) x
let real_al_def       x = Visitor_c.vk_toplevel_s (real_strip_info_visitor()) x




let real_strip_info_visitor_with_comments _ =
  { Visitor_c.default_visitor_c_s with
    Visitor_c.kinfo_s = (fun (k,_) i ->
      Ast_c.real_al_info_cpp true i
    );

    Visitor_c.kexpr_s = (fun (k,_) e ->
      let (e', ty),ii' = k e in
      (e', Ast_c.noType()), ii'
    );

(*
    Visitor_c.ktype_s = (fun (k,_) ft ->
      let ft' = k ft in
      match Ast_c.unwrap_typeC ft' with
      | Ast_c.TypeName (s,_typ) ->
          Ast_c.TypeName (s, Ast_c.noTypedefDef()) +> Ast_c.rewrap_typeC ft'
      | _ -> ft'

    );
*)

  }

let real_al_decl_with_comments x =
  Visitor_c.vk_decl_s   (real_strip_info_visitor_with_comments()) x
let real_al_statement_with_comments x =
  Visitor_c.vk_statement_s (real_strip_info_visitor_with_comments()) x





(*****************************************************************************)
(* Extract infos *)
(*****************************************************************************)

let extract_info_visitor recursor x =
  let globals = ref [] in
  let visitor =
    {
      Visitor_c.default_visitor_c with
        Visitor_c.kinfo = (fun (k, _) i -> Common.push2 i globals)
    } in
  begin
    recursor visitor x;
    !globals
  end

let ii_of_def = extract_info_visitor Visitor_c.vk_def
let ii_of_decl = extract_info_visitor Visitor_c.vk_decl
let ii_of_field = extract_info_visitor Visitor_c.vk_struct_field
let ii_of_node = extract_info_visitor Visitor_c.vk_node
let ii_of_expr = extract_info_visitor Visitor_c.vk_expr
let ii_of_assignOp = extract_info_visitor Visitor_c.vk_assignOp
let ii_of_binaryOp = extract_info_visitor Visitor_c.vk_binaryOp
let ii_of_stmt = extract_info_visitor Visitor_c.vk_statement
let ii_of_stmtseq = extract_info_visitor Visitor_c.vk_statement_sequencable
let ii_of_stmtseqlist =
  extract_info_visitor Visitor_c.vk_statement_sequencable_list
let ii_of_args = extract_info_visitor Visitor_c.vk_args_splitted
let ii_of_type = extract_info_visitor Visitor_c.vk_type
let ii_of_ini  = extract_info_visitor Visitor_c.vk_ini
let ii_of_inis  = extract_info_visitor Visitor_c.vk_inis_splitted
let ii_of_param = extract_info_visitor Visitor_c.vk_param
let ii_of_params = extract_info_visitor Visitor_c.vk_params_splitted
let ii_of_enum_fields = extract_info_visitor Visitor_c.vk_enum_fields_splitted
let ii_of_struct_fields = extract_info_visitor Visitor_c.vk_struct_fields
(*let ii_of_struct_field = extract_info_visitor Visitor_c.vk_struct_field*)
let ii_of_struct_fieldkinds =
  extract_info_visitor Visitor_c.vk_struct_fieldkinds
let ii_of_cst = extract_info_visitor Visitor_c.vk_cst
let ii_of_fragments =
  extract_info_visitor Visitor_c.vk_string_fragments_splitted
let ii_of_format = extract_info_visitor Visitor_c.vk_string_format
let ii_of_define_params =
  extract_info_visitor Visitor_c.vk_define_params_splitted
let ii_of_ident_list = extract_info_visitor Visitor_c.vk_ident_list_splitted
let ii_of_exec_code_list =
  extract_info_visitor Visitor_c.vk_exec_code_list_splitted
let ii_of_attrs = extract_info_visitor Visitor_c.vk_attrs_splitted
let ii_of_toplevel = extract_info_visitor Visitor_c.vk_toplevel

(*****************************************************************************)
(* Max min, range *)
(*****************************************************************************)
let max_min_ii_by_pos xs =
  match xs with
  | [] -> failwith "empty list, max_min_ii_by_pos"
  | [x] -> (x, x)
  | x::xs ->
      let pos_leq p1 p2 = (Ast_c.compare_pos p1 p2) = (-1) in
      xs +> List.fold_left (fun (maxii,minii) e ->
        let maxii' = if pos_leq maxii e then e else maxii in
        let minii' = if pos_leq e minii then e else minii in
        maxii', minii'
      ) (x,x)

(* avoid memory costs of prefiltering the list *)
let max_min_ii_by_pos_filtered f xs =
  let xs = Common.drop_until f xs in
  match xs with
  | [] -> failwith "empty list, max_min_ii_by_pos"
  | [x] -> (x, x)
  | x::xs ->
      let pos_leq p1 p2 = (Ast_c.compare_pos p1 p2) = (-1) in
      xs +> List.fold_left (fun ((maxii,minii) as acc) e ->
	if f e
	then
          let maxii' = if pos_leq maxii e then e else maxii in
          let minii' = if pos_leq e minii then e else minii in
          maxii', minii'
	else acc
      ) (x,x)

let info_to_fixpos ii =
  match Ast_c.pinfo_of_info ii with
    Ast_c.OriginTok pi -> Ast_cocci.Real pi.Common.charpos
  | Ast_c.ExpandedTok (_,(pi,offset)) ->
      Ast_cocci.Virt (pi.Common.charpos,offset)
  | Ast_c.FakeTok (_,(pi,offset)) ->
      Ast_cocci.Virt (pi.Common.charpos,offset)
  | Ast_c.AbstractLineTok pi ->
      failwith ("unexpected abstract: "^(Dumper.dump pi))

let max_min_by_pos xs =
  let (i1, i2) = max_min_ii_by_pos xs in
  (info_to_fixpos i1, info_to_fixpos i2)

let lin_col_by_pos xs =
  (* put min before max; no idea why they are backwards above *)
  let (i2, i1) =
    max_min_ii_by_pos_filtered (function ii -> not (Ast_c.is_fake ii)) xs in
  let posf x = Ast_c.col_of_info x in
  let mposf x = Ast_c.col_of_info x + String.length (Ast_c.str_of_info x) in
  (Ast_c.file_of_info i1,!Flag.current_element,
   (Ast_c.line_of_info i1, posf i1), (Ast_c.line_of_info i2, mposf i2))





let min_pinfo_of_node node =
  let ii = ii_of_node node in
  let (maxii, minii) = max_min_ii_by_pos ii in
  Ast_c.parse_info_of_info minii


let (range_of_origin_ii: Ast_c.info list -> (int * int) option) =
 fun ii ->
  try
    let (max, min) = max_min_ii_by_pos_filtered Ast_c.is_origintok ii in
    assert(Ast_c.is_origintok max);
    assert(Ast_c.is_origintok min);
    let strmax = Ast_c.str_of_info max in
    Some
      (Ast_c.pos_of_info min, Ast_c.pos_of_info max + String.length strmax)
  with _ ->
    None


(*****************************************************************************)
(* Ast getters *)
(*****************************************************************************)

let names_of_parameters_in_def def =
  match def.Ast_c.f_old_c_style with
  | Some _ ->
      pr2_once "names_of_parameters_in_def: f_old_c_style not handled";
      []
  | None ->
      let ftyp = def.Ast_c.f_type in
      let (ret, (params, bwrap)) = ftyp in
      params +> Common.map_filter (fun (param,ii) ->
        Ast_c.name_of_parameter param
      )

let names_of_parameters_in_macro xs =
  xs +> List.map (fun (xx, ii) ->
    let (s, ii2) = xx in
    s
  )



(* only used in ast_to_flow, so move it ? *)
let rec stmt_elems_of_sequencable xs =
  xs +> Common.map (fun x ->
    match x with
    | Ast_c.StmtElem e -> [e]
    | Ast_c.CppDirectiveStmt _
    | Ast_c.IfdefStmt _
        ->
        pr2_once ("stmt_elems_of_sequencable: filter a directive");
        []
    | Ast_c.IfdefStmt2 (_ifdef, xxs) ->
        pr2 ("stmt_elems_of_sequencable: IfdefStm2 TODO?");
        xxs +> List.map (fun xs ->
          let xs' = stmt_elems_of_sequencable xs in
          xs'
        ) +> List.flatten
  ) +> List.flatten