diff --git a/infer/src/backend/ClosureSubstSpecializedMethod.ml b/infer/src/backend/ClosureSubstSpecializedMethod.ml index 003219d3d..14d948ede 100644 --- a/infer/src/backend/ClosureSubstSpecializedMethod.ml +++ b/infer/src/backend/ClosureSubstSpecializedMethod.ml @@ -66,20 +66,108 @@ end module Analyzer = AbstractInterpreter.MakeRPO (TransferFunctions) +let try_keep_original ~default orig new_ ~f = if phys_equal orig new_ then default else f new_ + +let try_keep_original2 ~default orig1 new1 orig2 new2 ~f = + if phys_equal orig1 new1 && phys_equal orig2 new2 then default else f new1 new2 + + +let exec_pvar pname pvar = Pvar.swap_proc_in_local_pvar pvar pname + +let exec_var pname var = + let open Var in + match var with + | LogicalVar _ -> + var + | ProgramVar pvar -> + try_keep_original ~default:var pvar (exec_pvar pname pvar) ~f:of_pvar + + +let rec exec_exp pname e = + let open Exp in + match e with + | Var _ | Const _ -> + e + | UnOp (unop, e1, typ) -> + try_keep_original ~default:e e1 (exec_exp pname e1) ~f:(fun e1' -> UnOp (unop, e1', typ)) + | BinOp (binop, e1, e2) -> + try_keep_original2 ~default:e e1 (exec_exp pname e1) e2 (exec_exp pname e2) ~f:(fun e1' e2' -> + BinOp (binop, e1', e2') ) + | Exn e1 -> + try_keep_original ~default:e e1 (exec_exp pname e1) ~f:(fun e1' -> Exn e1') + | Closure {name; captured_vars} -> + let updated = ref false in + let captured_vars = + List.map captured_vars ~f:(fun ((e, pvar, typ, captured_mode) as captured_var) -> + try_keep_original2 ~default:captured_var e (exec_exp pname e) pvar + (exec_pvar pname pvar) ~f:(fun e' pvar' -> + updated := true ; + (e', pvar', typ, captured_mode) ) ) + in + if !updated then Closure {name; captured_vars} else e + | Cast (typ, e1) -> + try_keep_original ~default:e e1 (exec_exp pname e1) ~f:(fun e1' -> Cast (typ, e1')) + | Lvar pvar -> + try_keep_original ~default:e pvar (exec_pvar pname pvar) ~f:(fun pvar' -> Lvar pvar') + | Lfield (e1, fn, typ) -> + try_keep_original ~default:e e1 (exec_exp pname e1) ~f:(fun e1' -> Lfield (e1', fn, typ)) + | Lindex (e1, e2) -> + try_keep_original2 ~default:e e1 (exec_exp pname e1) e2 (exec_exp pname e2) ~f:(fun e1' e2' -> + Lindex (e1', e2') ) + | Sizeof {typ; nbytes; dynamic_length; subtype} -> + Option.value_map dynamic_length ~default:e ~f:(fun dynamic_length -> + try_keep_original ~default:e dynamic_length (exec_exp pname dynamic_length) + ~f:(fun dynamic_length' -> + Sizeof {typ; nbytes; dynamic_length= Some dynamic_length'; subtype} ) ) + + +let exec_metadata pname metadata = + let open Sil in + match metadata with + | Abstract _ | Skip -> + metadata + | ExitScope (vars, loc) -> + let updated = ref false in + let vars' = + List.map vars ~f:(fun var -> + try_keep_original ~default:var var (exec_var pname var) ~f:(fun var' -> + updated := true ; + var' ) ) + in + if !updated then ExitScope (vars', loc) else metadata + | Nullify (pvar, loc) -> + try_keep_original ~default:metadata pvar (exec_pvar pname pvar) ~f:(fun pvar' -> + Nullify (pvar', loc) ) + | VariableLifetimeBegins (pvar, typ, loc) -> + try_keep_original ~default:metadata pvar (exec_pvar pname pvar) ~f:(fun pvar' -> + VariableLifetimeBegins (pvar', typ, loc) ) + + +let exec_args proc_name args = + let updated = ref false in + let args' = + List.map + ~f:(fun ((exp, typ) as exp_typ) -> + try_keep_original ~default:exp_typ exp (exec_exp proc_name exp) ~f:(fun exp' -> + updated := true ; + (exp', typ) ) ) + args + in + if !updated then args' else args + + let exec_instr proc_name (id_to_pvar_map, pvars_to_blocks_map) instr = let open Sil in let res = - let exec_exp exp = - let exec_pvar pvar = Pvar.swap_proc_in_local_pvar pvar proc_name in - match exp with Exp.Lvar origin_pvar -> Exp.Lvar (exec_pvar origin_pvar) | exp -> exp - in match instr with | Load {id; e; root_typ; loc} -> - [Load {id; e= exec_exp e; root_typ; typ= root_typ; loc}] + [ try_keep_original ~default:instr e (exec_exp proc_name e) ~f:(fun e' -> + Load {id; e= e'; root_typ; typ= root_typ; loc} ) ] | Store {e1; root_typ; typ; e2; loc} -> - [Store {e1= exec_exp e1; root_typ; typ; e2= exec_exp e2; loc}] + [ try_keep_original2 ~default:instr e1 (exec_exp proc_name e1) e2 (exec_exp proc_name e2) + ~f:(fun e1' e2' -> Store {e1= e1'; root_typ; typ; e2= e2'; loc}) ] | Call (ret_id_typ, Var id, origin_args, loc, call_flags) -> ( - let converted_args = List.map ~f:(fun (exp, typ) -> (exec_exp exp, typ)) origin_args in + let converted_args = exec_args proc_name origin_args in match Option.bind ~f:VDom.get (BlockIdMap.find_opt id id_to_pvar_map) with | None -> [instr] @@ -107,12 +195,16 @@ let exec_instr proc_name (id_to_pvar_map, pvars_to_blocks_map) instr = | None -> [instr] ) ) | Call (return_ids, origin_call_exp, origin_args, loc, call_flags) -> - let converted_args = List.map ~f:(fun (exp, typ) -> (exec_exp exp, typ)) origin_args in - [Call (return_ids, exec_exp origin_call_exp, converted_args, loc, call_flags)] + [ try_keep_original2 ~default:instr origin_call_exp (exec_exp proc_name origin_call_exp) + origin_args (exec_args proc_name origin_args) + ~f:(fun converted_call_exp converted_args -> + Call (return_ids, converted_call_exp, converted_args, loc, call_flags) ) ] | Prune (origin_exp, loc, is_true_branch, if_kind) -> - [Prune (exec_exp origin_exp, loc, is_true_branch, if_kind)] - | _ -> - [instr] + [ try_keep_original ~default:instr origin_exp (exec_exp proc_name origin_exp) + ~f:(fun converted_exp -> Prune (converted_exp, loc, is_true_branch, if_kind)) ] + | Metadata metadata -> + [ try_keep_original ~default:instr metadata (exec_metadata proc_name metadata) + ~f:(fun metadata' -> Metadata metadata') ] in Array.of_list res