1--  Copyright 1994 Grady Booch
2--  Copyright 1998-2014 Simon Wright <simon@pushface.org>
3
4--  This package is free software; you can redistribute it and/or
5--  modify it under terms of the GNU General Public License as
6--  published by the Free Software Foundation; either version 2, or
7--  (at your option) any later version. This package is distributed in
8--  the hope that it will be useful, but WITHOUT ANY WARRANTY; without
9--  even the implied warranty of MERCHANTABILITY or FITNESS FOR A
10--  PARTICULAR PURPOSE. See the GNU General Public License for more
11--  details. You should have received a copy of the GNU General Public
12--  License distributed with this package; see file COPYING.  If not,
13--  write to the Free Software Foundation, 59 Temple Place - Suite
14--  330, Boston, MA 02111-1307, USA.
15
16--  As a special exception, if other files instantiate generics from
17--  this unit, or you link this unit with other files to produce an
18--  executable, this unit does not by itself cause the resulting
19--  executable to be covered by the GNU General Public License.  This
20--  exception does not however invalidate any other reasons why the
21--  executable file might be covered by the GNU Public License.
22
23with System.Address_To_Access_Conversions;
24
25package body BC.Graphs.Undirected is
26
27
28   ----------------------
29   -- Graph operations --
30   ----------------------
31
32   procedure Create_Arc (G : in out Graph;
33                         A : in out Arc'Class;
34                         I : Arc_Item;
35                         First : in out Vertex'Class;
36                         Second : in out Vertex'Class) is
37   begin
38      Clear (A);
39      A.Rep := new Arc_Node'(Ada.Finalization.Controlled with
40                             Item => I,
41                             Enclosing => G'Unchecked_Access,
42                             From => First.Rep,
43                             To => Second.Rep,
44                             Next_Incoming => null,
45                             Next_Outgoing => null,
46                             Count => 1);
47      if Second.Rep /= null then
48         A.Rep.Next_Incoming := Second.Rep.Incoming;
49         Second.Rep.Incoming := A.Rep;
50         A.Rep.Count := A.Rep.Count + 1;
51         Second.Rep.Count := Second.Rep.Count + 1;
52      end if;
53      if First.Rep /= null then
54         A.Rep.Next_Outgoing := First.Rep.Outgoing;
55         First.Rep.Outgoing := A.Rep;
56         A.Rep.Count := A.Rep.Count + 1;
57         First.Rep.Count := First.Rep.Count + 1;
58      end if;
59   end Create_Arc;
60
61
62   -----------------------
63   -- Vertex operations --
64   -----------------------
65
66   function Arity (V : Vertex) return Natural is
67      Count : Natural := 0;
68      Curr : Arc_Node_Ptr;
69   begin
70      if V.Rep = null then
71         raise BC.Is_Null;
72      end if;
73      Curr := V.Rep.Incoming;
74      while Curr /= null loop
75         Count := Count + 1;
76         Curr := Curr.Next_Incoming;
77      end loop;
78      Curr := V.Rep.Outgoing;
79      while Curr /= null loop
80         if Curr.From /= Curr.To then
81            Count := Count + 1;
82         end if;
83         Curr := Curr.Next_Outgoing;
84      end loop;
85      return Count;
86   end Arity;
87
88
89   --------------------
90   -- Arc operations --
91   --------------------
92
93   procedure Set_First_Vertex (A : in out Arc;
94                               V : access Vertex'Class) is
95      Prev, Curr : Arc_Node_Ptr;
96   begin
97      if A.Rep = null then
98         raise BC.Is_Null;
99      end if;
100      if A.Rep.From /= null then
101         Prev := null;
102         Curr := A.Rep.From.Outgoing;
103         while Curr /= A.Rep loop
104            Prev := Curr;
105            Curr := Curr.Next_Outgoing;
106         end loop;
107         if Prev = null then
108            A.Rep.From.Outgoing := Curr.Next_Outgoing;
109         else
110            Prev.Next_Outgoing := Curr.Next_Outgoing;
111         end if;
112         A.Rep.From.Count := A.Rep.From.Count - 1;
113         A.Rep.Count := A.Rep.Count - 1;
114      end if;
115      if V.Rep /= null then
116         A.Rep.Next_Outgoing := V.Rep.Outgoing;
117         V.Rep.Outgoing := A.Rep;
118         A.Rep.Count := A.Rep.Count + 1;
119         V.Rep.Count := V.Rep.Count + 1;
120      end if;
121      A.Rep.From := V.Rep;
122   end Set_First_Vertex;
123
124
125   procedure Set_Second_Vertex (A : in out Arc;
126                                V : access Vertex'Class) is
127      Prev, Curr : Arc_Node_Ptr;
128   begin
129      if A.Rep = null then
130         raise BC.Is_Null;
131      end if;
132      if A.Rep.To /= null then
133         Prev := null;
134         Curr := A.Rep.To.Incoming;
135         while Curr /= A.Rep loop
136            Prev := Curr;
137            Curr := Curr.Next_Incoming;
138         end loop;
139         if Prev = null then
140            A.Rep.To.Incoming := Curr.Next_Incoming;
141         else
142            Prev.Next_Incoming := Curr.Next_Incoming;
143         end if;
144         A.Rep.To.Count := A.Rep.To.Count - 1;
145         A.Rep.Count := A.Rep.Count - 1;
146      end if;
147      if V.Rep /= null then
148         A.Rep.Next_Incoming := V.Rep.Incoming;
149         V.Rep.Incoming := A.Rep;
150         A.Rep.Count := A.Rep.Count + 1;
151         V.Rep.Count := V.Rep.Count + 1;
152      end if;
153      A.Rep.To := V.Rep;
154   end Set_Second_Vertex;
155
156
157   procedure First_Vertex (A : Arc;
158                           V : in out Vertex'Class) is
159   begin
160      if A.Rep = null then
161         raise BC.Is_Null;
162      end if;
163      Clear (V);
164      V.Rep := A.Rep.From;
165      if V.Rep /= null then
166         V.Rep.Count := V.Rep.Count + 1;
167      end if;
168   end First_Vertex;
169
170
171   procedure Second_Vertex (A : Arc;
172                            V : in out Vertex'Class) is
173   begin
174      if A.Rep = null then
175         raise BC.Is_Null;
176      end if;
177      Clear (V);
178      V.Rep := A.Rep.To;
179      if V.Rep /= null then
180         V.Rep.Count := V.Rep.Count + 1;
181      end if;
182   end Second_Vertex;
183
184
185   ---------------------
186   -- Graph iterators --
187   ---------------------
188
189
190   package Graph_Address_Conversions
191   is new System.Address_To_Access_Conversions (Graph);
192
193   function New_Graph_Iterator
194     (For_The_Graph : Graph) return Graph_Iterator'Class is
195      Result : constant Undirected_Graph_Iterator
196        := (For_The_Graph => Graph_Ptr (Graph_Address_Conversions.To_Pointer
197                                          (For_The_Graph'Address)),
198            Index => For_The_Graph.Rep);
199   begin
200      return Result;
201   end New_Graph_Iterator;
202
203
204   package Vertex_Address_Conversions
205   is new System.Address_To_Access_Conversions (Vertex);
206
207   function New_Vertex_Iterator
208     (For_The_Vertex : Vertex) return Vertex_Iterator'Class is
209      Result : Undirected_Vertex_Iterator;
210   begin
211      Result.For_The_Vertex :=
212        Vertex_Ptr (Vertex_Address_Conversions.To_Pointer
213                      (For_The_Vertex'Address));
214      Reset (Result);
215      return Result;
216   end New_Vertex_Iterator;
217
218
219   -------------------------------
220   -- Private iteration support --
221   -------------------------------
222
223   procedure Reset (It : in out Undirected_Graph_Iterator) is
224   begin
225      It.Index := It.For_The_Graph.Rep;
226   end Reset;
227
228
229   procedure Next (It : in out Undirected_Graph_Iterator) is
230   begin
231      if It.Index /= null then
232         It.Index := It.Index.Next;
233      end if;
234   end Next;
235
236
237   function Is_Done (It : Undirected_Graph_Iterator) return Boolean is
238   begin
239      return It.Index = null;
240   end Is_Done;
241
242
243   function Current_Vertex
244     (It : Undirected_Graph_Iterator) return Abstract_Vertex'Class is
245   begin
246      if It.Index = null then
247         raise BC.Is_Null;
248      end if;
249      It.Index.Count := It.Index.Count + 1;
250      return Vertex'
251        (Ada.Finalization.Controlled with Rep => It.Index);
252   end Current_Vertex;
253
254
255   ----------------------
256   -- Vertex iterators --
257   ----------------------
258
259   procedure Reset (It : in out Undirected_Vertex_Iterator) is
260   begin
261      It.Do_Outgoing := True;
262      if It.For_The_Vertex.Rep /= null then
263         It.Index := It.For_The_Vertex.Rep.Outgoing;
264         if It.Index = null then
265            It.Do_Outgoing := False;
266            It.Index := It.For_The_Vertex.Rep.Incoming;
267            --  skip self-directed arcs, already seen in outgoing side
268            --  XXX hmm, wouldn't .Outgoing have been non-null?
269            while It.Index /= null and then It.Index.From = It.Index.To loop
270               pragma Assert (False);
271               It.Index := It.Index.Next_Incoming;
272            end loop;
273         end if;
274      else
275         It.Index := null;
276      end if;
277   end Reset;
278
279
280   procedure Next (It : in out Undirected_Vertex_Iterator) is
281   begin
282      --  XXX I think we ought to check here that there is an Index!
283      if It.Do_Outgoing then
284         It.Index := It.Index.Next_Outgoing;
285         if It.Index = null then
286            It.Do_Outgoing := False;
287            It.Index := It.For_The_Vertex.Rep.Incoming;
288            --  skip self-directed arcs, already seen in outgoing side
289            while It.Index /= null and then It.Index.From = It.Index.To loop
290               It.Index := It.Index.Next_Incoming;
291            end loop;
292         end if;
293      elsif It.Index /= null then
294         It.Index := It.Index.Next_Incoming;
295         --  skip self-directed arcs, already seen in outgoing side
296         while It.Index /= null and then It.Index.From = It.Index.To loop
297            It.Index := It.Index.Next_Incoming;
298         end loop;
299      end if;
300   end Next;
301
302
303   function Is_Done (It : Undirected_Vertex_Iterator) return Boolean is
304   begin
305      return It.Index = null;
306   end Is_Done;
307
308
309   function Current_Arc (It : Undirected_Vertex_Iterator)
310                        return Abstract_Arc'Class is
311   begin
312      if It.Index = null then
313         raise BC.Is_Null;
314      end if;
315      It.Index.Count := It.Index.Count + 1;
316      return Arc'(Ada.Finalization.Controlled with Rep => It.Index);
317   end Current_Arc;
318
319
320end BC.Graphs.Undirected;
321