let treat_tlval fa_terms ret_opt origin tlval =
let prefix_origin ntlval =
match origin with
| LvalOrig -> TLval ntlval
| AddrOfOrig -> TAddrOf ntlval
in
let (t_lhost, t_offset) = tlval in
match t_lhost with
| TMem _st -> DoChildren
| TResult _ty -> ( (* for post-conditions and assigns containing a \result *)
match ret_opt with
| None -> raise NoResult (* BTS 692 *)
| Some trm ->
(* [VP] What happens if t_offset <> TNoOffset? *)
ChangeTo (prefix_origin trm)
)
| TVar { lv_origin = Some vinfo } when vinfo.vformal ->
(match find_term_to_replace vinfo fa_terms with
| None -> DoChildren
(* ? can this happen ? is it correct ? *)
| Some nt ->
let make_li tmp_lvar = {
l_var_info = tmp_lvar; l_body = LBterm nt;
l_type = None; l_tparams = [];
l_labels = []; l_profile = [];
}
in
let make_tlet () =
let tmp_lvar = make_temp_logic_var nt.term_type in
Tlet
(make_li tmp_lvar,
mk_term
(prefix_origin (TVar tmp_lvar, t_offset))
nt.term_type)
in
let tlet_or_ident () =
if t_offset = TNoOffset then
(* Nothing to substitute afterwards. *)
ChangeTo nt.term_node
else
(* May need substitution in t_offset. *)
ChangeDoChildrenPost (make_tlet (), fun x -> x)
in
let add_offset lval = addTermOffsetLval t_offset lval in
match nt.term_node with
| TLval lv ->
ChangeDoChildrenPost
(prefix_origin (add_offset lv), fun x -> x)
| TStartOf lv ->
let lv = add_offset lv in
let t =
match origin with
LvalOrig -> TStartOf lv
| AddrOfOrig -> TAddrOf lv
in
ChangeDoChildrenPost(t,fun x->x)
(* [VP]: TAddrOf must be treated as the other
non-lval arguments. *)
(*| TAddrOf (lhost,off) ->
let prefix_origin2 lv =
match nt.term_node with
| TLval _ -> TLval lv
| TStartOf _ -> TStartOf lv
| _ -> TAddrOf lv
in
ChangeDoChildrenPost
((let ntlval = addTermOffsetLval t_offset (lhost,off)
in prefix_origin2 ntlval), fun x -> x)
*)
| TCastE(ty,{ term_node = TLval lv | TStartOf lv }) ->
(match origin with
LvalOrig -> tlet_or_ident()
| AddrOfOrig when t_offset = TNoOffset ->
let t =
Logic_const.taddrof lv (typeOfTermLval lv)
in
ChangeTo (TCastE(TPtr(ty,[]), t))
| AddrOfOrig ->
let lh = TMem nt in
ChangeDoChildrenPost
(TAddrOf (lh,t_offset),fun x -> x))
| _ when origin = AddrOfOrig ->
let source = Cil.source nt.term_loc in
rte_warn ~source
"Cannot substitute a non-lval parameter under an addrof operation";
raise AddrOfFormal
| _ -> tlet_or_ident ())
| _ -> DoChildren