-- 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-directed.adb,v $
-- $Revision: 1.9.2.1 $
-- $Date: 2002/12/29 16:42:24 $
-- $Author: simon $
with BC.Support.Exceptions;
with System.Address_To_Access_Conversions;
package body BC.Graphs.Directed is
package BSE renames BC.Support.Exceptions;
procedure Assert
is new BSE.Assert ("BC.Graphs.Directed");
----------------------
-- Graph operations --
----------------------
procedure Create_Arc (G : in out Graph;
A : in out Arc'Class;
I : Arc_Item;
From : in out Vertex'Class;
To : in out Vertex'Class) is
begin
Clear (A);
A.Rep := new Arc_Node'(Ada.Finalization.Controlled with
Item => I,
Enclosing => G'Unchecked_Access,
From => From.Rep,
To => To.Rep,
Next_Incoming => null,
Next_Outgoing => null,
Count => 1);
if To.Rep /= null then
A.Rep.Next_Incoming := To.Rep.Incoming;
To.Rep.Incoming := A.Rep;
A.Rep.Count := A.Rep.Count + 1;
To.Rep.Count := To.Rep.Count + 1;
end if;
if From.Rep /= null then
A.Rep.Next_Outgoing := From.Rep.Outgoing;
From.Rep.Outgoing := A.Rep;
A.Rep.Count := A.Rep.Count + 1;
From.Rep.Count := From.Rep.Count + 1;
end if;
end Create_Arc;
-----------------------
-- Vertex operations --
-----------------------
function Number_Of_Incoming_Arcs (V : Vertex) return Natural is
Count : Natural := 0;
Curr : Arc_Node_Ptr;
begin
Assert (V.Rep /= null,
BC.Is_Null'Identity,
"Number_Of_Incoming_Arcs",
BSE.Is_Null);
Curr := V.Rep.Incoming;
while Curr /= null loop
Count := Count + 1;
Curr := Curr.Next_Incoming;
end loop;
return Count;
end Number_Of_Incoming_Arcs;
function Number_Of_Outgoing_Arcs (V : Vertex) return Natural is
Count : Natural := 0;
Curr : Arc_Node_Ptr;
begin
Assert (V.Rep /= null,
BC.Is_Null'Identity,
"Number_Of_Outgoing_Arcs",
BSE.Is_Null);
Curr := V.Rep.Outgoing;
while Curr /= null loop
Count := Count + 1;
Curr := Curr.Next_Outgoing;
end loop;
return Count;
end Number_Of_Outgoing_Arcs;
--------------------
-- Arc operations --
--------------------
procedure Set_From_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.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_From_Vertex;
procedure Set_To_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_To_Vertex;
procedure From_Vertex (A : Arc; V : in out Vertex'Class) is
begin
Assert (A.Rep /= null,
BC.Is_Null'Identity,
"From_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 From_Vertex;
procedure To_Vertex (A : Arc; V : in out Vertex'Class) is
begin
Assert (A.Rep /= null,
BC.Is_Null'Identity,
"To_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 To_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
begin
return Directed_Graph_Iterator'
(For_The_Graph => Graph_Address_Conversions.To_Pointer
(For_The_Graph'Address).all'Access,
Index => For_The_Graph.Rep);
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 : Vertex_Bothways_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;
function New_Vertex_Incoming_Iterator
(For_The_Vertex : Vertex) return Vertex_Iterator'Class is
Result : Vertex_Incoming_Iterator;
begin
Result.For_The_Vertex :=
Vertex_Address_Conversions.To_Pointer
(For_The_Vertex'Address).all'Access;
Reset (Result);
return Result;
end New_Vertex_Incoming_Iterator;
function New_Vertex_Outgoing_Iterator
(For_The_Vertex : Vertex) return Vertex_Iterator'Class is
Result : Vertex_Outgoing_Iterator;
begin
Result.For_The_Vertex :=
Vertex_Address_Conversions.To_Pointer
(For_The_Vertex'Address).all'Access;
Reset (Result);
return Result;
end New_Vertex_Outgoing_Iterator;
-------------------------------
-- Private iteration support --
-------------------------------
procedure Reset (It : in out Directed_Graph_Iterator) is
begin
It.Index := It.For_The_Graph.Rep;
end Reset;
procedure Next (It : in out Directed_Graph_Iterator) is
begin
if It.Index /= null then
It.Index := It.Index.Next;
end if;
end Next;
function Is_Done (It : Directed_Graph_Iterator) return Boolean is
begin
return It.Index = null;
end Is_Done;
function Current_Vertex (It : Directed_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 --
----------------------
--------------
-- Abstract --
--------------
function Is_Done (It : Vertex_Abstract_Iterator) return Boolean is
begin
return It.Index = null;
end Is_Done;
function Current_Arc (It : Vertex_Abstract_Iterator)
return Abstract_Arc'Class is
begin
Assert (It.Index /= null,
BC.Is_Null'Identity,
"Current_Arc(Vertex_Outgoing_Iterator)",
BSE.Is_Null);
It.Index.Count := It.Index.Count + 1;
return Arc'(Ada.Finalization.Controlled with Rep => It.Index);
end Current_Arc;
--------------
-- Bothways --
--------------
procedure Reset (It : in out Vertex_Bothways_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 Vertex_Bothways_Iterator) is
begin
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;
--------------
-- Outgoing --
--------------
procedure Reset (It : in out Vertex_Outgoing_Iterator) is
begin
if It.For_The_Vertex.Rep /= null then
It.Index := It.For_The_Vertex.Rep.Outgoing;
else
It.Index := null;
end if;
end Reset;
procedure Next (It : in out Vertex_Outgoing_Iterator) is
begin
if It.Index /= null then
It.Index := It.Index.Next_Outgoing;
end if;
end Next;
--------------
-- Incoming --
--------------
procedure Reset (It : in out Vertex_Incoming_Iterator) is
begin
if It.For_The_Vertex.Rep /= null then
It.Index := It.For_The_Vertex.Rep.Incoming;
else
It.Index := null;
end if;
end Reset;
procedure Next (It : in out Vertex_Incoming_Iterator) is
begin
if It.Index /= null then
It.Index := It.Index.Next_Incoming;
end if;
end Next;
end BC.Graphs.Directed;
syntax highlighted by Code2HTML, v. 0.9.1