Skip to content

Commit 18b1cbc

Browse files
vouillonhhugo
authored andcommitted
Global flow analysis: add some debugging code
Make sure we have reached a fixed point.
1 parent c0e3651 commit 18b1cbc

File tree

3 files changed

+63
-22
lines changed

3 files changed

+63
-22
lines changed

compiler/lib/dgraph.ml

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -258,6 +258,18 @@ struct
258258
List.iter ~f:(fun x -> Queue.push x queue) !lst;
259259
{ queue; set = to_visit }
260260

261+
let check g v f report =
262+
let update ~children:_ _ = () in
263+
NSet.iter
264+
(fun x ->
265+
let a = NTbl.get v x in
266+
let b = f ~update v x in
267+
if not (D.equal a b)
268+
then (
269+
NTbl.set v x b;
270+
report x a b))
271+
g.domain
272+
261273
let f' size g f =
262274
n := 0;
263275
m := 0;

compiler/lib/dgraph.mli

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -102,6 +102,13 @@ module Make_Imperative
102102
-> t
103103
-> (update:(children:bool -> N.t -> unit) -> D.t NTbl.t -> N.t -> D.t)
104104
-> D.t NTbl.t
105+
106+
val check :
107+
t
108+
-> D.t NTbl.t
109+
-> (update:(children:bool -> N.t -> unit) -> D.t NTbl.t -> N.t -> D.t)
110+
-> (N.t -> D.t -> D.t -> unit)
111+
-> unit
105112
end
106113
end
107114

compiler/lib/global_flow.ml

Lines changed: 44 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -568,14 +568,53 @@ let propagate st ~update approx x =
568568
module G = Dgraph.Make_Imperative (Var) (Var.ISet) (Var.Tbl)
569569
module Solver = G.Solver (Domain)
570570

571+
let print_approx st f a =
572+
match a with
573+
| Top -> Format.fprintf f "top"
574+
| Values { known; others } ->
575+
Format.fprintf
576+
f
577+
"{%a/%b}"
578+
(Format.pp_print_list
579+
~pp_sep:(fun f () -> Format.fprintf f ", ")
580+
(fun f x ->
581+
Format.fprintf
582+
f
583+
"%a(%s)"
584+
Var.print
585+
x
586+
(match st.defs.(Var.idx x) with
587+
| Expr (Closure _) -> "C"
588+
| Expr (Block _) -> (
589+
"B"
590+
^
591+
match st.may_escape.(Var.idx x) with
592+
| Escape -> "X"
593+
| _ -> "")
594+
| _ -> "O")))
595+
(Var.Set.elements known)
596+
others
597+
571598
let solver st =
572599
let g =
573600
{ G.domain = st.vars
574601
; G.iter_children =
575602
(fun f x -> Var.Tbl.DataSet.iter (fun k -> f k) (Var.Tbl.get st.deps x))
576603
}
577604
in
578-
Solver.f' () g (propagate st)
605+
let res = Solver.f' () g (propagate st) in
606+
if debug ()
607+
then
608+
Solver.check g res (propagate st) (fun x a b ->
609+
Format.eprintf
610+
"Incorrect value: %a: %a -> %a@."
611+
Var.print
612+
x
613+
(print_approx st)
614+
a
615+
(print_approx st)
616+
b);
617+
res
579618

580619
(****)
581620

@@ -635,29 +674,12 @@ let f ~fast p =
635674
(fun f a ->
636675
match a with
637676
| Top -> Format.fprintf f "top"
638-
| Values { known; others } ->
677+
| Values _ ->
639678
Format.fprintf
640679
f
641-
"{%a/%b} mut:%b vmut:%b vesc:%s esc:%s"
642-
(Format.pp_print_list
643-
~pp_sep:(fun f () -> Format.fprintf f ", ")
644-
(fun f x ->
645-
Format.fprintf
646-
f
647-
"%a(%s)"
648-
Var.print
649-
x
650-
(match st.defs.(Var.idx x) with
651-
| Expr (Closure _) -> "C"
652-
| Expr (Block _) -> (
653-
"B"
654-
^
655-
match st.may_escape.(Var.idx x) with
656-
| Escape -> "X"
657-
| _ -> "")
658-
| _ -> "O")))
659-
(Var.Set.elements known)
660-
others
680+
"%a mut:%b vmut:%b vesc:%s esc:%s"
681+
(print_approx st)
682+
a
661683
(Var.ISet.mem st.possibly_mutable x)
662684
(Var.ISet.mem st.variable_possibly_mutable x)
663685
(match st.variable_may_escape.(Var.idx x) with

0 commit comments

Comments
 (0)