parsing_c/parsing_consistency_c.ml

   1 (* Yoann Padioleau
   2  *
   3  * Copyright (C) 2010, University of Copenhagen DIKU and INRIA.
   4  * Copyright (C) 2006, 2007, 2008 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
  16 open Common
  17
  18
  19 (*****************************************************************************)
  20 (* Wrappers *)
  21 (*****************************************************************************)
  22 let pr2_err, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_parsing
  23
  24 (*****************************************************************************)
  25 (* Consistency checking *)
  26 (*****************************************************************************)
  27
  28 (* todo:
  29  *  could check that an ident has always the same class, be it a typedef
  30  *  (but sometimes do 'acpi_val acpi_val;'), an ident, a TMacroStatement,
  31  *  etc.
  32  *)
  33
  34 type class_ident =
  35   | CIdent (* can be var, func, field, tag, enum constant *)
  36   | CTypedef
  37
  38 let str_of_class_ident = function
  39   | CIdent -> "Ident"
  40   | CTypedef -> "Typedef"
  41
  42 (*
  43   | CMacro
  44   | CMacroString
  45   | CMacroStmt
  46   | CMacroDecl
  47   | CMacroIterator
  48   | CAttr
  49
  50 (* but take care that must still be able to use '=' *)
  51 type context = InFunction | InEnum | InStruct | InInitializer | InParams
  52 type class_token =
  53   | CIdent of class_ident
  54
  55   | CComment
  56   | CSpace
  57   | CCommentCpp of cppkind
  58   | CCommentMisc
  59   | CCppDirective
  60
  61   | COPar
  62   | CCPar
  63   | COBrace
  64   | CCBrace
  65
  66   | CSymbol
  67   | CReservedKwd (type | decl | qualif | flow | misc | attr)
  68 *)
  69
  70 let ident_to_typename ident : Ast_c.fullType =
  71   Ast_c.mk_ty (Ast_c.TypeName  (ident, Ast_c.noTypedefDef())) Ast_c.noii
  72
  73
  74 (* parse_typedef_fix4 *)
  75 let consistency_checking2 xs =
  76
  77   (* first phase, gather data *)
  78   let stat = Hashtbl.create 101 in
  79
  80   (* default value for hash *)
  81   let v1 () = Hashtbl.create 101 in
  82   let v2 () = ref 0 in
  83
  84   let bigf = { Visitor_c.default_visitor_c with
  85
  86     Visitor_c.kexpr = (fun (k,bigf) x ->
  87       match Ast_c.unwrap_expr x with
  88       | Ast_c.Ident (id) ->
  89           let s = Ast_c.str_of_name id in
  90           stat +>
  91             Common.hfind_default s v1 +> Common.hfind_default CIdent v2 +>
  92             (fun aref -> incr aref)
  93
  94       | _ -> k x
  95     );
  96     Visitor_c.ktype = (fun (k,bigf) t ->
  97       match Ast_c.unwrap_typeC t with
  98       | Ast_c.TypeName (name,_typ) ->
  99           let s = Ast_c.str_of_name name in
 100           stat +>
 101             Common.hfind_default s v1 +> Common.hfind_default CTypedef v2 +>
 102             (fun aref -> incr aref)
 103
 104       | _ -> k t
 105     );
 106   }
 107   in
 108   xs +> List.iter (fun (p) -> Visitor_c.vk_toplevel bigf p);
 109
 110
 111   let ident_to_type = ref [] in
 112
 113
 114   (* second phase, analyze data *)
 115   stat +> Hashtbl.iter (fun k v ->
 116     let xs = Common.hash_to_list v in
 117     if List.length xs >= 2
 118     then begin
 119       pr2_err ("TYPEDEF CONFLICT:" ^ k);
 120       let sorted = xs +> List.sort (fun (ka,va) (kb,vb) ->
 121         if !va =|= !vb then
 122           (match ka, kb with
 123           | CTypedef, _ -> 1 (* first is smaller *)
 124           | _, CTypedef -> -1
 125           | _ -> 0
 126           )
 127         else compare !va !vb
 128       ) in
 129       let sorted = List.rev sorted in
 130       match sorted with
 131       | [CTypedef, i1;CIdent, i2] ->
 132           pr2_err ("transforming some ident in typedef");
 133           push2 k ident_to_type;
 134       | [CIdent, i1;CTypedef, i2] ->
 135           pr2_err ("TODO:typedef now used as an identifier");
 136       | _ ->
 137           pr2_err ("TODO:other transforming?");
 138
 139     end
 140   );
 141
 142   (* third phase, update ast.
 143    * todo? but normally should try to handle correctly scope ? maybe sometime
 144    * sizeof(id) and even if id was for a long time an identifier, maybe
 145    * a few time, because of the scope it's actually really a type.
 146    *)
 147   if (null !ident_to_type)
 148   then xs
 149   else
 150     let bigf = { Visitor_c.default_visitor_c_s with
 151       Visitor_c.kdefineval_s = (fun (k,bigf) x ->
 152         match x with
 153         | Ast_c.DefineExpr e ->
 154             (match Ast_c.unwrap_expr e with
 155             | Ast_c.Ident (ident)  ->
 156                 let s = Ast_c.str_of_name ident in
 157                 if List.mem s !ident_to_type
 158                 then
 159                   let t = ident_to_typename ident in
 160                   Ast_c.DefineType t
 161                 else k x
 162             | _ -> k x
 163             )
 164         | _ -> k x
 165       );
 166       Visitor_c.kexpr_s = (fun (k, bigf) x ->
 167         match Ast_c.get_e_and_ii x with
 168         | (Ast_c.SizeOfExpr e, tref), isizeof ->
 169             let i1 = tuple_of_list1 isizeof in
 170             (match Ast_c.get_e_and_ii e with
 171             | (Ast_c.ParenExpr e, _), iiparen ->
 172                 let (i2, i3) = tuple_of_list2 iiparen in
 173                 (match Ast_c.get_e_and_ii e with
 174                 | (Ast_c.Ident (ident), _), _ii  ->
 175
 176                     let s = Ast_c.str_of_name ident in
 177                     if List.mem s !ident_to_type
 178                     then
 179                       let t = ident_to_typename ident in
 180                       (Ast_c.SizeOfType t, tref),[i1;i2;i3]
 181                     else  k x
 182                 | _ -> k x
 183                 )
 184             | _ -> k x
 185             )
 186         | _ -> k x
 187       );
 188     } in
 189     xs +> List.map (fun (p) ->
 190       Visitor_c.vk_toplevel_s bigf p
 191     )
 192
 193
 194 let consistency_checking a  =
 195   Common.profile_code "C consistencycheck" (fun () -> consistency_checking2 a)
 196
 197
 198