From c7b5a39b4e41f59b64f7ffb23272c824dd3f5402 Mon Sep 17 00:00:00 2001 From: Simmo Saan Date: Tue, 26 May 2026 15:38:42 +0300 Subject: [PATCH] Add possible analysis V and G coupling layer --- src/framework/vg.ml | 85 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 85 insertions(+) create mode 100644 src/framework/vg.ml diff --git a/src/framework/vg.ml b/src/framework/vg.ml new file mode 100644 index 0000000000..4f0b9c1cad --- /dev/null +++ b/src/framework/vg.ml @@ -0,0 +1,85 @@ +open Analyses + +module type S = +sig + module V0: SpecSysVar + module G0: Lattice.S + + module V: SpecSysVar + module G: Lattice.S + + val global: (_, G.t, _, V.t) man -> V0.t -> G0.t + val sideg: (_, G.t, _, V.t) man -> V0.t -> G0.t -> unit +end + +module Make (V: SpecSysVar) (G: Lattice.S): S with module V0 = V and module G0 = G = +struct + module V0 = V + module G0 = G + module V = V + module G = G + + let global man = man.global + let sideg man = man.sideg +end + + +module type S2 = +sig + include S + + val all_globals: (_, G.t, _, V.t) man -> V0.t Seq.t +end + +module Make2 (V: SpecSysVar) (G: Lattice.S): S2 with module V0 = V and module G0 = G = +struct + module V0 = V + module G0 = G + + module V = + struct + include Printable.Either (V0) (UnitV) + include StdV + end + + module V0Set = SetDomain.Make (V0) + + module G = + struct + include Lattice.Lift2 (G0) (V0Set) + end + + let global man g = + match man.global (`Left g) with + | `Bot -> G0.bot () + | `Lifted1 x -> x + | _ -> assert false + + let sideg man g x = + man.sideg (`Left g) (`Lifted1 x); + man.sideg (`Right ()) (`Lifted2 (V0Set.singleton g)) + + let all_globals man = + match man.global (`Right ()) with + | `Bot -> Seq.empty + | `Lifted2 x -> V0Set.to_seq x + | _ -> assert false +end + +module Make3 (V: SpecSysVar) (G: Lattice.S): S2 with module V0 = V and module G0 = G = +struct + module V0 = V + module G0 = G + + module V = UnitV + module G = MapDomain.MapBot (V0) (G0) + + let global man g = G.find g (man.global ()) + let sideg man g x = man.sideg () (G.singleton g x) + + let all_globals man = + man.global () + |> G.bindings + |> List.to_seq + |> Seq.map fst +end