Source file dependencyManager.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
open Utils

module type Manager_sig =
  sig
    type t
    type elt
    val empty : t
    val add_dependency : elt -> elt -> t -> t
    val dependencies : elt -> t -> elt list
    val merge : t -> t -> t 
    val roots : t -> elt list
  end


(*module Make(O:sig type t val compare:t->t->int val to_string:t->string end) = *)
module Make(O:Map.OrderedType) =
struct
  module EltSet=Set.Make(O)
  module EltMap=Map.Make(O)

  type t = {depends_on:EltSet.t EltMap.t;
	    dependants:EltSet.t EltMap.t;
	   }

  type elt=O.t

  let empty = {depends_on=EltMap.empty;
	       dependants=EltMap.empty}

  let add_dependency e1 e2 man =
    let depends_on =
      try
	EltMap.find e1 man.depends_on
      with
      | Not_found -> EltSet.empty in
    let dependants =
      try
	EltMap.find e2 man.dependants
      with
      | Not_found -> EltSet.empty in
    {depends_on=EltMap.add e1 (EltSet.add e2 depends_on) man.depends_on;
     dependants=EltMap.add e2 (EltSet.add e1 dependants) man.dependants}
    
  let rec dependencies_rec elt man depth depthMap =
    try
      let dependants = EltMap.find elt man.dependants in
      let new_depthMap = 
	EltSet.fold
	  (fun elt depthMap ->
	   let depth =
	     try
	       max (depth+1) (EltMap.find elt depthMap)
	     with
	     | Not_found -> depth+1 in
	   EltMap.add elt depth depthMap)
	  dependants
	  depthMap in
      EltSet.fold
	(fun elt depthMap ->
	 dependencies_rec elt man (EltMap.find elt depthMap) depthMap)
	dependants
	new_depthMap
    with
    | Not_found -> depthMap
			      
  let dependencies elt man =
    let depthMap = dependencies_rec elt man 0 EltMap.empty in
    let orderedElt =
      EltMap.fold
	(fun elt depth acc ->
	 try 
	   IntMap.add depth (elt::(IntMap.find depth acc)) acc
	 with
	 | Not_found -> IntMap.add depth [elt] acc)
	depthMap
	IntMap.empty in
(*    let () =
      IntMap.iter
	(fun depth elts ->
	 Printf.printf
	   "at depth %i from %s we have the following elements: %s\n"
	   depth
	   (O.to_string elt)
	   (string_of_list " " O.to_string elts))
	orderedElt
    in *)
    List.rev
      (IntMap.fold
	 (fun _ elts acc -> elts@acc)
	 orderedElt
	 [])
   
  let set_merge elt dep map =
    let new_set =
      try
	EltSet.union dep (EltMap.find elt map)
      with
      | Not_found -> dep in
    EltMap.add elt new_set map

      
  let merge m1 m2 =
    {depends_on=EltMap.fold set_merge m1.depends_on m2.depends_on;
     dependants=EltMap.fold set_merge m1.dependants m2.dependants}


  let roots m =
    let rec roots_rec elt roots =
      try
	let depends_on = EltMap.find elt m.depends_on in
	EltSet.fold
	  (fun elt acc -> roots_rec elt acc)
	  depends_on
	  (EltSet.remove elt roots)
      with
      | Not_found -> EltSet.add elt roots in
    EltSet.elements 
      (EltMap.fold
	 (fun elt _ acc -> roots_rec elt acc)
	 m.depends_on
	 EltSet.empty)

end