@@ -85,6 +85,17 @@ struct
8585
8686 let refine_lv man st c x c' pretty exp =
8787 let set' lval v st = set st (eval_lv ~man st lval) (Cilfacade. typeOfLval lval) ~lval_raw: lval v ~man in
88+ let default () =
89+ (* For accesses via pointers in complicated case, no refinement yet *)
90+ let old_val = eval_rv_lval_refine ~man st exp x in
91+ let old_val = map_oldval old_val (Cilfacade. typeOfLval x) in
92+ let v = apply_invariant ~old_val ~new_val: c' in
93+ if is_some_bot v then contra st
94+ else (
95+ if M. tracing then M. tracel " inv" " improve lval %a from %a to %a (c = %a, c' = %a)" d_lval x VD. pretty old_val VD. pretty v pretty c VD. pretty c';
96+ set' x v st
97+ )
98+ in
8899 match x with
89100 | Var var , o when refine_entire_var ->
90101 (* For variables, this is done at to the level of entire variables to benefit e.g. from disjunctive struct domains *)
@@ -100,17 +111,36 @@ struct
100111 if M. tracing then M. tracel " inv" " st from %a to %a" D. pretty st D. pretty r;
101112 r
102113 )
114+ | Mem (Lval lv ), off ->
115+ let lvals = eval_lv ~man st (Mem (Lval lv), off) in
116+ let res = AD. fold (fun a acc ->
117+ Option. bind acc (fun acc ->
118+ match a with
119+ | Addr (base , _ ) as orig ->
120+ let (a:VD.t ) = Address (AD. singleton (AD.Addr. of_var base)) in
121+ if M. tracing then M. tracel " inv" " Consider case of lval %a = %a" d_lval lv VD. pretty a;
122+ let st = set' lv a st in
123+ let old_val = get ~man st (AD. singleton orig) None in
124+ let old_val = VD. cast (Cilfacade. typeOfLval x) old_val in (* needed as the type of this pointer may be different *)
125+ (* this what I would originally have liked to do, but eval_rv_lval_refine uses queries and thus stale values *)
126+ (* let old_val = eval_rv_lval_refine ~man st exp x in *)
127+ let old_val = map_oldval old_val (Cilfacade. typeOfLval x) in
128+ let v = apply_invariant ~old_val ~new_val: c' in
129+ if is_some_bot v then
130+ Some (D. join acc (try contra st with Analyses. Deadcode -> D. bot () ))
131+ else (
132+ if M. tracing then M. tracel " inv" " improve lval %a from %a to %a (c = %a, c' = %a)" d_lval x VD. pretty old_val VD. pretty v pretty c VD. pretty c';
133+ Some (D. join acc (set' x v st))
134+ )
135+ | _ -> None
136+ )
137+ ) lvals (Some (D. bot () ))
138+ in
139+ BatOption. map_default_delayed (fun d -> if D. is_bot d then raise Analyses. Deadcode else d) default res
103140 | Var _, _
104141 | Mem _ , _ ->
105- (* For accesses via pointers, not yet *)
106- let old_val = eval_rv_lval_refine ~man st exp x in
107- let old_val = map_oldval old_val (Cilfacade. typeOfLval x) in
108- let v = apply_invariant ~old_val ~new_val: c' in
109- if is_some_bot v then contra st
110- else (
111- if M. tracing then M. tracel " inv" " improve lval %a from %a to %a (c = %a, c' = %a)" d_lval x VD. pretty old_val VD. pretty v pretty c VD. pretty c';
112- set' x v st
113- )
142+ default ()
143+
114144
115145 let invariant_fallback man st exp tv =
116146 (* We use a recursive helper function so that x != 0 is false can be handled
0 commit comments