← Back to branch summary

~ubuntu-branches/ubuntu/karmic/coccinelle/karmic

« back to all changes in this revision

Viewing changes to parsing_c/type_annoter_c.ml

  • Committer: Bazaar Package Importer
  • Author(s): Євгеній Мещеряков
  • Date: 2009-05-11 15:32:24 UTC
  • mfrom: (1.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090511153224-1odv41d4dkr3y80v
Tags: 0.1.8.deb-2
Use common install Makefile target for both native and bytecode
build. This hopefully fixes FTBFS on bytecode archs 

Show diffs side-by-side

added added

removed removed

Lines of Context:
parsing_c/type_annoter_c.ml
94
94
(*****************************************************************************)
95
95
(* Wrappers *)
96
96
(*****************************************************************************)
97
 
let pr2 s = 
98
 
  if !Flag_parsing_c.verbose_type
99
 
  then Common.pr2 s
100
 
 
101
 
let pr2_once s = 
102
 
  if !Flag_parsing_c.verbose_type
103
 
  then Common.pr2_once s
 
97
let pr2, pr2_once = Common.mk_pr2_wrappers Flag_parsing_c.verbose_type
104
98
 
105
99
(*****************************************************************************)
106
100
(* Environment *)
161
155
  | VarOrFunc of string * Ast_c.exp_type
162
156
  | EnumConstant of string * string option
163
157
 
 
158
  (* also used for macro type aliases *)
164
159
  | TypeDef   of string * fullType
165
160
  (* the structType contains nested "idents" with struct scope *)
166
161
  | StructUnionNameDef of string * (structUnion * structType) wrap
354
349
  | StructUnionName (su, s) -> 
355
350
      (try 
356
351
          let (((su,fields),ii), env') = lookup_structunion (su, s) env in
357
 
          Ast_c.nQ, (StructUnion (su, Some s, fields), ii)
 
352
          Ast_c.mk_ty (StructUnion (su, Some s, fields)) ii
358
353
          (* old: +> Ast_c.rewrap_typeC ty 
359
354
           * but must wrap with good ii, otherwise pretty_print_c
360
355
           * will be lost and raise some Impossible
466
461
 * I now add a fake parse_info for such default int so no more failwith
467
462
 * normally.
468
463
 *)
469
 
let offset (_,(ty,iis)) =
470
 
  match ty, iis with
471
 
  | TypeName (name, _typ), [] -> 
472
 
      (match name with
473
 
      | RegularName (s, [ii]) -> ii.Ast_c.pinfo
474
 
      | _ -> raise Todo
475
 
      )
476
 
  | _, ii::_ -> ii.Ast_c.pinfo
477
 
  | _ -> failwith "type has no text; need to think again"
 
464
let offset ft = 
 
465
  let (qu, ty) = ft in
 
466
  (* bugfix: because of string->name, the ii can be deeper *)
 
467
  let ii = Ast_c.get_local_ii_of_tybis_inlining_ii_of_name ty in
 
468
  match ii with
 
469
  | ii::_ -> ii.Ast_c.pinfo
 
470
  | [] -> failwith "type has no text; need to think again"
478
471
  
479
472
 
480
473
 
629
622
    | Constant (String (s,kind)) -> make_info_def (type_of_s "char *")
630
623
    | Constant MultiString _  -> make_info_def (type_of_s "char *")
631
624
    | Constant (Char   (s,kind)) -> make_info_def (type_of_s "char")
632
 
    | Constant (Int (s))         -> make_info_def (type_of_s "int")
 
625
    | Constant (Int (s,kind)) ->
 
626
        (* this seems really unpleasant, but perhaps the type needs to be set
 
627
           up in some way that allows pretty printing *)
 
628
        make_info_def
 
629
          (match kind with
 
630
          (* matches limited by what is generated in lexer_c.mll *)
 
631
            Si(Signed,CInt) -> type_of_s "int"
 
632
          | Si(UnSigned,CInt) -> type_of_s "unsigned int"
 
633
          | Si(Signed,CLong) -> type_of_s "long"
 
634
          | Si(UnSigned,CLong) -> type_of_s "unsigned long"
 
635
          | Si(Signed,CLongLong) -> type_of_s "long long"
 
636
          | Si(UnSigned,CLongLong) -> type_of_s "unsigned long long"
 
637
          | _ -> failwith "unexpected kind for constant")
633
638
    | Constant (Float (s,kind)) -> 
634
639
        let fake = Ast_c.fakeInfo (Common.fake_parse_info) in
635
640
        let fake = Ast_c.rewrap_str "float" fake in
636
641
        let iinull = [fake] in
637
 
        make_info_def
638
 
          (Ast_c.nQ, (BaseType (FloatType kind), iinull))
 
642
        make_info_def (Ast_c.mk_ty (BaseType (FloatType kind)) iinull)
639
643
          
640
644
          
641
645
    (* -------------------------------------------------- *)
648
652
     * Also as I don't want a warning on the Ident that are a FunCall,
649
653
     * easier to have a rule separate from the Ident rule.
650
654
     *)
651
 
    | FunCall (((Ident (ident), typ), _ii) as e1, args) -> 
 
655
    | FunCall (e1, args) -> 
 
656
     (match Ast_c.unwrap_expr e1 with
 
657
     | Ident (ident) -> 
652
658
        
653
659
        (* recurse *)
654
660
        args +> List.iter (fun (e,ii) -> 
715
721
        )
716
722
 
717
723
 
718
 
    | FunCall (e, args) -> 
 
724
      | _e -> 
719
725
        k expr;
720
726
        
721
 
        (Ast_c.get_type_expr e) +> Type_c.do_with_type (fun typ -> 
 
727
        (Ast_c.get_type_expr e1) +> Type_c.do_with_type (fun typ -> 
722
728
          (* copy paste of above *)   
723
729
          (match unwrap_unfold_env typ with
724
730
          | FunctionType (ret, params) -> make_info_def ret
730
736
          | _ -> Type_c.noTypeHere
731
737
          )
732
738
        )
 
739
     )
733
740
 
734
741
 
735
742
    (* -------------------------------------------------- *)
800
807
          let fake = Ast_c.fakeInfo Common.fake_parse_info in
801
808
          let fake = Ast_c.rewrap_str "*" fake in
802
809
          
803
 
          let ft = (Ast_c.nQ, (Pointer t, [fake])) in
 
810
          let ft = Ast_c.mk_ty (Pointer t) [fake] in
804
811
          make_info_def_fix ft
805
812
        )
806
813
 
867
874
        k expr; 
868
875
        Ast_c.get_type_expr e2
869
876
          
 
877
    | Binary (e1, Logical _, e2) -> 
 
878
        k expr;
 
879
        make_info_def (type_of_s "int")
 
880
 
870
881
    (* todo: lub *)
871
 
    | Binary (e1, op, e2) -> 
 
882
    | Binary (e1, Arith op, e2) -> 
872
883
        k expr;
873
 
        Type_c.lub (Type_c.get_opt_type e1) (Type_c.get_opt_type e2)
 
884
        Type_c.lub op (Type_c.get_opt_type e1) (Type_c.get_opt_type e2)
874
885
 
875
886
    | CondExpr (cond, e1opt, e2) -> 
876
887
        k expr;
1027
1038
 
1028
1039
    (* ------------------------------------------------------------ *)
1029
1040
    Visitor_c.kstatement = (fun (k, bigf) st -> 
1030
 
      match st with 
1031
 
      | Compound statxs, ii -> do_in_new_scope (fun () -> k st);
 
1041
      match Ast_c.unwrap_st st with 
 
1042
      | Compound statxs -> do_in_new_scope (fun () -> k st);
1032
1043
      | _ -> k st
1033
1044
    );
1034
1045
    (* ------------------------------------------------------------ *)
1045
1056
            let local =
1046
1057
              match local with
1047
1058
              | Ast_c.NotLocalDecl -> Ast_c.NotLocalVar
1048
 
              | Ast_c.LocalDecl -> Ast_c.LocalVar (offset t) 
 
1059
              | Ast_c.LocalDecl -> Ast_c.LocalVar (offset t)
1049
1060
            in
1050
1061
            
1051
1062
            var +> Common.do_option (fun (name, iniopt) -> 
1080
1091
       * the ref of abstract-lined types, but the real one, so 
1081
1092
       * don't al_type here
1082
1093
       *)
1083
 
      let (_q, t) = typ in
1084
 
      match t with 
1085
 
      | StructUnion  (su, Some s, structType),ii -> 
 
1094
      let (_q, tbis) = typ in
 
1095
      match Ast_c.unwrap_typeC typ with 
 
1096
      | StructUnion  (su, Some s, structType) -> 
1086
1097
          let structType' = Lib.al_fields structType in 
 
1098
          let ii = Ast_c.get_ii_typeC_take_care tbis in
1087
1099
          let ii' = Lib.al_ii ii in
1088
1100
          add_binding (StructUnionNameDef (s, ((su, structType'),ii')))  true;
1089
1101
 
1090
1102
          if need_annotate_body
1091
1103
          then k typ (* todo: restrict ? new scope so use do_in_scope ? *)
1092
1104
 
1093
 
      | Enum (sopt, enums), ii -> 
 
1105
      | Enum (sopt, enums) -> 
1094
1106
 
1095
1107
          enums +> List.iter (fun ((name, eopt), iicomma) -> 
1096
1108
 
1137
1149
          (match oldstyle with 
1138
1150
          | None -> 
1139
1151
              let typ' = 
1140
 
                Lib.al_type (Ast_c.nQ, (FunctionType ftyp, [i1;i2])) in
 
1152
                Lib.al_type (Ast_c.mk_ty (FunctionType ftyp) [i1;i2]) in
1141
1153
 
1142
1154
              add_binding (VarOrFunc (funcs, (typ',islocal i1.Ast_c.pinfo))) 
1143
1155
                false;
1170
1182
                );
1171
1183
 
1172
1184
          );
 
1185
      | CppTop x -> 
 
1186
          (match x with
 
1187
          | Define ((s,ii), (DefineVar, DefineType t)) -> 
 
1188
              add_binding (TypeDef (s,Lib.al_type t)) true;
 
1189
          | _ -> k elem
 
1190
          )   
 
1191
 
1173
1192
      | Declaration _
1174
1193
 
1175
 
      | CppTop _ 
 
1194
 
 
1195
 
1176
1196
      | IfdefTop _
1177
1197
      | MacroTop _ 
1178
1198
      | EmptyDef _
1236
1256
 
1237
1257
  let bigf = { Visitor_c.default_visitor_c with
1238
1258
    Visitor_c.kexpr = (fun (k,bigf) expr ->
1239
 
      (match unwrap expr with
1240
 
        (CondExpr(e,_,_),_) -> propagate_test e
 
1259
      (match unwrap_expr expr with
 
1260
        CondExpr(e,_,_) -> propagate_test e
1241
1261
      | _ -> ()
1242
1262
      );
1243
1263
      k expr
1244
1264
    );
1245
1265
    Visitor_c.kstatement = (fun (k, bigf) st ->
1246
 
      match unwrap st with 
 
1266
      match unwrap_st st with 
1247
1267
        Selection(s) ->
1248
1268
          (match s with If(e1,s1,s2) -> propagate_test e1 | _ -> ());
1249
1269
          k st;