Skip to content

Commit

Permalink
while execution done
Browse files Browse the repository at this point in the history
  • Loading branch information
@Th0mz
Th0mz committed May 8, 2024
1 parent 528bb57 commit 57423f4
Show file tree
Hide file tree
Showing 4 changed files with 105 additions and 113 deletions.
85 changes: 53 additions & 32 deletions lib/mdg/analyse.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,22 @@ open State

let verbose = ref false;;

let register, setup, was_changed =
let bs : bool list ref = ref [] in

let reg = fun () -> match !bs with
| _ :: bs' -> bs := true :: bs'
| _ -> () in

let push = fun () -> bs := false :: !bs in

let pop = fun () -> match !bs with
| b :: bs' -> bs := bs'; b
| _ -> failwith "no element to pop" in

reg, push, pop;;


let rec program (is_verbose : bool) ((_, {body}) : m Program.t) : Graph.t * Store.t =
verbose := is_verbose;

Expand All @@ -17,59 +33,65 @@ and analyse (state : state) (statement : m Statement.t) : unit =
let graph = state.graph in
let store = state.store in

(* aliases *)
let eval_expr = eval_expr store state.this in
let add_dep_edge = Graph.addDepEdge register graph in
let add_prop_edge = Graph.addPropEdge register graph in
let store_update = Store.update register store in
let alloc = Graph.alloc graph in
let add_node = Graph.addNode register graph in
let add_property = Graph.staticAddProperty register graph in
let add_property' = Graph.dynamicAddProperty register graph in
let lookup = Graph.lookup graph in
let new_version = Graph.staticNewVersion register graph in
let new_version' = Graph.dynamicNewVersion register graph in

