infer_clone/infer/src/IR/HilInstr.ml

(*
 * Copyright (c) 2017 - present Facebook, Inc.
 * All rights reserved.
 *
 * This source code is licensed under the BSD style license found in the
 * LICENSE file in the root directory of this source tree. An additional grant
 * of patent rights can be found in the PATENTS file in the same directory.
 *)

open! IStd

module F = Format
module L = Logging

type call =
  | Direct of Typ.Procname.t
  | Indirect of AccessPath.Raw.t
[@@deriving compare]

let pp_call fmt = function
  | Direct pname -> Typ.Procname.pp fmt pname
  | Indirect access_path -> F.fprintf fmt "*%a" AccessPath.Raw.pp access_path

type t =
  | Write of AccessPath.Raw.t * HilExp.t * Location.t
  | Assume of HilExp.t * [`Then | `Else] * Sil.if_kind * Location.t
  | Call of AccessPath.base option * call * HilExp.t list * CallFlags.t * Location.t
[@@deriving compare]

let pp fmt = function
  | Write (access_path, exp, loc) ->
      F.fprintf fmt "%a := %a [%a]" AccessPath.Raw.pp access_path HilExp.pp exp Location.pp loc
  | Assume (exp, _, _, loc) ->
      F.fprintf fmt "assume %a [%a]" HilExp.pp exp Location.pp loc
  | Call (ret_opt, call, actuals, _, loc) ->
      let pp_ret fmt = Option.iter ~f:(F.fprintf fmt "%a := " AccessPath.pp_base) in
      let pp_actuals fmt = PrettyPrintable.pp_collection ~pp_item:HilExp.pp fmt in
      F.fprintf fmt "%a%a(%a) [%a]" pp_ret ret_opt pp_call call pp_actuals actuals Location.pp loc

type translation =
  | Instr of t
  | Update of Var.t * AccessPath.Raw.t
  | Ignore

(* convert an SIL instruction into an HIL instruction. the [f_resolve_id] function should map an SSA
   temporary variable to the access path it represents. evaluating the HIL instruction should
   produce the same result as evaluating the SIL instruction and replacing the temporary variables
   using [f_resolve_id]. *)
let of_sil ~f_resolve_id (instr : Sil.instr) =
  let analyze_id_assignment lhs_id rhs_exp rhs_typ loc =
    let rhs_hil_exp = HilExp.of_sil ~f_resolve_id rhs_exp rhs_typ in
    match HilExp.get_access_paths rhs_hil_exp with
    | [rhs_access_path] ->
        Update (lhs_id, rhs_access_path)
    | _ ->
        Instr (Write (((lhs_id, rhs_typ), []), rhs_hil_exp, loc)) in
  match instr with
  | Load (lhs_id, rhs_exp, rhs_typ, loc) ->
      analyze_id_assignment (Var.of_id lhs_id) rhs_exp rhs_typ loc
  | Store (Lvar lhs_pvar, lhs_typ, rhs_exp, loc)
    when Pvar.is_ssa_frontend_tmp lhs_pvar ->
      analyze_id_assignment (Var.of_pvar lhs_pvar) rhs_exp lhs_typ loc
  | Call (Some (ret_id, _), Const (Cfun callee_pname),
          (target_exp, _) :: (Sizeof (cast_typ, _, _), _) :: _ , loc, _)
    when Typ.Procname.equal callee_pname BuiltinDecl.__cast ->
      analyze_id_assignment (Var.of_id ret_id) target_exp cast_typ loc
  | Store (lhs_exp, typ, rhs_exp, loc) ->
      let lhs_access_path =
        match HilExp.of_sil ~f_resolve_id lhs_exp typ with
        | AccessPath ap -> ap
        | _ -> invalid_argf "Non-assignable LHS expression %a" Exp.pp lhs_exp in
      Instr (Write (lhs_access_path, HilExp.of_sil ~f_resolve_id rhs_exp typ, loc))
  | Call (ret_opt, call_exp, formals, loc, call_flags) ->
      let hil_ret = Option.map ~f:(fun (ret_id, ret_typ) -> Var.of_id ret_id, ret_typ) ret_opt in
      let hil_call =
        match HilExp.of_sil ~f_resolve_id call_exp (Typ.mk Tvoid) with
        | Constant (Cfun procname) -> Direct procname
        | AccessPath access_path -> Indirect access_path
        | call_exp -> invalid_argf "Unexpected call expression %a" HilExp.pp call_exp in
      let formals = List.map ~f:(fun (exp, typ) -> HilExp.of_sil ~f_resolve_id exp typ) formals in
      Instr (Call (hil_ret, hil_call, formals, call_flags, loc))
  | Prune (exp, loc, true_branch, if_kind) ->
      let hil_exp = HilExp.of_sil ~f_resolve_id exp (Typ.mk (Tint IBool)) in
      let branch = if true_branch then `Then else `Else in
      Instr (Assume (hil_exp, branch, if_kind, loc))
  | Nullify _ | Remove_temps _
  (* ignoring for now; will translate as builtin function call if needed *)
  | Abstract _ | Declare_locals _ ->
      (* these don't seem useful for most analyses. can translate them later if we want to *)
      Ignore