[inferbo] Minor simplifications

Reviewed By: ezgicicek

Differential Revision: D13190906

fbshipit-source-id: 0bb65fa30
master
Mehdi Bouaziz 6 years ago committed by Facebook Github Bot
parent e505fd2dba
commit 0ec75c587f

@ -343,6 +343,8 @@ module Val = struct
else {v with arrayblk= ArrayBlk.set_stride new_stride v.arrayblk} else {v with arrayblk= ArrayBlk.set_stride new_stride v.arrayblk}
let unknown_locs = of_pow_loc PowLoc.unknown ~traces:TraceSet.empty
module Itv = struct module Itv = struct
let m1_255 = of_itv Itv.m1_255 let m1_255 = of_itv Itv.m1_255

@ -107,7 +107,7 @@ let malloc size_exp =
let typ, stride, length0, dyn_length = get_malloc_info size_exp in let typ, stride, length0, dyn_length = get_malloc_info size_exp in
let length = Sem.eval integer_type_widths length0 mem in let length = Sem.eval integer_type_widths length0 mem in
let traces = Trace.(Set.add_elem location ArrayDeclaration) (Dom.Val.get_traces length) in let traces = Trace.(Set.add_elem location ArrayDeclaration) (Dom.Val.get_traces length) in
let path = Option.value_map (Dom.Mem.find_simple_alias id mem) ~default:None ~f:Loc.get_path in let path = Option.bind (Dom.Mem.find_simple_alias id mem) ~f:Loc.get_path in
let allocsite = Allocsite.make pname ~node_hash ~inst_num:0 ~dimension:1 ~path in let allocsite = Allocsite.make pname ~node_hash ~inst_num:0 ~dimension:1 ~path in
let offset, size = (Itv.zero, Dom.Val.get_itv length) in let offset, size = (Itv.zero, Dom.Val.get_itv length) in
let size_exp_opt = let size_exp_opt =
@ -389,9 +389,7 @@ module Collection = struct
let new_list _ = let new_list _ =
let exec {pname; node_hash; location} ~ret:(id, _) mem = let exec {pname; node_hash; location} ~ret:(id, _) mem =
let loc = Loc.of_id id in let loc = Loc.of_id id in
let path = let path = Option.bind (Dom.Mem.find_simple_alias id mem) ~f:Loc.get_path in
Option.value_map (Dom.Mem.find_simple_alias id mem) ~default:None ~f:Loc.get_path
in
let allocsite = Allocsite.make pname ~node_hash ~inst_num:0 ~dimension:1 ~path in let allocsite = Allocsite.make pname ~node_hash ~inst_num:0 ~dimension:1 ~path in
let alloc_loc = Loc.of_allocsite allocsite in let alloc_loc = Loc.of_allocsite allocsite in
let init_size = Dom.Val.of_int 0 in let init_size = Dom.Val.of_int 0 in