(match statement with
(* -------- A S S I G N - E X P R -------- *)
| _, AssignSimple {left; right} ->
let _L = eval_expr right in
Store.update store left _L

(* ???
| _, AssignArray _ -> ()
| _, AssignFunCall _ -> ()
*)
store_update left _L

(* -------- A S S I G N - O P -------- *)
| _, AssignBinary {left; opLeft; opRght; id; _} ->
let _L1, _L2 = eval_expr opLeft, eval_expr opRght in
let l_i = Graph.alloc graph id in
LocationSet.iter (flip (Graph.addDepEdge graph) l_i) (LocationSet.union _L1 _L2);
Store.update store left (LocationSet.singleton l_i);
let l_i = alloc id in
LocationSet.iter (flip add_dep_edge l_i) (LocationSet.union _L1 _L2);
store_update left (LocationSet.singleton l_i);

| _, AssignUnary {left; argument; id; _} ->
let _L1 = eval_expr argument in
let l_i = Graph.alloc graph id in
LocationSet.iter (flip (Graph.addDepEdge graph) l_i) _L1;
Store.update store left (LocationSet.singleton l_i)
let l_i = alloc id in
LocationSet.iter (flip add_dep_edge l_i) _L1;
store_update left (LocationSet.singleton l_i)

(* -------- N E W O B J E C T -------- *)
| _, AssignObject {id; left} ->
let l_i = Graph.alloc graph id in
Store.update store left (LocationSet.singleton l_i);
Graph.addNode graph l_i;
let l_i = alloc id in
store_update left (LocationSet.singleton l_i);
add_node l_i;

(* -------- S T A T I C P R O P E R T Y L O O K U P -------- *)
| _, AssignStaticMember {left; _object; property=(_, {name=property; _}); id} ->
let _L = eval_expr _object in
Graph.staticAddProperty graph _L property id;
let _L' = LocationSet.map (fun loc -> Graph.lookup graph loc property) _L in
Store.update store left _L'
add_property _L property id;
let _L' = LocationSet.map (fun loc -> lookup loc property) _L in
store_update left _L'

(* -------- D Y N A M I C P R O P E R T Y L O O K U P -------- *)
| _, AssignDynmicMember {left; _object; property; id} ->
let _L1, _L2 = eval_expr _object, eval_expr property in
Graph.dynamicAddProperty graph _L1 _L2 id;
let _L' = LocationSet.map (fun loc -> Graph.lookup graph loc "*") _L1 in
Store.update store left _L'
add_property' _L1 _L2 id;
let _L' = LocationSet.map (fun loc -> lookup loc "*") _L1 in
store_update left _L'

(* -------- S T A T I C P R O P E R T Y U P D A T E -------- *)
| _, StaticMemberAssign {_object; property=(_, {name=property; _}); right; id} ->
let _L1, _L2 = eval_expr _object, eval_expr right in
let _L1' = Graph.staticNewVersion graph store _object _L1 property id in
let _L1' = new_version store _object _L1 property id in
LocationSet.iter ( fun l_1 ->
LocationSet.iter (fun l_2 ->
Graph.addPropEdge graph l_1 l_2 (Some property)
add_prop_edge l_1 l_2 (Some property)
) _L2
) _L1'

Expand All @@ -79,25 +101,25 @@ and analyse (state : state) (statement : m Statement.t) : unit =
eval_expr property,
eval_expr right in

let _L1' = Graph.dynamicNewVersion graph store _object _L1 _L2 id in
let _L1' = new_version' store _object _L1 _L2 id in
LocationSet.iter ( fun l_1 ->
LocationSet.iter (fun l_3 ->
Graph.addPropEdge graph l_1 l_3 None
add_prop_edge l_1 l_3 None
) _L3
) _L1'

(* -------- C A L L -------- *)
| _, AssignFunCall _ -> ()
| _, AssignNew _ -> ()
| _, AssignNew _ -> ()

(* -------- I F -------- *)
| _, If {consequent; alternate; _} ->
let state' = State.copy state in
analyse_sequence state consequent;
option_may (analyse_sequence state') alternate;

Graph.lub state.graph state'.graph;
Store.lub state.store state'.store;
Graph.lub register state.graph state'.graph;
Store.lub register state.store state'.store;

(* -------- W H I L E -------- *)
| _, While {body; _} ->
Expand All @@ -121,11 +143,10 @@ and analyse (state : state) (statement : m Statement.t) : unit =
and analyse_sequence (state : state) = List.iter (analyse state)

and ifp (f : state -> unit) (state : state) : unit =
let state' = State.copy state in
setup ();
f state;
if not (State.is_equal state state')
then ifp f state
else ()
if not (was_changed ())
then ifp f state


and eval_expr (store : Store.t) (this : LocationSet.t) (expr : m Expression.t) : LocationSet.t =
Expand Down
96 changes: 41 additions & 55 deletions lib/mdg/graph.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,26 +36,12 @@ and print_edge (from : location) (edges : EdgeSet.t) : unit =

let copy (graph : t) : t = HashTable.copy graph

let is_equal (graph : t) (graph' : t) : bool =
let result = ref true in
if HashTable.length graph = HashTable.length graph'
then (
HashTable.iter ( fun key value ->
if !result then
let value' = HashTable.find_opt graph' key in
if Option.is_some value'
then result := EdgeSet.equal value (Option.get value')
else result := false
) graph;
!result
)
else false

(* ------- M A I N F U N C T I O N S -------*)
let lub (graph : t) (graph' : t) : unit =
let lub (register : unit -> unit) (graph : t) (graph' : t) : unit =
(* least upper bound *)
HashTable.iter (fun from edges' ->
let edges = get_edges graph from in
if not (EdgeSet.subset edges' edges) then register ();
HashTable.replace graph from (EdgeSet.union edges edges');
) graph'

Expand Down Expand Up @@ -103,119 +89,119 @@ let rec lookup (graph : t) (l : location) (property : property) : location =
else failwith "property lookup failed, location doesn't posses such property"

(* ------- G R A P H M A N I P U L A T I O N ------- *)
let addNode (graph : t) (loc : location) : unit =
HashTable.add graph loc EdgeSet.empty
let addNode (register : unit -> unit) (graph : t) (loc : location) : unit =
if not (HashTable.mem graph loc) || not (EdgeSet.is_empty (HashTable.find graph loc)) then register ();
HashTable.replace graph loc EdgeSet.empty

let addEdge (graph : t) (edge : Edge.t) (_to : location) (from : location) : unit =
let addEdge (register : unit -> unit) (graph : t) (edge : Edge.t) (_to : location) (from : location) : unit =
let edges = get_edges graph from in
if not (EdgeSet.mem edge edges) then register ();
HashTable.replace graph from (EdgeSet.add edge edges)

let addDepEdge (graph : t) (from : location) (_to : location) : unit =
let addDepEdge (register : unit -> unit) (graph : t) (from : location) (_to : location) : unit =
let edge = {Edge._to = _to; info = Dependency} in
addEdge graph edge _to from
addEdge register graph edge _to from

let addPropEdge (graph : t) (from : location) (_to : location) (property : property option) : unit =
let addPropEdge (register : unit -> unit) (graph : t) (from : location) (_to : location) (property : property option) : unit =
let edge = {Edge._to = _to; info = Property property} in
addEdge graph edge _to from
addEdge register graph edge _to from

let addVersionEdge (graph : t) (from : location) (_to : location) (property : property option) : unit =
let addVersionEdge (register : unit -> unit) (graph : t) (from : location) (_to : location) (property : property option) : unit =
let edge = {Edge._to = _to; info = Version property} in
addEdge graph edge _to from
addEdge register graph edge _to from

let staticAddProperty (graph : t) (_L : LocationSet.t) (property : property) (id : int) : unit =
let staticAddProperty (register : unit -> unit) (graph : t) (_L : LocationSet.t) (property : property) (id : int) : unit =
LocationSet.iter (fun l ->
let l_o = orig graph l in

let edges = get_edges graph l_o in
if not (EdgeSet.exists (has_property_edge (Some property)) edges)
then let l_i = alloc graph id in
addPropEdge graph l_o l_i (Some property)
addPropEdge register graph l_o l_i (Some property)
) _L

let dynamicAddProperty (graph : t) (_L_obj : LocationSet.t) (_L_prop : LocationSet.t) (id : int) : unit =
let dynamicAddProperty (register : unit -> unit) (graph : t) (_L_obj : LocationSet.t) (_L_prop : LocationSet.t) (id : int) : unit =
LocationSet.iter (fun l ->
let l_o = orig graph l in

let edges = get_edges graph l_o in
if (EdgeSet.exists (has_property_edge None) edges) then
let {Edge._to; _} = EdgeSet.find_last (has_property_edge None) edges in
LocationSet.iter (flip (addDepEdge graph) _to) _L_prop
LocationSet.iter (flip (addDepEdge register graph) _to) _L_prop
else
( let l_i = alloc graph id in
addPropEdge graph l_o l_i None;
LocationSet.iter (flip (addDepEdge graph) l_i) _L_prop )
addPropEdge register graph l_o l_i None;
LocationSet.iter (flip (addDepEdge register graph) l_i) _L_prop )

) _L_obj


let sNVStrongUpdate (graph : t) (store : Store.t) (l : location) (property : property) (id : int) : LocationSet.t =
let sNVStrongUpdate (register : unit -> unit) (graph : t) (store : Store.t) (l : location) (property : property) (id : int) : LocationSet.t =
let l_i = alloc graph id in
addVersionEdge graph l l_i (Some property);
Store.strong_update store l l_i;
addVersionEdge register graph l l_i (Some property);
Store.strong_update register store l l_i;

(* return *)
LocationSet.singleton l_i

let sNVWeakUpdate (graph : t) (store : Store.t) (_object : string) (_L : LocationSet.t) (property : property) (id : int) : LocationSet.t =
let sNVWeakUpdate (register : unit -> unit) (graph : t) (store : Store.t) (_object : string) (_L : LocationSet.t) (property : property) (id : int) : LocationSet.t =
let l_i = alloc graph id in
LocationSet.iter ( fun l ->
(* add version edges *)
addVersionEdge graph l l_i (Some property);
addVersionEdge register graph l l_i (Some property);

(* store update *)
let _new = LocationSet.of_list [l; l_i] in
Store.weak_update store l _new
Store.weak_update register store l _new
) _L;
Store.update' store _object (LocationSet.singleton l_i);
Store.update' register store _object (LocationSet.singleton l_i);

(* return *)
LocationSet.singleton l_i

let staticNewVersion (graph : t) (store : Store.t) (_object : m Expression.t) (_L : LocationSet.t) (property : property) (id : int) : LocationSet.t =
let staticNewVersion (register : unit -> unit) (graph : t) (store : Store.t) (_object : m Expression.t) (_L : LocationSet.t) (property : property) (id : int) : LocationSet.t =
if LocationSet.cardinal _L = 1
then sNVStrongUpdate graph store (LocationSet.min_elt _L) property id
else sNVWeakUpdate graph store (get_expression_id _object) _L property id
then sNVStrongUpdate register graph store (LocationSet.min_elt _L) property id
else sNVWeakUpdate register graph store (get_expression_id _object) _L property id


let dNVStrongUpdate (graph : t) (store : Store.t) (l_obj : location) (_L_prop : LocationSet.t) (id : int) : LocationSet.t =
let dNVStrongUpdate (register : unit -> unit) (graph : t) (store : Store.t) (l_obj : location) (_L_prop : LocationSet.t) (id : int) : LocationSet.t =
let l_i = alloc graph id in
addVersionEdge graph l_obj l_i None;
addVersionEdge register graph l_obj l_i None;

(* add dependency edges *)
LocationSet.iter (fun l_prop ->
addDepEdge graph l_prop l_i
addDepEdge register graph l_prop l_i
) _L_prop;

Store.strong_update store l_obj l_i;
Store.strong_update register store l_obj l_i;

(* return *)
LocationSet.singleton l_i

let dNVWeakUpdate (graph : t) (store : Store.t) (_object : string) (_L_obj : LocationSet.t) (_L_prop : LocationSet.t) (id : int) : LocationSet.t =
let dNVWeakUpdate (register : unit -> unit) (graph : t) (store : Store.t) (_object : string) (_L_obj : LocationSet.t) (_L_prop : LocationSet.t) (id : int) : LocationSet.t =
let l_i = alloc graph id in
print_endline "yee";
LocationSet.iter ( fun l ->
print_endline l;
(* add version edges *)
addVersionEdge graph l l_i None;
addVersionEdge register graph l l_i None;

(* store update *)
let _new = LocationSet.of_list [l; l_i] in
Store.weak_update store l _new
Store.weak_update register store l _new
) _L_obj;
Store.update' store _object (LocationSet.singleton l_i);
Store.update' register store _object (LocationSet.singleton l_i);


(* add dependency edges *)
LocationSet.iter (fun l_prop ->
addDepEdge graph l_prop l_i
addDepEdge register graph l_prop l_i
) _L_prop;

(* return *)
LocationSet.singleton l_i

let dynamicNewVersion (graph : t) (store : Store.t) (_object : m Expression.t) (_L_obj : LocationSet.t) (_L_prop : LocationSet.t) (id : int) : LocationSet.t =
let dynamicNewVersion (register : unit -> unit) (graph : t) (store : Store.t) (_object : m Expression.t) (_L_obj : LocationSet.t) (_L_prop : LocationSet.t) (id : int) : LocationSet.t =
if LocationSet.cardinal _L_obj = 1
then dNVStrongUpdate graph store (LocationSet.min_elt _L_obj) _L_prop id
else dNVWeakUpdate graph store (get_expression_id _object) _L_obj _L_prop id
then dNVStrongUpdate register graph store (LocationSet.min_elt _L_obj) _L_prop id
else dNVWeakUpdate register graph store (get_expression_id _object) _L_obj _L_prop id

5 changes: 0 additions & 5 deletions lib/mdg/state.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,11 +17,6 @@ let copy ({graph; store; _} as state : state) : state =
graph = Graph.copy graph;
store = Store.copy store;
}

let is_equal (state : state) (state' : state) : bool =
Graph.is_equal state.graph state'.graph &&
Store.is_equal state.store state'.store &&
LocationSet.equal state.this state'.this



Expand Down
Loading

0 comments on commit 57423f4

Please sign in to comment.