parsing_c/lib_parsing_c.ml

   1 (* Copyright (C) 2007, 2008 Yoann Padioleau
   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  *)
  12 open Common
  13
  14 (*****************************************************************************)
  15 (* Abstract line *)
  16 (*****************************************************************************)
  17
  18 (* todo?: al_expr doit enlever les infos de type ? et doit remettre en
  19  *  emptyAnnot ?
  20  *)
  21
  22 (* drop all info information *)
  23
  24 let strip_info_visitor _ =
  25   { Visitor_c.default_visitor_c_s with
  26     Visitor_c.kinfo_s =
  27     (* traversal should be deterministic... *)
  28     (let ctr = ref 0 in
  29     (function (k,_) ->
  30     function i -> ctr := !ctr + 1; Ast_c.al_info !ctr i));
  31
  32     Visitor_c.kexpr_s = (fun (k,_) e ->
  33       let (e', ty),ii' = k e in
  34       (e', Ast_c.noType()(*ref !ty*)), ii' (* keep type - jll *)
  35     );
  36
  37 (*
  38     Visitor_c.ktype_s = (fun (k,_) ft ->
  39       let ft' = k ft in
  40       match Ast_c.unwrap_typeC ft' with
  41       | Ast_c.TypeName (s,_typ) ->
  42           Ast_c.TypeName (s, Ast_c.noTypedefDef()) +> Ast_c.rewrap_typeC ft'
  43       | _ -> ft'
  44
  45     );
  46 *)
  47
  48   }
  49
  50 let al_expr      x = Visitor_c.vk_expr_s      (strip_info_visitor()) x
  51 let al_statement x = Visitor_c.vk_statement_s (strip_info_visitor()) x
  52 let al_type      x = Visitor_c.vk_type_s      (strip_info_visitor()) x
  53 let al_param     x = Visitor_c.vk_param_s     (strip_info_visitor()) x
  54 let al_params    x = Visitor_c.vk_params_s    (strip_info_visitor()) x
  55 let al_arguments x = Visitor_c.vk_arguments_s (strip_info_visitor()) x
  56 let al_fields    x = Visitor_c.vk_struct_fields_s (strip_info_visitor()) x
  57
  58 let al_node      x = Visitor_c.vk_node_s      (strip_info_visitor()) x
  59
  60 let al_program  x = List.map (Visitor_c.vk_toplevel_s (strip_info_visitor())) x
  61 let al_ii    x = Visitor_c.vk_ii_s (strip_info_visitor()) x
  62
  63
  64
  65
  66
  67
  68 let semi_strip_info_visitor = (* keep position information *)
  69   { Visitor_c.default_visitor_c_s with
  70     Visitor_c.kinfo_s = (fun (k,_) i -> Ast_c.semi_al_info i);
  71
  72     Visitor_c.kexpr_s = (fun (k,_) e ->
  73       let (e', ty),ii' = k e in
  74       (e', Ast_c.noType()(*ref !ty*)), ii' (* keep type - jll *)
  75     );
  76
  77   }
  78
  79 let semi_al_expr      = Visitor_c.vk_expr_s      semi_strip_info_visitor
  80 let semi_al_statement = Visitor_c.vk_statement_s semi_strip_info_visitor
  81 let semi_al_type      = Visitor_c.vk_type_s      semi_strip_info_visitor
  82 let semi_al_param     = Visitor_c.vk_param_s     semi_strip_info_visitor
  83 let semi_al_params    = Visitor_c.vk_params_s    semi_strip_info_visitor
  84 let semi_al_arguments = Visitor_c.vk_arguments_s semi_strip_info_visitor
  85
  86 let semi_al_program = List.map (Visitor_c.vk_toplevel_s semi_strip_info_visitor)
  87
  88
  89
  90
  91
  92 let real_strip_info_visitor _ =
  93   { Visitor_c.default_visitor_c_s with
  94     Visitor_c.kinfo_s = (fun (k,_) i ->
  95       Ast_c.real_al_info i
  96     );
  97
  98     Visitor_c.kexpr_s = (fun (k,_) e ->
  99       let (e', ty),ii' = k e in
 100       (e', Ast_c.noType()), ii'
 101     );
 102
 103 (*
 104     Visitor_c.ktype_s = (fun (k,_) ft ->
 105       let ft' = k ft in
 106       match Ast_c.unwrap_typeC ft' with
 107       | Ast_c.TypeName (s,_typ) ->
 108           Ast_c.TypeName (s, Ast_c.noTypedefDef()) +> Ast_c.rewrap_typeC ft'
 109       | _ -> ft'
 110
 111     );
 112 *)
 113
 114   }
 115
 116 let real_al_expr      x = Visitor_c.vk_expr_s   (real_strip_info_visitor()) x
 117 let real_al_node      x = Visitor_c.vk_node_s   (real_strip_info_visitor()) x
 118 let real_al_type      x = Visitor_c.vk_type_s   (real_strip_info_visitor()) x
 119
 120
 121 (*****************************************************************************)
 122 (* Extract infos *)
 123 (*****************************************************************************)
 124
 125 let extract_info_visitor recursor x =
 126   let globals = ref [] in
 127   let visitor =
 128     {
 129       Visitor_c.default_visitor_c with
 130         Visitor_c.kinfo = (fun (k, _) i -> Common.push2 i globals)
 131     } in
 132   begin
 133     recursor visitor x;
 134     !globals
 135   end
 136
 137 let ii_of_decl = extract_info_visitor Visitor_c.vk_decl
 138 let ii_of_node = extract_info_visitor Visitor_c.vk_node
 139 let ii_of_expr = extract_info_visitor Visitor_c.vk_expr
 140 let ii_of_stmt = extract_info_visitor Visitor_c.vk_statement
 141 let ii_of_args = extract_info_visitor Visitor_c.vk_args_splitted
 142 let ii_of_type = extract_info_visitor Visitor_c.vk_type
 143 let ii_of_ini  = extract_info_visitor Visitor_c.vk_ini
 144 let ii_of_param = extract_info_visitor Visitor_c.vk_param
 145 let ii_of_params = extract_info_visitor Visitor_c.vk_params_splitted
 146 let ii_of_struct_fields = extract_info_visitor Visitor_c.vk_struct_fields
 147 (*let ii_of_struct_field = extract_info_visitor Visitor_c.vk_struct_field*)
 148 let ii_of_struct_fieldkinds = extract_info_visitor Visitor_c.vk_struct_fieldkinds
 149 let ii_of_cst = extract_info_visitor Visitor_c.vk_cst
 150 let ii_of_define_params =
 151   extract_info_visitor Visitor_c.vk_define_params_splitted
 152 let ii_of_toplevel = extract_info_visitor Visitor_c.vk_toplevel
 153
 154 (*****************************************************************************)
 155 (* Max min, range *)
 156 (*****************************************************************************)
 157 let max_min_ii_by_pos xs =
 158   match xs with
 159   | [] -> failwith "empty list, max_min_ii_by_pos"
 160   | [x] -> (x, x)
 161   | x::xs ->
 162       let pos_leq p1 p2 = (Ast_c.compare_pos p1 p2) = (-1) in
 163       xs +> List.fold_left (fun (maxii,minii) e ->
 164         let maxii' = if pos_leq maxii e then e else maxii in
 165         let minii' = if pos_leq e minii then e else minii in
 166         maxii', minii'
 167       ) (x,x)
 168
 169 let info_to_fixpos ii =
 170   match Ast_c.pinfo_of_info ii with
 171     Ast_c.OriginTok pi -> Ast_cocci.Real pi.Common.charpos
 172   | Ast_c.ExpandedTok (_,(pi,offset)) ->
 173       Ast_cocci.Virt (pi.Common.charpos,offset)
 174   | Ast_c.FakeTok (_,(pi,offset)) ->
 175       Ast_cocci.Virt (pi.Common.charpos,offset)
 176   | Ast_c.AbstractLineTok pi -> failwith "unexpected abstract"
 177
 178 let max_min_by_pos xs =
 179   let (i1, i2) = max_min_ii_by_pos xs in
 180   (info_to_fixpos i1, info_to_fixpos i2)
 181
 182 let lin_col_by_pos xs =
 183   (* put min before max; no idea why they are backwards above *)
 184   let (i2, i1) = max_min_ii_by_pos xs in
 185   let posf x = Ast_c.col_of_info x in
 186   let mposf x = Ast_c.col_of_info x + String.length (Ast_c.str_of_info x) in
 187   (Ast_c.file_of_info i1,!Flag.current_element,
 188    (Ast_c.line_of_info i1, posf i1), (Ast_c.line_of_info i2, mposf i2))
 189
 190
 191
 192
 193
 194 let min_pinfo_of_node node =
 195   let ii = ii_of_node node in
 196   let (maxii, minii) = max_min_ii_by_pos ii in
 197   Ast_c.parse_info_of_info minii
 198
 199
 200 let (range_of_origin_ii: Ast_c.info list -> (int * int) option) =
 201  fun ii ->
 202   let ii = List.filter Ast_c.is_origintok ii in
 203   try
 204     let (max, min) = max_min_ii_by_pos ii in
 205     assert(Ast_c.is_origintok max);
 206     assert(Ast_c.is_origintok min);
 207     let strmax = Ast_c.str_of_info max in
 208     Some
 209       (Ast_c.pos_of_info min, Ast_c.pos_of_info max + String.length strmax)
 210   with _ ->
 211     None