You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

75 lines
2.4 KiB

(*
* Copyright (c) Facebook, Inc. and its affiliates.
*
* This source code is licensed under the MIT license found in the
* LICENSE file in the root directory of this source tree.
*)
open! IStd
module F = Format
module L = Logging
open PulseBasicInterface
(** Stacks: map addresses of variables to values and histoy. *)
module VarAddress = struct
include Var
let pp f var =
let pp_ampersand f = function ProgramVar _ -> F.pp_print_string f "&" | LogicalVar _ -> () in
F.fprintf f "%a%a" pp_ampersand var Var.pp var
end
module AddrHistPair = struct
type t = AbstractValue.t * ValueHistory.t [@@deriving compare, equal, yojson_of]
let pp f addr_trace =
if Config.debug_level_analysis >= 3 then
Pp.pair ~fst:AbstractValue.pp ~snd:ValueHistory.pp f addr_trace
else AbstractValue.pp f (fst addr_trace)
end
module M = PrettyPrintable.MakePPMonoMap (VarAddress) (AddrHistPair)
let yojson_of_t m = [%yojson_of: (VarAddress.t * AddrHistPair.t) list] (M.bindings m)
let canonicalize ~get_var_repr stack =
let exception AliasingContradiction in
try
let (_allocated, changed), stack' =
M.fold_mapi stack ~init:(AbstractValue.Set.empty, false)
~f:(fun var (allocated, changed) ((addr, hist) as addr_hist) ->
let addr' = get_var_repr addr in
if Var.is_pvar var && AbstractValue.Set.mem addr' allocated then (
L.d_printfln
"CONTRADICTION: %a = %a makes two stack variables' addresses equal (%a=%a) in %a@\n"
AbstractValue.pp addr AbstractValue.pp addr' AbstractValue.pp addr Var.pp var M.pp
stack ;
raise AliasingContradiction ) ;
let allocated =
if Var.is_pvar var then AbstractValue.Set.add addr' allocated else allocated
in
if phys_equal addr addr' then ((allocated, changed), addr_hist)
else
let changed = true in
((allocated, changed), (addr', hist)) )
in
Sat (if changed then stack' else stack)
with AliasingContradiction -> Unsat
let subst_var (v, v') stack =
canonicalize stack ~get_var_repr:(fun addr -> if AbstractValue.equal v addr then v' else addr)
include M
let compare = M.compare AddrHistPair.compare
let equal = M.equal AddrHistPair.equal
let pp fmt m =
let pp_item fmt (var_address, v) =
F.fprintf fmt "%a=%a" VarAddress.pp var_address AddrHistPair.pp v
in
PrettyPrintable.pp_collection ~pp_item fmt (M.bindings m)