parsing_c/lib_parsing_c.ml

   1 (* Yoann Padioleau
   2  *
   3  * Copyright (C) 2010, University of Copenhagen DIKU and INRIA.
   4  * Copyright (C) 2007, 2008, 2009 Ecole des Mines de Nantes
   5  *
   6  * This program is free software; you can redistribute it and/or
   7  * modify it under the terms of the GNU General Public License (GPL)
   8  * version 2 as published by the Free Software Foundation.
   9  *
  10  * This program is distributed in the hope that it will be useful,
  11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13  * file license.txt for more details.
  14  *)
  15 open Common
  16
  17 (*****************************************************************************)
  18 (* Wrappers *)
  19 (*****************************************************************************)
  20 let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_parsing
  21
  22 (*****************************************************************************)
  23 (* Abstract line *)
  24 (*****************************************************************************)
  25
  26 (* todo?: al_expr doit enlever les infos de type ? et doit remettre en
  27  *  emptyAnnot ?
  28
  29 No!  Keeping the type information is important to ensuring that variables
  30 of different type and declared in different places do not seem to match
  31 each other.  On the other hand, we don't want to keep around the
  32 information about whether the expression is a test expression, because a
  33 term that is a test expression should match one that is not.  The test
  34 information is only useful for matching to the CTL.
  35
  36  *)
  37
  38 (* drop all info information *)
  39
  40 let strip_info_visitor _ =
  41   let drop_test ty =
  42     let (ty,_) = !ty in
  43     ref (ty,Ast_c.NotTest) in
  44
  45   { Visitor_c.default_visitor_c_s with
  46     Visitor_c.kinfo_s =
  47     (* traversal should be deterministic... *)
  48     (let ctr = ref 0 in
  49     (function (k,_) ->
  50     function i -> ctr := !ctr + 1; Ast_c.al_info_cpp !ctr i));
  51
  52     Visitor_c.kexpr_s = (fun (k,_) e ->
  53       let (e', ty), ii' = k e in
  54       (e', drop_test ty), ii' (* keep type - jll *)
  55     );
  56
  57 (*
  58     Visitor_c.ktype_s = (fun (k,_) ft ->
  59       let ft' = k ft in
  60       match Ast_c.unwrap_typeC ft' with
  61       | Ast_c.TypeName (s,_typ) ->
  62           Ast_c.TypeName (s, Ast_c.noTypedefDef()) +> Ast_c.rewrap_typeC ft'
  63       | _ -> ft'
  64
  65     );
  66 *)
  67
  68   }
  69
  70 let al_expr      x = Visitor_c.vk_expr_s      (strip_info_visitor()) x
  71 let al_statement x = Visitor_c.vk_statement_s (strip_info_visitor()) x
  72 let al_type      x = Visitor_c.vk_type_s      (strip_info_visitor()) x
  73 let al_init      x = Visitor_c.vk_ini_s       (strip_info_visitor()) x
  74 let al_param     x = Visitor_c.vk_param_s     (strip_info_visitor()) x
  75 let al_params    x = Visitor_c.vk_params_s    (strip_info_visitor()) x
  76 let al_arguments x = Visitor_c.vk_arguments_s (strip_info_visitor()) x
  77 let al_fields    x = Visitor_c.vk_struct_fields_s (strip_info_visitor()) x
  78
  79 let al_node      x = Visitor_c.vk_node_s      (strip_info_visitor()) x
  80
  81 let al_program  x = List.map (Visitor_c.vk_toplevel_s (strip_info_visitor())) x
  82 let al_ii    x = Visitor_c.vk_ii_s (strip_info_visitor()) x
  83
  84
  85
  86
  87 let strip_inh_info_visitor _ =  (* for inherited metavariables *)
  88   let drop_test_lv ty =
  89     let (ty,_) = !ty in
  90     let ty =
  91       match ty with
  92         None -> None
  93       | Some (ty,_) -> Some (ty,Ast_c.NotLocalVar) in
  94     ref (ty,Ast_c.NotTest) in
  95
  96   { Visitor_c.default_visitor_c_s with
  97     Visitor_c.kinfo_s =
  98     (* traversal should be deterministic... *)
  99     (let ctr = ref 0 in
 100     (function (k,_) ->
 101     function i -> ctr := !ctr + 1; Ast_c.al_info_cpp !ctr i));
 102
 103     Visitor_c.kexpr_s = (fun (k,_) e ->
 104       let (e', ty), ii' = k e in
 105       (e', drop_test_lv ty), ii' (* keep type - jll *)
 106     );
 107
 108 (*
 109     Visitor_c.ktype_s = (fun (k,_) ft ->
 110       let ft' = k ft in
 111       match Ast_c.unwrap_typeC ft' with
 112       | Ast_c.TypeName (s,_typ) ->
 113           Ast_c.TypeName (s, Ast_c.noTypedefDef()) +> Ast_c.rewrap_typeC ft'
 114       | _ -> ft'
 115
 116     );
 117 *)
 118
 119   }
 120
 121 let al_inh_expr      x = Visitor_c.vk_expr_s      (strip_inh_info_visitor()) x
 122 let al_inh_statement x = Visitor_c.vk_statement_s (strip_inh_info_visitor()) x
 123 let al_inh_type      x = Visitor_c.vk_type_s      (strip_inh_info_visitor()) x
 124 let al_inh_init      x = Visitor_c.vk_ini_s       (strip_inh_info_visitor()) x
 125 let al_inh_arguments x = Visitor_c.vk_arguments_s (strip_inh_info_visitor()) x
 126
 127
 128
 129 let semi_strip_info_visitor = (* keep position information *)
 130   let drop_test ty =
 131     let (ty,_) = !ty in
 132     ref (ty,Ast_c.NotTest) in
 133
 134   { Visitor_c.default_visitor_c_s with
 135     Visitor_c.kinfo_s = (fun (k,_) i -> Ast_c.semi_al_info_cpp i);
 136
 137     Visitor_c.kexpr_s = (fun (k,_) e ->
 138       let (e', ty),ii' = k e in
 139       (e', drop_test ty), ii' (* keep type - jll *)
 140     );
 141
 142   }
 143
 144 let semi_al_expr      = Visitor_c.vk_expr_s      semi_strip_info_visitor
 145 let semi_al_statement = Visitor_c.vk_statement_s semi_strip_info_visitor
 146 let semi_al_type      = Visitor_c.vk_type_s      semi_strip_info_visitor
 147 let semi_al_init      = Visitor_c.vk_ini_s       semi_strip_info_visitor
 148 let semi_al_param     = Visitor_c.vk_param_s     semi_strip_info_visitor
 149 let semi_al_params    = Visitor_c.vk_params_s    semi_strip_info_visitor
 150 let semi_al_arguments = Visitor_c.vk_arguments_s semi_strip_info_visitor
 151
 152 let semi_al_program =
 153   List.map (Visitor_c.vk_toplevel_s semi_strip_info_visitor)
 154
 155
 156
 157
 158 (* really strip, do not keep position nor anything specificities, true
 159  * abstracted form. This is used outside coccinelle in Yacfe and aComment *)
 160 let real_strip_info_visitor _ =
 161   { Visitor_c.default_visitor_c_s with
 162     Visitor_c.kinfo_s = (fun (k,_) i ->
 163       Ast_c.real_al_info_cpp i
 164     );
 165
 166     Visitor_c.kexpr_s = (fun (k,_) e ->
 167       let (e', ty),ii' = k e in
 168       (e', Ast_c.noType()), ii'
 169     );
 170
 171 (*
 172     Visitor_c.ktype_s = (fun (k,_) ft ->
 173       let ft' = k ft in
 174       match Ast_c.unwrap_typeC ft' with
 175       | Ast_c.TypeName (s,_typ) ->
 176           Ast_c.TypeName (s, Ast_c.noTypedefDef()) +> Ast_c.rewrap_typeC ft'
 177       | _ -> ft'
 178
 179     );
 180 *)
 181
 182   }
 183
 184 let real_al_expr      x = Visitor_c.vk_expr_s   (real_strip_info_visitor()) x
 185 let real_al_node      x = Visitor_c.vk_node_s   (real_strip_info_visitor()) x
 186 let real_al_type      x = Visitor_c.vk_type_s   (real_strip_info_visitor()) x
 187
 188
 189 (*****************************************************************************)
 190 (* Extract infos *)
 191 (*****************************************************************************)
 192
 193 let extract_info_visitor recursor x =
 194   let globals = ref [] in
 195   let visitor =
 196     {
 197       Visitor_c.default_visitor_c with
 198         Visitor_c.kinfo = (fun (k, _) i -> Common.push2 i globals)
 199     } in
 200   begin
 201     recursor visitor x;
 202     !globals
 203   end
 204
 205 let ii_of_decl = extract_info_visitor Visitor_c.vk_decl
 206 let ii_of_node = extract_info_visitor Visitor_c.vk_node
 207 let ii_of_expr = extract_info_visitor Visitor_c.vk_expr
 208 let ii_of_stmt = extract_info_visitor Visitor_c.vk_statement
 209 let ii_of_args = extract_info_visitor Visitor_c.vk_args_splitted
 210 let ii_of_type = extract_info_visitor Visitor_c.vk_type
 211 let ii_of_ini  = extract_info_visitor Visitor_c.vk_ini
 212 let ii_of_param = extract_info_visitor Visitor_c.vk_param
 213 let ii_of_params = extract_info_visitor Visitor_c.vk_params_splitted
 214 let ii_of_struct_fields = extract_info_visitor Visitor_c.vk_struct_fields
 215 (*let ii_of_struct_field = extract_info_visitor Visitor_c.vk_struct_field*)
 216 let ii_of_struct_fieldkinds = extract_info_visitor Visitor_c.vk_struct_fieldkinds
 217 let ii_of_cst = extract_info_visitor Visitor_c.vk_cst
 218 let ii_of_define_params =
 219   extract_info_visitor Visitor_c.vk_define_params_splitted
 220 let ii_of_toplevel = extract_info_visitor Visitor_c.vk_toplevel
 221
 222 (*****************************************************************************)
 223 (* Max min, range *)
 224 (*****************************************************************************)
 225 let max_min_ii_by_pos xs =
 226   match xs with
 227   | [] -> failwith "empty list, max_min_ii_by_pos"
 228   | [x] -> (x, x)
 229   | x::xs ->
 230       let pos_leq p1 p2 = (Ast_c.compare_pos p1 p2) =|= (-1) in
 231       xs +> List.fold_left (fun (maxii,minii) e ->
 232         let maxii' = if pos_leq maxii e then e else maxii in
 233         let minii' = if pos_leq e minii then e else minii in
 234         maxii', minii'
 235       ) (x,x)
 236
 237 let info_to_fixpos ii =
 238   match Ast_c.pinfo_of_info ii with
 239     Ast_c.OriginTok pi -> Ast_cocci.Real pi.Common.charpos
 240   | Ast_c.ExpandedTok (_,(pi,offset)) ->
 241       Ast_cocci.Virt (pi.Common.charpos,offset)
 242   | Ast_c.FakeTok (_,(pi,offset)) ->
 243       Ast_cocci.Virt (pi.Common.charpos,offset)
 244   | Ast_c.AbstractLineTok pi -> failwith "unexpected abstract"
 245
 246 let max_min_by_pos xs =
 247   let (i1, i2) = max_min_ii_by_pos xs in
 248   (info_to_fixpos i1, info_to_fixpos i2)
 249
 250 let lin_col_by_pos xs =
 251   (* put min before max; no idea why they are backwards above *)
 252   let non_fake = List.filter (function ii -> not (Ast_c.is_fake ii)) xs in
 253   let (i2, i1) = max_min_ii_by_pos non_fake in
 254   let posf x = Ast_c.col_of_info x in
 255   let mposf x = Ast_c.col_of_info x + String.length (Ast_c.str_of_info x) in
 256   (Ast_c.file_of_info i1,!Flag.current_element,
 257    (Ast_c.line_of_info i1, posf i1), (Ast_c.line_of_info i2, mposf i2))
 258
 259
 260
 261
 262
 263 let min_pinfo_of_node node =
 264   let ii = ii_of_node node in
 265   let (maxii, minii) = max_min_ii_by_pos ii in
 266   Ast_c.parse_info_of_info minii
 267
 268
 269 let (range_of_origin_ii: Ast_c.info list -> (int * int) option) =
 270  fun ii ->
 271   let ii = List.filter Ast_c.is_origintok ii in
 272   try
 273     let (max, min) = max_min_ii_by_pos ii in
 274     assert(Ast_c.is_origintok max);
 275     assert(Ast_c.is_origintok min);
 276     let strmax = Ast_c.str_of_info max in
 277     Some
 278       (Ast_c.pos_of_info min, Ast_c.pos_of_info max + String.length strmax)
 279   with _ ->
 280     None
 281
 282
 283 (*****************************************************************************)
 284 (* Ast getters *)
 285 (*****************************************************************************)
 286
 287 let names_of_parameters_in_def def =
 288   match def.Ast_c.f_old_c_style with
 289   | Some _ ->
 290       pr2_once "names_of_parameters_in_def: f_old_c_style not handled";
 291       []
 292   | None ->
 293       let ftyp = def.Ast_c.f_type in
 294       let (ret, (params, bwrap)) = ftyp in
 295       params +> Common.map_filter (fun (param,ii) ->
 296         Ast_c.name_of_parameter param
 297       )
 298
 299 let names_of_parameters_in_macro xs =
 300   xs +> List.map (fun (xx, ii) ->
 301     let (s, ii2) = xx in
 302     s
 303   )
 304
 305
 306
 307 (* only used in ast_to_flow, so move it ? *)
 308 let rec stmt_elems_of_sequencable xs =
 309   xs +> Common.map (fun x ->
 310     match x with
 311     | Ast_c.StmtElem e -> [e]
 312     | Ast_c.CppDirectiveStmt _
 313     | Ast_c.IfdefStmt _
 314         ->
 315         pr2_once ("stmt_elems_of_sequencable: filter a directive");
 316         []
 317     | Ast_c.IfdefStmt2 (_ifdef, xxs) ->
 318         pr2 ("stmt_elems_of_sequencable: IfdefStm2 TODO?");
 319         xxs +> List.map (fun xs ->
 320           let xs' = stmt_elems_of_sequencable xs in
 321           xs'
 322         ) +> List.flatten
 323   ) +> List.flatten
 324
 325
 326