parsing_c/lib_parsing_c.ml

   1 (* Yoann Padioleau
   2  *
   3  * Copyright (C) 2007, 2008, 2009 Ecole des Mines de Nantes
   4  *
   5  * This program is free software; you can redistribute it and/or
   6  * modify it under the terms of the GNU General Public License (GPL)
   7  * version 2 as published by the Free Software Foundation.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * file license.txt for more details.
  13  *)
  14 open Common
  15
  16 (*****************************************************************************)
  17 (* Abstract line *)
  18 (*****************************************************************************)
  19
  20 (* todo?: al_expr doit enlever les infos de type ? et doit remettre en
  21  *  emptyAnnot ?
  22  *)
  23
  24 (* drop all info information *)
  25
  26 let strip_info_visitor _ =
  27   { Visitor_c.default_visitor_c_s with
  28     Visitor_c.kinfo_s =
  29     (* traversal should be deterministic... *)
  30     (let ctr = ref 0 in
  31     (function (k,_) ->
  32     function i -> ctr := !ctr + 1; Ast_c.al_info_cpp !ctr i));
  33
  34     Visitor_c.kexpr_s = (fun (k,_) e ->
  35       let (e', ty),ii' = k e in
  36       (e', Ast_c.noType()(*ref !ty*)), ii' (* keep type - jll *)
  37     );
  38
  39 (*
  40     Visitor_c.ktype_s = (fun (k,_) ft ->
  41       let ft' = k ft in
  42       match Ast_c.unwrap_typeC ft' with
  43       | Ast_c.TypeName (s,_typ) ->
  44           Ast_c.TypeName (s, Ast_c.noTypedefDef()) +> Ast_c.rewrap_typeC ft'
  45       | _ -> ft'
  46
  47     );
  48 *)
  49
  50   }
  51
  52 let al_expr      x = Visitor_c.vk_expr_s      (strip_info_visitor()) x
  53 let al_statement x = Visitor_c.vk_statement_s (strip_info_visitor()) x
  54 let al_type      x = Visitor_c.vk_type_s      (strip_info_visitor()) x
  55 let al_init      x = Visitor_c.vk_ini_s       (strip_info_visitor()) x
  56 let al_param     x = Visitor_c.vk_param_s     (strip_info_visitor()) x
  57 let al_params    x = Visitor_c.vk_params_s    (strip_info_visitor()) x
  58 let al_arguments x = Visitor_c.vk_arguments_s (strip_info_visitor()) x
  59 let al_fields    x = Visitor_c.vk_struct_fields_s (strip_info_visitor()) x
  60
  61 let al_node      x = Visitor_c.vk_node_s      (strip_info_visitor()) x
  62
  63 let al_program  x = List.map (Visitor_c.vk_toplevel_s (strip_info_visitor())) x
  64 let al_ii    x = Visitor_c.vk_ii_s (strip_info_visitor()) x
  65
  66
  67
  68
  69
  70
  71 let semi_strip_info_visitor = (* keep position information *)
  72   { Visitor_c.default_visitor_c_s with
  73     Visitor_c.kinfo_s = (fun (k,_) i -> Ast_c.semi_al_info_cpp i);
  74
  75     Visitor_c.kexpr_s = (fun (k,_) e ->
  76       let (e', ty),ii' = k e in
  77       (e', Ast_c.noType()(*ref !ty*)), ii' (* keep type - jll *)
  78     );
  79
  80   }
  81
  82 let semi_al_expr      = Visitor_c.vk_expr_s      semi_strip_info_visitor
  83 let semi_al_statement = Visitor_c.vk_statement_s semi_strip_info_visitor
  84 let semi_al_type      = Visitor_c.vk_type_s      semi_strip_info_visitor
  85 let semi_al_init      = Visitor_c.vk_ini_s       semi_strip_info_visitor
  86 let semi_al_param     = Visitor_c.vk_param_s     semi_strip_info_visitor
  87 let semi_al_params    = Visitor_c.vk_params_s    semi_strip_info_visitor
  88 let semi_al_arguments = Visitor_c.vk_arguments_s semi_strip_info_visitor
  89
  90 let semi_al_program =
  91   List.map (Visitor_c.vk_toplevel_s semi_strip_info_visitor)
  92
  93
  94
  95
  96 (* really strip, do not keep position nor anything specificities, true
  97  * abstracted form. *)
  98 let real_strip_info_visitor _ =
  99   { Visitor_c.default_visitor_c_s with
 100     Visitor_c.kinfo_s = (fun (k,_) i ->
 101       Ast_c.real_al_info_cpp i
 102     );
 103
 104     Visitor_c.kexpr_s = (fun (k,_) e ->
 105       let (e', ty),ii' = k e in
 106       (e', Ast_c.noType()), ii'
 107     );
 108
 109 (*
 110     Visitor_c.ktype_s = (fun (k,_) ft ->
 111       let ft' = k ft in
 112       match Ast_c.unwrap_typeC ft' with
 113       | Ast_c.TypeName (s,_typ) ->
 114           Ast_c.TypeName (s, Ast_c.noTypedefDef()) +> Ast_c.rewrap_typeC ft'
 115       | _ -> ft'
 116
 117     );
 118 *)
 119
 120   }
 121
 122 let real_al_expr      x = Visitor_c.vk_expr_s   (real_strip_info_visitor()) x
 123 let real_al_node      x = Visitor_c.vk_node_s   (real_strip_info_visitor()) x
 124 let real_al_type      x = Visitor_c.vk_type_s   (real_strip_info_visitor()) x
 125
 126
 127 (*****************************************************************************)
 128 (* Extract infos *)
 129 (*****************************************************************************)
 130
 131 let extract_info_visitor recursor x =
 132   let globals = ref [] in
 133   let visitor =
 134     {
 135       Visitor_c.default_visitor_c with
 136         Visitor_c.kinfo = (fun (k, _) i -> Common.push2 i globals)
 137     } in
 138   begin
 139     recursor visitor x;
 140     !globals
 141   end
 142
 143 let ii_of_decl = extract_info_visitor Visitor_c.vk_decl
 144 let ii_of_node = extract_info_visitor Visitor_c.vk_node
 145 let ii_of_expr = extract_info_visitor Visitor_c.vk_expr
 146 let ii_of_stmt = extract_info_visitor Visitor_c.vk_statement
 147 let ii_of_args = extract_info_visitor Visitor_c.vk_args_splitted
 148 let ii_of_type = extract_info_visitor Visitor_c.vk_type
 149 let ii_of_ini  = extract_info_visitor Visitor_c.vk_ini
 150 let ii_of_param = extract_info_visitor Visitor_c.vk_param
 151 let ii_of_params = extract_info_visitor Visitor_c.vk_params_splitted
 152 let ii_of_struct_fields = extract_info_visitor Visitor_c.vk_struct_fields
 153 (*let ii_of_struct_field = extract_info_visitor Visitor_c.vk_struct_field*)
 154 let ii_of_struct_fieldkinds = extract_info_visitor Visitor_c.vk_struct_fieldkinds
 155 let ii_of_cst = extract_info_visitor Visitor_c.vk_cst
 156 let ii_of_define_params =
 157   extract_info_visitor Visitor_c.vk_define_params_splitted
 158 let ii_of_toplevel = extract_info_visitor Visitor_c.vk_toplevel
 159
 160 (*****************************************************************************)
 161 (* Max min, range *)
 162 (*****************************************************************************)
 163 let max_min_ii_by_pos xs =
 164   match xs with
 165   | [] -> failwith "empty list, max_min_ii_by_pos"
 166   | [x] -> (x, x)
 167   | x::xs ->
 168       let pos_leq p1 p2 = (Ast_c.compare_pos p1 p2) =|= (-1) in
 169       xs +> List.fold_left (fun (maxii,minii) e ->
 170         let maxii' = if pos_leq maxii e then e else maxii in
 171         let minii' = if pos_leq e minii then e else minii in
 172         maxii', minii'
 173       ) (x,x)
 174
 175 let info_to_fixpos ii =
 176   match Ast_c.pinfo_of_info ii with
 177     Ast_c.OriginTok pi -> Ast_cocci.Real pi.Common.charpos
 178   | Ast_c.ExpandedTok (_,(pi,offset)) ->
 179       Ast_cocci.Virt (pi.Common.charpos,offset)
 180   | Ast_c.FakeTok (_,(pi,offset)) ->
 181       Ast_cocci.Virt (pi.Common.charpos,offset)
 182   | Ast_c.AbstractLineTok pi -> failwith "unexpected abstract"
 183
 184 let max_min_by_pos xs =
 185   let (i1, i2) = max_min_ii_by_pos xs in
 186   (info_to_fixpos i1, info_to_fixpos i2)
 187
 188 let lin_col_by_pos xs =
 189   (* put min before max; no idea why they are backwards above *)
 190   let (i2, i1) = max_min_ii_by_pos xs in
 191   let posf x = Ast_c.col_of_info x in
 192   let mposf x = Ast_c.col_of_info x + String.length (Ast_c.str_of_info x) in
 193   (Ast_c.file_of_info i1,!Flag.current_element,
 194    (Ast_c.line_of_info i1, posf i1), (Ast_c.line_of_info i2, mposf i2))
 195
 196
 197
 198
 199
 200 let min_pinfo_of_node node =
 201   let ii = ii_of_node node in
 202   let (maxii, minii) = max_min_ii_by_pos ii in
 203   Ast_c.parse_info_of_info minii
 204
 205
 206 let (range_of_origin_ii: Ast_c.info list -> (int * int) option) =
 207  fun ii ->
 208   let ii = List.filter Ast_c.is_origintok ii in
 209   try
 210     let (max, min) = max_min_ii_by_pos ii in
 211     assert(Ast_c.is_origintok max);
 212     assert(Ast_c.is_origintok min);
 213     let strmax = Ast_c.str_of_info max in
 214     Some
 215       (Ast_c.pos_of_info min, Ast_c.pos_of_info max + String.length strmax)
 216   with _ ->
 217     None
 218
 219
 220 (*****************************************************************************)
 221 (* Ast getters *)
 222 (*****************************************************************************)
 223
 224 let names_of_parameters_in_def def =
 225   match def.Ast_c.f_old_c_style with
 226   | Some _ ->
 227       pr2_once "names_of_parameters_in_def: f_old_c_style not handled";
 228       []
 229   | None ->
 230       let ftyp = def.Ast_c.f_type in
 231       let (ret, (params, bwrap)) = ftyp in
 232       params +> Common.map_filter (fun (param,ii) ->
 233         Ast_c.name_of_parameter param
 234       )
 235
 236 let names_of_parameters_in_macro xs =
 237   xs +> List.map (fun (xx, ii) ->
 238     let (s, ii2) = xx in
 239     s
 240   )