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_declaration x = Visitor_c.vk_decl_s    (strip_info_visitor()) x
  72 let al_field     x = Visitor_c.vk_struct_field_s (strip_info_visitor()) x
  73 let al_statement x = Visitor_c.vk_statement_s (strip_info_visitor()) x
  74 let al_type      x = Visitor_c.vk_type_s      (strip_info_visitor()) x
  75 let al_init      x = Visitor_c.vk_ini_s       (strip_info_visitor()) x
  76 let al_inits     x = Visitor_c.vk_inis_s      (strip_info_visitor()) x
  77 let al_param     x = Visitor_c.vk_param_s     (strip_info_visitor()) x
  78 let al_params    x = Visitor_c.vk_params_s    (strip_info_visitor()) x
  79 let al_arguments x = Visitor_c.vk_arguments_s (strip_info_visitor()) x
  80 let al_fields    x = Visitor_c.vk_struct_fields_s (strip_info_visitor()) x
  81 let al_name      x = Visitor_c.vk_name_s      (strip_info_visitor()) x
  82
  83 let al_node      x = Visitor_c.vk_node_s      (strip_info_visitor()) x
  84
  85 let al_program  x = List.map (Visitor_c.vk_toplevel_s (strip_info_visitor())) x
  86 let al_ii    x = Visitor_c.vk_ii_s (strip_info_visitor()) x
  87
  88
  89
  90
  91 let strip_inh_info_visitor _ =  (* for inherited metavariables *)
  92   let drop_test_lv ty =
  93     let (ty,_) = !ty in
  94     let ty =
  95       match ty with
  96         None -> None
  97       | Some (ty,_) -> Some (ty,Ast_c.NotLocalVar) in
  98     ref (ty,Ast_c.NotTest) in
  99
 100   { Visitor_c.default_visitor_c_s with
 101     Visitor_c.kinfo_s =
 102     (* traversal should be deterministic... *)
 103     (let ctr = ref 0 in
 104     (function (k,_) ->
 105     function i -> ctr := !ctr + 1; Ast_c.al_info_cpp !ctr i));
 106
 107     Visitor_c.kexpr_s = (fun (k,_) e ->
 108       let (e', ty), ii' = k e in
 109       (e', drop_test_lv ty), ii' (* keep type - jll *)
 110     );
 111
 112 (*
 113     Visitor_c.ktype_s = (fun (k,_) ft ->
 114       let ft' = k ft in
 115       match Ast_c.unwrap_typeC ft' with
 116       | Ast_c.TypeName (s,_typ) ->
 117           Ast_c.TypeName (s, Ast_c.noTypedefDef()) +> Ast_c.rewrap_typeC ft'
 118       | _ -> ft'
 119
 120     );
 121 *)
 122
 123   }
 124
 125 let al_inh_expr      x = Visitor_c.vk_expr_s      (strip_inh_info_visitor()) x
 126 let al_inh_declaration x = Visitor_c.vk_decl_s    (strip_inh_info_visitor()) x
 127 let al_inh_field    x = Visitor_c.vk_struct_field_s (strip_inh_info_visitor()) x
 128 let al_inh_field_list x =
 129   Visitor_c.vk_struct_fields_s (strip_inh_info_visitor()) x
 130 let al_inh_statement x = Visitor_c.vk_statement_s (strip_inh_info_visitor()) x
 131 let al_inh_type      x = Visitor_c.vk_type_s      (strip_inh_info_visitor()) x
 132 let al_inh_init      x = Visitor_c.vk_ini_s       (strip_inh_info_visitor()) x
 133 let al_inh_inits     x = Visitor_c.vk_inis_s      (strip_inh_info_visitor()) x
 134 let al_inh_arguments x = Visitor_c.vk_arguments_s (strip_inh_info_visitor()) x
 135
 136
 137
 138 let semi_strip_info_visitor = (* keep position information *)
 139   let drop_test ty =
 140     let (ty,_) = !ty in
 141     ref (ty,Ast_c.NotTest) in
 142
 143   { Visitor_c.default_visitor_c_s with
 144     Visitor_c.kinfo_s = (fun (k,_) i -> Ast_c.semi_al_info_cpp i);
 145
 146     Visitor_c.kexpr_s = (fun (k,_) e ->
 147       let (e', ty),ii' = k e in
 148       (e', drop_test ty), ii' (* keep type - jll *)
 149     );
 150
 151   }
 152
 153 let semi_al_expr      = Visitor_c.vk_expr_s      semi_strip_info_visitor
 154 let semi_al_declaration = Visitor_c.vk_decl_s    semi_strip_info_visitor
 155 let semi_al_field = Visitor_c.vk_struct_field_s  semi_strip_info_visitor
 156 let semi_al_fields = Visitor_c.vk_struct_fields_s semi_strip_info_visitor
 157 let semi_al_statement = Visitor_c.vk_statement_s semi_strip_info_visitor
 158 let semi_al_type      = Visitor_c.vk_type_s      semi_strip_info_visitor
 159 let semi_al_init      = Visitor_c.vk_ini_s       semi_strip_info_visitor
 160 let semi_al_inits     = Visitor_c.vk_inis_s      semi_strip_info_visitor
 161 let semi_al_param     = Visitor_c.vk_param_s     semi_strip_info_visitor
 162 let semi_al_params    = Visitor_c.vk_params_s    semi_strip_info_visitor
 163 let semi_al_arguments = Visitor_c.vk_arguments_s semi_strip_info_visitor
 164
 165 let semi_al_program =
 166   List.map (Visitor_c.vk_toplevel_s semi_strip_info_visitor)
 167
 168
 169
 170
 171 (* really strip, do not keep position nor anything specificities, true
 172  * abstracted form. This is used outside coccinelle in Yacfe and aComment *)
 173 let real_strip_info_visitor _ =
 174   { Visitor_c.default_visitor_c_s with
 175     Visitor_c.kinfo_s = (fun (k,_) i ->
 176       Ast_c.real_al_info_cpp i
 177     );
 178
 179     Visitor_c.kexpr_s = (fun (k,_) e ->
 180       let (e', ty),ii' = k e in
 181       (e', Ast_c.noType()), ii'
 182     );
 183
 184 (*
 185     Visitor_c.ktype_s = (fun (k,_) ft ->
 186       let ft' = k ft in
 187       match Ast_c.unwrap_typeC ft' with
 188       | Ast_c.TypeName (s,_typ) ->
 189           Ast_c.TypeName (s, Ast_c.noTypedefDef()) +> Ast_c.rewrap_typeC ft'
 190       | _ -> ft'
 191
 192     );
 193 *)
 194
 195   }
 196
 197 let real_al_expr      x = Visitor_c.vk_expr_s   (real_strip_info_visitor()) x
 198 let real_al_arguments x = Visitor_c.vk_arguments_s (real_strip_info_visitor()) x
 199 let real_al_node      x = Visitor_c.vk_node_s   (real_strip_info_visitor()) x
 200 let real_al_type      x = Visitor_c.vk_type_s   (real_strip_info_visitor()) x
 201 let real_al_decl      x = Visitor_c.vk_decl_s   (real_strip_info_visitor()) x
 202 let real_al_init      x = Visitor_c.vk_ini_s    (real_strip_info_visitor()) x
 203 let real_al_inits     x = Visitor_c.vk_inis_s   (real_strip_info_visitor()) x
 204 let real_al_statement x = Visitor_c.vk_statement_s (real_strip_info_visitor()) x
 205 let real_al_def       x = Visitor_c.vk_toplevel_s (real_strip_info_visitor()) x
 206
 207 (*****************************************************************************)
 208 (* Extract infos *)
 209 (*****************************************************************************)
 210
 211 let extract_info_visitor recursor x =
 212   let globals = ref [] in
 213   let visitor =
 214     {
 215       Visitor_c.default_visitor_c with
 216         Visitor_c.kinfo = (fun (k, _) i -> Common.push2 i globals)
 217     } in
 218   begin
 219     recursor visitor x;
 220     !globals
 221   end
 222
 223 let ii_of_decl = extract_info_visitor Visitor_c.vk_decl
 224 let ii_of_field = extract_info_visitor Visitor_c.vk_struct_field
 225 let ii_of_node = extract_info_visitor Visitor_c.vk_node
 226 let ii_of_expr = extract_info_visitor Visitor_c.vk_expr
 227 let ii_of_stmt = extract_info_visitor Visitor_c.vk_statement
 228 let ii_of_args = extract_info_visitor Visitor_c.vk_args_splitted
 229 let ii_of_type = extract_info_visitor Visitor_c.vk_type
 230 let ii_of_ini  = extract_info_visitor Visitor_c.vk_ini
 231 let ii_of_inis  = extract_info_visitor Visitor_c.vk_inis_splitted
 232 let ii_of_param = extract_info_visitor Visitor_c.vk_param
 233 let ii_of_params = extract_info_visitor Visitor_c.vk_params_splitted
 234 let ii_of_enum_fields = extract_info_visitor Visitor_c.vk_enum_fields_splitted
 235 let ii_of_struct_fields = extract_info_visitor Visitor_c.vk_struct_fields
 236 (*let ii_of_struct_field = extract_info_visitor Visitor_c.vk_struct_field*)
 237 let ii_of_struct_fieldkinds = extract_info_visitor Visitor_c.vk_struct_fieldkinds
 238 let ii_of_cst = extract_info_visitor Visitor_c.vk_cst
 239 let ii_of_define_params =
 240   extract_info_visitor Visitor_c.vk_define_params_splitted
 241 let ii_of_toplevel = extract_info_visitor Visitor_c.vk_toplevel
 242
 243 (*****************************************************************************)
 244 (* Max min, range *)
 245 (*****************************************************************************)
 246 let max_min_ii_by_pos xs =
 247   match xs with
 248   | [] -> failwith "empty list, max_min_ii_by_pos"
 249   | [x] -> (x, x)
 250   | x::xs ->
 251       let pos_leq p1 p2 = (Ast_c.compare_pos p1 p2) =|= (-1) in
 252       xs +> List.fold_left (fun (maxii,minii) e ->
 253         let maxii' = if pos_leq maxii e then e else maxii in
 254         let minii' = if pos_leq e minii then e else minii in
 255         maxii', minii'
 256       ) (x,x)
 257
 258 let info_to_fixpos ii =
 259   match Ast_c.pinfo_of_info ii with
 260     Ast_c.OriginTok pi -> Ast_cocci.Real pi.Common.charpos
 261   | Ast_c.ExpandedTok (_,(pi,offset)) ->
 262       Ast_cocci.Virt (pi.Common.charpos,offset)
 263   | Ast_c.FakeTok (_,(pi,offset)) ->
 264       Ast_cocci.Virt (pi.Common.charpos,offset)
 265   | Ast_c.AbstractLineTok pi -> failwith "unexpected abstract"
 266
 267 let max_min_by_pos xs =
 268   let (i1, i2) = max_min_ii_by_pos xs in
 269   (info_to_fixpos i1, info_to_fixpos i2)
 270
 271 let lin_col_by_pos xs =
 272   (* put min before max; no idea why they are backwards above *)
 273   let non_fake = List.filter (function ii -> not (Ast_c.is_fake ii)) xs in
 274   let (i2, i1) = max_min_ii_by_pos non_fake in
 275   let posf x = Ast_c.col_of_info x in
 276   let mposf x = Ast_c.col_of_info x + String.length (Ast_c.str_of_info x) in
 277   (Ast_c.file_of_info i1,!Flag.current_element,
 278    (Ast_c.line_of_info i1, posf i1), (Ast_c.line_of_info i2, mposf i2))
 279
 280
 281
 282
 283
 284 let min_pinfo_of_node node =
 285   let ii = ii_of_node node in
 286   let (maxii, minii) = max_min_ii_by_pos ii in
 287   Ast_c.parse_info_of_info minii
 288
 289
 290 let (range_of_origin_ii: Ast_c.info list -> (int * int) option) =
 291  fun ii ->
 292   let ii = List.filter Ast_c.is_origintok ii in
 293   try
 294     let (max, min) = max_min_ii_by_pos ii in
 295     assert(Ast_c.is_origintok max);
 296     assert(Ast_c.is_origintok min);
 297     let strmax = Ast_c.str_of_info max in
 298     Some
 299       (Ast_c.pos_of_info min, Ast_c.pos_of_info max + String.length strmax)
 300   with _ ->
 301     None
 302
 303
 304 (*****************************************************************************)
 305 (* Ast getters *)
 306 (*****************************************************************************)
 307
 308 let names_of_parameters_in_def def =
 309   match def.Ast_c.f_old_c_style with
 310   | Some _ ->
 311       pr2_once "names_of_parameters_in_def: f_old_c_style not handled";
 312       []
 313   | None ->
 314       let ftyp = def.Ast_c.f_type in
 315       let (ret, (params, bwrap)) = ftyp in
 316       params +> Common.map_filter (fun (param,ii) ->
 317         Ast_c.name_of_parameter param
 318       )
 319
 320 let names_of_parameters_in_macro xs =
 321   xs +> List.map (fun (xx, ii) ->
 322     let (s, ii2) = xx in
 323     s
 324   )
 325
 326
 327
 328 (* only used in ast_to_flow, so move it ? *)
 329 let rec stmt_elems_of_sequencable xs =
 330   xs +> Common.map (fun x ->
 331     match x with
 332     | Ast_c.StmtElem e -> [e]
 333     | Ast_c.CppDirectiveStmt _
 334     | Ast_c.IfdefStmt _
 335         ->
 336         pr2_once ("stmt_elems_of_sequencable: filter a directive");
 337         []
 338     | Ast_c.IfdefStmt2 (_ifdef, xxs) ->
 339         pr2 ("stmt_elems_of_sequencable: IfdefStm2 TODO?");
 340         xxs +> List.map (fun xs ->
 341           let xs' = stmt_elems_of_sequencable xs in
 342           xs'
 343         ) +> List.flatten
 344   ) +> List.flatten
 345
 346
 347