@ -142,14 +142,14 @@ let set_array_stride integer_type_widths typ v =
let rec eval : Typ.IntegerWidths.t -> Exp.t -> Mem.astate -> Val.t = let rec eval : Typ.IntegerWidths.t -> Exp.t -> Mem.astate -> Val.t =
fun integer_type_widths exp mem -> fun integer_type_widths exp mem ->
if must_alias_cmp exp mem then Val.of_int 0 if must_alias_cmp exp mem then Val.Itv.zero
else else
match exp with match exp with
| Exp.Var id -> | Exp.Var id ->
Mem.find_stack (Var.of_id id |> Loc.of_var) mem Mem.find_stack (Var.of_id id |> Loc.of_var) mem
| Exp.Lvar pvar -> | Exp.Lvar pvar ->
let ploc = Loc.of_pvar pvar in let loc = Loc.of_pvar pvar in
if Mem.is_stack_loc ploc mem then Mem.find ploc mem else Val.of_loc ploc if Mem.is_stack_loc loc mem then Mem.find loc mem else Val.of_loc loc
| Exp.UnOp (uop, e, _) -> | Exp.UnOp (uop, e, _) ->
eval_unop integer_type_widths uop e mem eval_unop integer_type_widths uop e mem
| Exp.BinOp (bop, e1, e2) -> | Exp.BinOp (bop, e1, e2) ->
@ -174,27 +174,30 @@ let rec eval : Typ.IntegerWidths.t -> Exp.t -> Mem.astate -> Val.t =
and eval_lindex integer_type_widths array_exp index_exp mem = and eval_lindex integer_type_widths array_exp index_exp mem =
let array_v, index_v = let array_v = eval integer_type_widths array_exp mem in
(eval integer_type_widths array_exp mem, eval integer_type_widths index_exp mem)
in
if ArrayBlk.is_bot (Val.get_array_blk array_v) then if ArrayBlk.is_bot (Val.get_array_blk array_v) then
match array_exp with match array_exp with
| Exp.Lfield _ when not (PowLoc.is_bot (Val.get_pow_loc array_v)) -> | Exp.Lfield _ ->
(* It handles the case accessing an array field of struct, let array_locs = Val.get_pow_loc array_v in
if PowLoc.is_bot array_locs then Val.unknown_locs
else
(* It handles the case accessing an array field of struct,
e.g., x.f[n] . Since our abstract domain distinguishes e.g., x.f[n] . Since our abstract domain distinguishes
memory sections for each array fields in struct, it finds memory sections for each array fields in struct, it finds
the memory section using the abstract memory, though the the memory section using the abstract memory, though the
memory lookup is not required to evaluate the address of memory lookup is not required to evaluate the address of
x.f[n] in the concrete semantics. *) x.f[n] in the concrete semantics. *)
Val.plus_pi (Mem.find_set (Val.get_pow_loc array_v) mem) index_v let index_v = eval integer_type_widths index_exp mem in
Val.plus_pi (Mem.find_set array_locs mem) index_v
| _ -> | _ ->
Val.of_pow_loc PowLoc.unknown ~traces:TraceSet.empty Val.unknown_locs
else else
match array_exp with match array_exp with
| Exp.Lindex _ -> | Exp.Lindex _ ->
(* It handles multi-dimensional arrays. *) (* It handles multi-dimensional arrays. *)
Mem.find_set (Val.get_all_locs array_v) mem Mem.find_set (Val.get_all_locs array_v) mem
| _ -> | _ ->
let index_v = eval integer_type_widths index_exp mem in
Val.plus_pi array_v index_v Val.plus_pi array_v index_v
@ -271,7 +274,7 @@ let rec eval_arr : Typ.IntegerWidths.t -> Exp.t -> Mem.astate -> Val.t =
| Some (AliasTarget.Empty _) | None -> | Some (AliasTarget.Empty _) | None ->
Val.bot ) Val.bot )
| Exp.Lvar pvar -> | Exp.Lvar pvar ->
Mem.find_set (PowLoc.singleton (Loc.of_pvar pvar)) mem Mem.find (Loc.of_pvar pvar) mem
| Exp.BinOp (bop, e1, e2) -> | Exp.BinOp (bop, e1, e2) ->
eval_binop integer_type_widths bop e1 e2 mem eval_binop integer_type_widths bop e1 e2 mem
| Exp.Cast (t, e) -> | Exp.Cast (t, e) ->

@ -146,13 +146,12 @@ module Exec = struct
-> Dom.Mem.astate = -> Dom.Mem.astate =
fun ~decl_sym_val deref_kind pname symbol_table path tenv ~node_hash location ~depth loc typ fun ~decl_sym_val deref_kind pname symbol_table path tenv ~node_hash location ~depth loc typ
?offset ?size ?stride ~inst_num ~new_sym_num ~new_alloc_num mem -> ?offset ?size ?stride ~inst_num ~new_sym_num ~new_alloc_num mem ->
let option_value opt_x default_f = match opt_x with Some x -> x | None -> default_f () in
let offset = let offset =
option_value offset (fun () -> IOption.value_default_f offset ~f:(fun () ->
Itv.make_sym pname symbol_table (Itv.SymbolPath.offset path) new_sym_num ) Itv.make_sym pname symbol_table (Itv.SymbolPath.offset path) new_sym_num )
in in
let size = let size =
option_value size (fun () -> IOption.value_default_f size ~f:(fun () ->
Itv.make_sym ~unsigned:true pname symbol_table (Itv.SymbolPath.length path) new_sym_num Itv.make_sym ~unsigned:true pname symbol_table (Itv.SymbolPath.length path) new_sym_num
) )
in in

@ -8,3 +8,5 @@
open! IStd open! IStd
let find_value_exn = function None -> raise Caml.Not_found | Some v -> v let find_value_exn = function None -> raise Caml.Not_found | Some v -> v
let value_default_f ~f = function None -> f () | Some v -> v

@ -9,3 +9,6 @@ open! IStd
val find_value_exn : 'a option -> 'a val find_value_exn : 'a option -> 'a
(** Like [Option.value_exn] but raises [Caml.Not_found] when called with [None]. *) (** Like [Option.value_exn] but raises [Caml.Not_found] when called with [None]. *)
val value_default_f : f:(unit -> 'a) -> 'a option -> 'a
(** Like [Option.value ~default:(f ())] but [f] is called only if [None]. *)

Loading…
Cancel
Save