-- Copyright 1994 Grady Booch
-- Copyright 1998-2002 Simon Wright <simon@pushface.org>
-- This package is free software; you can redistribute it and/or
-- modify it under terms of the GNU General Public License as
-- published by the Free Software Foundation; either version 2, or
-- (at your option) any later version. This package is distributed in
-- the hope that it will be useful, but WITHOUT ANY WARRANTY; without
-- even the implied warranty of MERCHANTABILITY or FITNESS FOR A
-- PARTICULAR PURPOSE. See the GNU General Public License for more
-- details. You should have received a copy of the GNU General Public
-- License distributed with this package; see file COPYING. If not,
-- write to the Free Software Foundation, 59 Temple Place - Suite
-- 330, Boston, MA 02111-1307, USA.
-- As a special exception, if other files instantiate generics from
-- this unit, or you link this unit with other files to produce an
-- executable, this unit does not by itself cause the resulting
-- executable to be covered by the GNU General Public License. This
-- exception does not however invalidate any other reasons why the
-- executable file might be covered by the GNU Public License.
-- $RCSfile: bc-graphs-undirected.adb,v $
-- $Revision: 1.9.2.1 $
-- $Date: 2002/12/29 16:42:26 $
-- $Author: simon $
with BC.Support.Exceptions;
with System.Address_To_Access_Conversions;
package body BC.Graphs.Undirected is
package BSE renames BC.Support.Exceptions;
procedure Assert
is new BSE.Assert ("BC.Graphs.Undirected");
----------------------
-- Graph operations --
----------------------
procedure Create_Arc (G : in out Graph;
A : in out Arc'Class;
I : Arc_Item;
First : in out Vertex'Class;
Second : in out Vertex'Class) is
begin
Clear (A);
A.Rep := new Arc_Node'(Ada.Finalization.Controlled with
Item => I,
Enclosing => G'Unchecked_Access,
From => First.Rep,
To => Second.Rep,
Next_Incoming => null,
Next_Outgoing => null,
Count => 1);
if Second.Rep /= null then
A.Rep.Next_Incoming := Second.Rep.Incoming;
Second.Rep.Incoming := A.Rep;
A.Rep.Count := A.Rep.Count + 1;
Second.Rep.Count := Second.Rep.Count + 1;
end if;
if First.Rep /= null then
A.Rep.Next_Outgoing := First.Rep.Outgoing;
First.Rep.Outgoing := A.Rep;
A.Rep.Count := A.Rep.Count + 1;
First.Rep.Count := First.Rep.Count + 1;
end if;
end Create_Arc;
-----------------------
-- Vertex operations --
-----------------------
function Arity (V : Vertex) return Natural is
Count : Natural := 0;
Curr : Arc_Node_Ptr;
begin
Assert (V.Rep /= null,
BC.Is_Null'Identity,
"Arity",
BSE.Is_Null);
Curr := V.Rep.Incoming;
while Curr /= null loop
Count := Count + 1;
Curr := Curr.Next_Incoming;
end loop;
Curr := V.Rep.Outgoing;
while Curr /= null loop
if Curr.From /= Curr.To then
Count := Count + 1;
end if;
Curr := Curr.Next_Outgoing;
end loop;
return Count;
end Arity;
--------------------
-- Arc operations --
--------------------
procedure Set_First_Vertex (A : in out Arc;
V : access Vertex'Class) is
Prev, Curr : Arc_Node_Ptr;
begin
Assert (A.Rep /= null,
BC.Is_Null'Identity,
"Set_First_Vertex",
BSE.Is_Null);
if A.Rep.From /= null then
Prev := null;
Curr := A.Rep.From.Outgoing;
while Curr /= A.Rep loop
Prev := Curr;
Curr := Curr.Next_Outgoing;
end loop;
if Prev = null then
A.Rep.From.Outgoing := Curr.Next_Outgoing;
else
Prev.Next_Outgoing := Curr.Next_Outgoing;
end if;
A.Rep.From.Count := A.Rep.From.Count - 1;
A.Rep.Count := A.Rep.Count - 1;
end if;
if V.Rep /= null then
A.Rep.Next_Outgoing := V.Rep.Outgoing;
V.Rep.Outgoing := A.Rep;
A.Rep.Count := A.Rep.Count + 1;
V.Rep.Count := V.Rep.Count + 1;
end if;
A.Rep.From := V.Rep;
end Set_First_Vertex;
procedure Set_Second_Vertex (A : in out Arc;
V : access Vertex'Class) is
Prev, Curr : Arc_Node_Ptr;
begin
Assert (A.Rep /= null,
BC.Is_Null'Identity,
"Set_From_Vertex",
BSE.Is_Null);
if A.Rep.To /= null then
Prev := null;
Curr := A.Rep.To.Incoming;
while Curr /= A.Rep loop
Prev := Curr;
Curr := Curr.Next_Incoming;
end loop;
if Prev = null then
A.Rep.To.Incoming := Curr.Next_Incoming;
else
Prev.Next_Incoming := Curr.Next_Incoming;
end if;
A.Rep.To.Count := A.Rep.To.Count - 1;
A.Rep.Count := A.Rep.Count - 1;
end if;
if V.Rep /= null then
A.Rep.Next_Incoming := V.Rep.Incoming;
V.Rep.Incoming := A.Rep;
A.Rep.Count := A.Rep.Count + 1;
V.Rep.Count := V.Rep.Count + 1;
end if;
A.Rep.To := V.Rep;
end Set_Second_Vertex;
procedure First_Vertex (A : Arc;
V : in out Vertex'Class) is
begin
Assert (A.Rep /= null,
BC.Is_Null'Identity,
"First_Vertex",
BSE.Is_Null);
Clear (V);
V.Rep := A.Rep.From;
if V.Rep /= null then
V.Rep.Count := V.Rep.Count + 1;
end if;
end First_Vertex;
procedure Second_Vertex (A : Arc;
V : in out Vertex'Class) is
begin
Assert (A.Rep /= null,
BC.Is_Null'Identity,
"Second_Vertex",
BSE.Is_Null);
Clear (V);
V.Rep := A.Rep.To;
if V.Rep /= null then
V.Rep.Count := V.Rep.Count + 1;
end if;
end Second_Vertex;
---------------------
-- Graph iterators --
---------------------
package Graph_Address_Conversions
is new System.Address_To_Access_Conversions (Graph);
function New_Graph_Iterator
(For_The_Graph : Graph) return Graph_Iterator'Class is
Result : Undirected_Graph_Iterator
:= (For_The_Graph => Graph_Address_Conversions.To_Pointer
(For_The_Graph'Address).all'Access,
Index => For_The_Graph.Rep);
begin
return Result;
end New_Graph_Iterator;
package Vertex_Address_Conversions
is new System.Address_To_Access_Conversions (Vertex);
function New_Vertex_Iterator
(For_The_Vertex : Vertex) return Vertex_Iterator'Class is
Result : Undirected_Vertex_Iterator;
begin
Result.For_The_Vertex :=
Vertex_Address_Conversions.To_Pointer
(For_The_Vertex'Address).all'Access;
Reset (Result);
return Result;
end New_Vertex_Iterator;
-------------------------------
-- Private iteration support --
-------------------------------
procedure Reset (It : in out Undirected_Graph_Iterator) is
begin
It.Index := It.For_The_Graph.Rep;
end Reset;
procedure Next (It : in out Undirected_Graph_Iterator) is
begin
if It.Index /= null then
It.Index := It.Index.Next;
end if;
end Next;
function Is_Done (It : Undirected_Graph_Iterator) return Boolean is
begin
return It.Index = null;
end Is_Done;
function Current_Vertex
(It : Undirected_Graph_Iterator) return Abstract_Vertex'Class is
begin
Assert (It.Index /= null,
BC.Is_Null'Identity,
"Current_Vertex(Graph_Iterator)",
BSE.Is_Null);
It.Index.Count := It.Index.Count + 1;
return Vertex'
(Ada.Finalization.Controlled with Rep => It.Index);
end Current_Vertex;
----------------------
-- Vertex iterators --
----------------------
procedure Reset (It : in out Undirected_Vertex_Iterator) is
begin
It.Do_Outgoing := True;
if It.For_The_Vertex.Rep /= null then
It.Index := It.For_The_Vertex.Rep.Outgoing;
if It.Index = null then
It.Do_Outgoing := False;
It.Index := It.For_The_Vertex.Rep.Incoming;
-- skip self-directed arcs, already seen in outgoing side
-- XXX hmm, wouldn't .Outgoing have been non-null?
while It.Index /= null and then It.Index.From = It.Index.To loop
pragma Assert (False);
It.Index := It.Index.Next_Incoming;
end loop;
end if;
else
It.Index := null;
end if;
end Reset;
procedure Next (It : in out Undirected_Vertex_Iterator) is
begin
-- XXX I think we ought to check here that there is an Index!
if It.Do_Outgoing then
It.Index := It.Index.Next_Outgoing;
if It.Index = null then
It.Do_Outgoing := False;
It.Index := It.For_The_Vertex.Rep.Incoming;
-- skip self-directed arcs, already seen in outgoing side
while It.Index /= null and then It.Index.From = It.Index.To loop
It.Index := It.Index.Next_Incoming;
end loop;
end if;
elsif It.Index /= null then
It.Index := It.Index.Next_Incoming;
-- skip self-directed arcs, already seen in outgoing side
while It.Index /= null and then It.Index.From = It.Index.To loop
It.Index := It.Index.Next_Incoming;
end loop;
end if;
end Next;
function Is_Done (It : Undirected_Vertex_Iterator) return Boolean is
begin
return It.Index = null;
end Is_Done;
function Current_Arc (It : Undirected_Vertex_Iterator)
return Abstract_Arc'Class is
begin
Assert (It.Index /= null,
BC.Is_Null'Identity,
"Current_Arc(Arc_Iterator)",
BSE.Is_Null);
It.Index.Count := It.Index.Count + 1;
return Arc'(Ada.Finalization.Controlled with Rep => It.Index);
end Current_Arc;
end BC.Graphs.Undirected;