Skip to content

Commit e95b1ec

Browse files
committed
move query and side out of iterate
1 parent 18ee07c commit e95b1ec

File tree

1 file changed

+41
-44
lines changed

1 file changed

+41
-44
lines changed

src/solver/td_simplified.ml

Lines changed: 41 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -63,53 +63,50 @@ module Base : GenericEqSolver =
6363
) w
6464
in
6565

66-
let rec iterate x = (* ~(inner) solve in td3*)
67-
let query x y = (* ~eval in td3 *)
68-
if tracing then trace "solver_query" "entering query for %a; stable %b; called %b" S.Var.pretty_trace y (HM.mem stable y) (HM.mem called y);
69-
get_var_event y;
70-
if not (HM.mem called y) then (
71-
if S.system y = None then (
72-
init y;
73-
HM.replace stable y ()
74-
) else (
75-
HM.replace called y ();
76-
if tracing then trace "iter" "iterate called from query";
77-
iterate y;
78-
HM.remove called y)
66+
let rec query x y = (* ~eval in td3 *)
67+
if tracing then trace "solver_query" "entering query for %a; stable %b; called %b" S.Var.pretty_trace y (HM.mem stable y) (HM.mem called y);
68+
get_var_event y;
69+
if not (HM.mem called y) then (
70+
if S.system y = None then (
71+
init y;
72+
HM.replace stable y ()
7973
) else (
80-
if tracing && not (HM.mem wpoint y) then trace "wpoint" "query adding wpoint %a" S.Var.pretty_trace y;
81-
HM.replace wpoint y ();
82-
);
83-
let tmp = HM.find rho y in
84-
add_infl y x;
85-
if tracing then trace "answer" "exiting query for %a\nanswer: %a" S.Var.pretty_trace y S.Dom.pretty tmp;
86-
tmp
74+
HM.replace called y ();
75+
if tracing then trace "iter" "iterate called from query";
76+
iterate y;
77+
HM.remove called y)
78+
) else (
79+
if tracing && not (HM.mem wpoint y) then trace "wpoint" "query adding wpoint %a" S.Var.pretty_trace y;
80+
HM.replace wpoint y ();
81+
);
82+
let tmp = HM.find rho y in
83+
add_infl y x;
84+
if tracing then trace "answer" "exiting query for %a\nanswer: %a" S.Var.pretty_trace y S.Dom.pretty tmp;
85+
tmp
86+
87+
and side x y d = (* side from x to y; only to variables y w/o rhs; x only used for trace *)
88+
if tracing then trace "side" "side to %a (wpx: %b) from %a; value: %a" S.Var.pretty_trace y (HM.mem wpoint y) S.Var.pretty_trace x S.Dom.pretty d;
89+
assert (S.system y = None);
90+
init y;
91+
let widen a b =
92+
if M.tracing then M.trace "wpoint" "side widen %a" S.Var.pretty_trace y;
93+
S.Dom.widen a (S.Dom.join a b)
8794
in
95+
let op a b = if HM.mem wpoint y then widen a b else S.Dom.join a b
96+
in
97+
let old = HM.find rho y in
98+
let tmp = op old d in
99+
HM.replace stable y ();
100+
if not (S.Dom.leq tmp old) then (
101+
if tracing && not (S.Dom.is_bot old) then trace "update" "side to %a (wpx: %b) from %a new: %a" S.Var.pretty_trace y (HM.mem wpoint y) S.Var.pretty_trace x S.Dom.pretty tmp;
102+
HM.replace rho y tmp;
103+
destabilize y;
104+
(* make y a widening point. This will only matter for the next side _ y. *)
105+
if tracing && not (HM.mem wpoint y) then trace "wpoint" "side adding wpoint %a" S.Var.pretty_trace y;
106+
HM.replace wpoint y ()
107+
)
88108

89-
let side x y d = (* side from x to y; only to variables y w/o rhs; x only used for trace *)
90-
if tracing then trace "side" "side to %a (wpx: %b) from %a; value: %a" S.Var.pretty_trace y (HM.mem wpoint y) S.Var.pretty_trace x S.Dom.pretty d;
91-
assert (S.system y = None);
92-
init y;
93-
let widen a b =
94-
if M.tracing then M.trace "wpoint" "side widen %a" S.Var.pretty_trace y;
95-
S.Dom.widen a (S.Dom.join a b)
96-
in
97-
let op a b = if HM.mem wpoint y then widen a b else S.Dom.join a b
98-
in
99-
let old = HM.find rho y in
100-
let tmp = op old d in
101-
HM.replace stable y ();
102-
if not (S.Dom.leq tmp old) then (
103-
if tracing && not (S.Dom.is_bot old) then trace "update" "side to %a (wpx: %b) from %a new: %a" S.Var.pretty_trace y (HM.mem wpoint y) S.Var.pretty_trace x S.Dom.pretty tmp;
104-
HM.replace rho y tmp;
105-
destabilize y;
106-
(* make y a widening point. This will only matter for the next side _ y. *)
107-
if tracing && not (HM.mem wpoint y) then trace "wpoint" "side adding wpoint %a" S.Var.pretty_trace y;
108-
HM.replace wpoint y ()
109-
)
110-
in
111-
112-
(* begining of iterate*)
109+
and iterate x = (* ~(inner) solve in td3*)
113110
if tracing then trace "iter" "begin iterate %a, called: %b, stable: %b, wpoint: %b" S.Var.pretty_trace x (HM.mem called x) (HM.mem stable x) (HM.mem wpoint x);
114111
init x;
115112
assert (S.system x <> None);

0 commit comments

Comments
 (0)