diff --git a/infer/src/IR/Tenv.ml b/infer/src/IR/Tenv.ml index 9fdd5e494..055d10422 100644 --- a/infer/src/IR/Tenv.ml +++ b/infer/src/IR/Tenv.ml @@ -23,6 +23,10 @@ end) (** Type for type environment. *) type t = Typ.Struct.t TypenameHash.t +let iter f tenv = TypenameHash.iter f tenv + +let fold f tenv = TypenameHash.fold f tenv + let pp fmt (tenv: t) = TypenameHash.iter (fun name typ -> @@ -61,13 +65,24 @@ let lookup tenv name : Typ.Struct.t option = (** Add a (name,type) pair to the global type environment. *) let add tenv name struct_typ = TypenameHash.replace tenv name struct_typ +let compare_fields (name1, _, _) (name2, _, _) = Typ.Fieldname.compare name1 name2 + +let equal_fields f1 f2 = Int.equal (compare_fields f1 f2) 0 + +let sort_fields fields = List.sort ~cmp:compare_fields fields + +let sort_fields_tenv tenv = + let sort_fields_struct name ({Typ.Struct.fields} as st) = + ignore (mk_struct tenv ~default:st ~fields:(sort_fields fields) name) + in + iter sort_fields_struct tenv + (** Add a field to a given struct in the global type environment. *) let add_field tenv class_tn_name field = match lookup tenv class_tn_name with | Some ({fields} as struct_typ) - -> let field_equal (f1, _, _) (f2, _, _) = Typ.Fieldname.equal f1 f2 in - if not (List.mem ~equal:field_equal fields field) then - let new_fields = field :: fields in + -> if not (List.mem ~equal:equal_fields fields field) then + let new_fields = List.merge [field] fields ~cmp:compare_fields in ignore (mk_struct tenv ~default:struct_typ ~fields:new_fields ~statics:[] class_tn_name) | _ -> () @@ -124,7 +139,3 @@ let store_to_file (filename: DB.filename) (tenv: t) = let out_channel = Out_channel.create debug_filename in let fmt = Format.formatter_of_out_channel out_channel in Format.fprintf fmt "%a" pp tenv ; Out_channel.close out_channel - -let iter f tenv = TypenameHash.iter f tenv - -let fold f tenv = TypenameHash.fold f tenv diff --git a/infer/src/IR/Tenv.mli b/infer/src/IR/Tenv.mli index f6ce0e73f..8660991c3 100644 --- a/infer/src/IR/Tenv.mli +++ b/infer/src/IR/Tenv.mli @@ -41,6 +41,8 @@ val mk_struct : val add_field : t -> Typ.Name.t -> Typ.Struct.field -> unit (** Add a field to a given struct in the global type environment. *) +val sort_fields_tenv : t -> unit + val mem : t -> Typ.Name.t -> bool (** Check if typename is found in t *) diff --git a/infer/src/clang/cFrontend.ml b/infer/src/clang/cFrontend.ml index caba198f4..d9b0359a6 100644 --- a/infer/src/clang/cFrontend.ml +++ b/infer/src/clang/cFrontend.ml @@ -58,7 +58,7 @@ let do_source_file translation_unit_context ast = NullabilityPreanalysis.analysis cfg tenv ; Cg.store_to_file cg_file call_graph ; Cfg.store_cfg_to_file ~source_file cfg_file cfg ; - CGeneral_utils.sort_fields_tenv tenv ; + Tenv.sort_fields_tenv tenv ; Tenv.store_to_file tenv_file tenv ; if Config.stats_mode then Cfg.check_cfg_connectedness cfg ; if Config.stats_mode || Config.debug_mode || Config.testing_mode || Config.frontend_tests diff --git a/infer/src/clang/cGeneral_utils.ml b/infer/src/clang/cGeneral_utils.ml index fe938f414..c557e3e60 100644 --- a/infer/src/clang/cGeneral_utils.ml +++ b/infer/src/clang/cGeneral_utils.ml @@ -65,16 +65,6 @@ let rec append_no_duplicates_fields list1 list2 = | [] -> list2 -let sort_fields fields = - let compare (name1, _, _) (name2, _, _) = Typ.Fieldname.compare name1 name2 in - List.sort ~cmp:compare fields - -let sort_fields_tenv tenv = - let sort_fields_struct name ({Typ.Struct.fields} as st) = - ignore (Tenv.mk_struct tenv ~default:st ~fields:(sort_fields fields) name) - in - Tenv.iter sort_fields_struct tenv - let rec collect_list_tuples l (a, a1, b, c, d) = match l with | [] diff --git a/infer/src/clang/cGeneral_utils.mli b/infer/src/clang/cGeneral_utils.mli index 34c6ed6f6..44fb8ab48 100644 --- a/infer/src/clang/cGeneral_utils.mli +++ b/infer/src/clang/cGeneral_utils.mli @@ -21,11 +21,6 @@ val append_no_duplicates_fields : val append_no_duplicates_csu : Typ.Name.t list -> Typ.Name.t list -> Typ.Name.t list -val sort_fields : - (Typ.Fieldname.t * Typ.t * Annot.Item.t) list -> (Typ.Fieldname.t * Typ.t * Annot.Item.t) list - -val sort_fields_tenv : Tenv.t -> unit - val collect_list_tuples : ('a list * 'b list * 'c list * 'd list * 'e list) list -> 'a list * 'b list * 'c list * 'd list * 'e list