Revision a5dc55ca
src/tools/seal_utils.ml  

2  2 
open Utils 
3  3 

4  4 
let report = Log.report ~plugin:"seal" 
5 


6 
let compute_sliced_vars vars_to_keep deps nd = 

7 
let is_variable vid = 

8 
List.exists 

9 
(fun v > v.var_id = vid) 

10 
nd.node_locals 

11 
in 

12 
let find_variable vid = 

13 
List.find 

14 
(fun v > v.var_id = vid) 

15 
nd.node_locals 

16 
in 

17  5  
18 
(* Returns the vars required to compute v. 

19 
Memories are specifically identified. *) 

20 
let coi_var v = 

21 
let vname = v.var_id in 

22 
let sliced_deps = 

23 
Causality.slice_graph deps vname 

24 
in 

25 
(* Format.eprintf "sliced graph for %a: %a@." 

26 
* Printers.pp_var v 

27 
* Causality.pp_dep_graph sliced_deps; *) 

28 
let vset, memset = 

29 
IdentDepGraph.fold_vertex 

30 
(fun vname (vset,memset) > 

31 
if Causality.ExprDep.is_read_var vname 

32 
then 

33 
let vname' = String.sub vname 1 (1 + String.length vname) in 

34 
if is_variable vname' then 

35 
ISet.add vname' vset, 

36 
ISet.add vname' memset 

37 
else 

38 
vset, memset 

39 
else 

40 
ISet.add vname vset, memset 

41 
) 

42 
sliced_deps 

43 
(ISet.singleton vname, ISet.empty) 

44 
in 

45 
report ~level:3 (fun fmt > Format.fprintf fmt "COI of var %s: (%a // %a)@." 

46 
v.var_id 

47 
(fprintf_list ~sep:"," Format.pp_print_string) (ISet.elements vset) 

48 
(fprintf_list ~sep:"," Format.pp_print_string) (ISet.elements memset) 

49 
) ; 

50 
vset, memset 

51 
in 

6 


7 


8 
(******************************************************************************) 

9 
(* Computing a slice of a node, selecting only some variables, based on *) 

10 
(* their COI (cone of influence) *) 

11 
(******************************************************************************) 

52  12  
53 
(* Computes the variables required to compute


54 
vl. Variables /seen/ do not need to


55 
be computed *)


56 
let rec coi_vars vl seen =


57 
List.fold_left


58 
(fun accu v > 

59 
let vset, memset = coi_var v in


60 
(* We handle the new mems


61 
discovered in the coi *)


62 
let memset =


63 
ISet.filter ( 

64 
fun vid >


65 
not


66 
(List.exists


67 
(fun v > v.var_id = vid)


68 
vl


69 
)


70 
) memset


71 
in


72 
let memset_vars =


73 
ISet.fold (


74 
fun vid accu >


75 
(find_variable vid)::accu


76 
) memset []


77 
in


78 
let vset' =


79 
coi_vars memset_vars (vl@seen)


80 
in


81 
ISet.union accu (ISet.union vset vset')


82 
)


83 
ISet.empty


84 
(List.filter


85 
(fun v > not (List.mem v seen))


86 
vl


13 
(* Basic functions to search into nodes. Could be moved to corelang eventually *)


14 
let is_variable nd vid =


15 
List.exists


16 
(fun v > v.var_id = vid)


17 
nd.node_locals


18 


19 
let find_variable nd vid =


20 
List.find


21 
(fun v > v.var_id = vid)


22 
nd.node_locals


23  
24 
(* Returns the vars required to compute v.


25 
Memories are specifically identified. *)


26 
let coi_var deps nd v =


27 
let vname = v.var_id in


28 
let sliced_deps =


29 
Causality.slice_graph deps vname


30 
in


31 
(* Format.eprintf "sliced graph for %a: %a@."


32 
* Printers.pp_var v


33 
* Causality.pp_dep_graph sliced_deps; *)


34 
let vset, memset =


35 
IdentDepGraph.fold_vertex


36 
(fun vname (vset,memset) >


37 
if Causality.ExprDep.is_read_var vname


38 
then


39 
let vname' = String.sub vname 1 (1 + String.length vname) in


40 
if is_variable nd vname' then


41 
ISet.add vname' vset,


42 
ISet.add vname' memset


43 
else


44 
vset, memset


45 
else


46 
ISet.add vname vset, memset


87  47 
) 
48 
sliced_deps 

49 
(ISet.singleton vname, ISet.empty) 

88  50 
in 
89 
ISet.elements (coi_vars vars_to_keep []) 

51 
report ~level:3 (fun fmt > Format.fprintf fmt "COI of var %s: (%a // %a)@." 

52 
v.var_id 

53 
(fprintf_list ~sep:"," Format.pp_print_string) (ISet.elements vset) 

54 
(fprintf_list ~sep:"," Format.pp_print_string) (ISet.elements memset) 

55 
) ; 

56 
vset, memset 

57  
58 


59 
(* Computes the variables required to compute vl. Variables /seen/ do not need 

60 
to be computed *) 

61 
let rec coi_vars deps nd vl seen = 

62 
let coi_vars = coi_vars deps nd in 

63 
List.fold_left 

64 
(fun accu v > 

65 
let vset, memset = coi_var deps nd v in 

66 
(* We handle the new mems discovered in the coi *) 

67 
let memset = 

68 
ISet.filter ( 

69 
fun vid > 

70 
not 

71 
(List.exists 

72 
(fun v > v.var_id = vid) 

73 
vl 

74 
) 

75 
) memset 

76 
in 

77 
let memset_vars = 

78 
ISet.fold ( 

79 
fun vid accu > 

80 
(find_variable nd vid)::accu 

81 
) memset [] 

82 
in 

83 
let vset' = 

84 
coi_vars memset_vars (vl@seen) 

85 
in 

86 
ISet.union accu (ISet.union vset vset') 

87 
) 

88 
ISet.empty 

89 
(List.filter 

90 
(fun v > not (List.mem v seen)) 

91 
vl 

92 
) 

93 


94 


95 
(* compute the coi of vars_to_keeps in node nd *) 

96 
let compute_sliced_vars vars_to_keep deps nd = 

97 
ISet.elements (coi_vars deps nd vars_to_keep []) 

98  
99  
100  
90  101  
91  102  
92  103 
(* If existing outputs are included in vars_to_keep, just slice the content. 
Also available in: Unified diff