summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/directed_graphs.adb344
-rw-r--r--src/directed_graphs.ads132
2 files changed, 359 insertions, 117 deletions
diff --git a/src/directed_graphs.adb b/src/directed_graphs.adb
index 3b4caee..4acf0fa 100644
--- a/src/directed_graphs.adb
+++ b/src/directed_graphs.adb
@@ -163,6 +163,31 @@ package body Directed_Graphs is
Container.Edge_Labels.Insert (Edge, Label);
end Append_Label;
+ procedure Append_Label
+ (Parent, Child : in out Cursor;
+ Label : in Edge_Label_Type) is
+ begin
+ if Impl.Checks then
+ if Parent.Container = null then
+ raise Constraint_Error with "Graph for parent cursor does not exist";
+ end if;
+ if Child.Container = null then
+ raise Constraint_Error with "Graph for child cursor does not exist";
+ end if;
+ if Parent.Container /= Child.Container then
+ raise Constraint_Error with "Cursors are for different graphs";
+ end if;
+ if not Has_Edge (Parent, Child) then
+ raise Constraint_Error with "Graph does not contain edge";
+ end if;
+ if Has_Label (Parent, Child) then
+ raise Constraint_Error with "Edge already has label";
+ end if;
+ end if;
+ Parent.Container.Edge_Labels.Insert
+ ((From => Element (Parent), To => Element (Child)), Label);
+ end Append_Label;
+
@@ -321,6 +346,41 @@ package body Directed_Graphs is
end;
end Constant_Label_Reference;
+ function Constant_Label_Reference
+ (Parent, Child : in Cursor)
+ return Edge_Label_Constant_Reference is
+ begin
+ if Impl.Checks then
+ if Parent.Container = null then
+ raise Constraint_Error with "Graph for parent cursor does not exist";
+ end if;
+ if Child.Container = null then
+ raise Constraint_Error with "Graph for child cursor does not exist";
+ end if;
+ if Parent.Container /= Child.Container then
+ raise Constraint_Error with "Cursors are for different graphs";
+ end if;
+ if not Has_Edge (Parent, Child) then
+ raise Constraint_Error with "Graph does not contain edge";
+ end if;
+ if not Has_Label (Parent, Child) then
+ raise Constraint_Error with "Edge does not have a label";
+ end if;
+ end if;
+ declare
+ Tamper : constant Help.Tamper_Counts_Access :=
+ Parent.Container.Tamper_Info'Unrestricted_Access;
+ Edge : Edge_Type := ((From => Element (Parent), To => Element (Child)));
+ begin
+ return Ref : constant Edge_Label_Constant_Reference :=
+ (Element => Parent.Container.Edge_Labels.Constant_Reference (Edge).Element,
+ Control => (Ada.Finalization.Controlled with Tamper))
+ do
+ Impl.Lock (Tamper.all);
+ end return;
+ end;
+ end Constant_Label_Reference;
+
@@ -533,39 +593,6 @@ package body Directed_Graphs is
- -------------
- -- Context --
- -------------
-
- procedure Context
- (Container : in Graph;
- Node : in Node_Type;
- Parents : out Node_Array;
- Children : out Node_Array) is
- begin
- Parents := Container.Parents (Node);
- Children := Container.Children (Node);
- end Context;
-
- procedure Context
- (Position : in Cursor;
- Parents : out Node_Array;
- Children : out Node_Array) is
- begin
- if Impl.Checks then
- if Position.Container = null then
- raise Constraint_Error with "Graph does not exist";
- end if;
- if not Has_Element (Position) then
- raise Constraint_Error with "Cursor points to nothing";
- end if;
- end if;
- Position.Container.Context (Element (Position), Parents, Children);
- end Context;
-
-
-
-
----------
-- Copy --
----------
@@ -582,6 +609,29 @@ package body Directed_Graphs is
+ ---------------
+ -- Cursor_To --
+ ---------------
+
+ function Cursor_To
+ (Position : in Cursor;
+ Node : in Node_Type)
+ return Cursor is
+ begin
+ if Impl.Checks then
+ if Position.Container = null then
+ raise Constraint_Error with "Graph does not exist";
+ end if;
+ if not Position.Container.Contains (Node) then
+ raise Constraint_Error with "Target node does not exist";
+ end if;
+ end if;
+ return Position.Container.To_Cursor (Node);
+ end Cursor_To;
+
+
+
+
------------
-- Degree --
------------
@@ -685,6 +735,27 @@ package body Directed_Graphs is
end Delete;
procedure Delete
+ (Parent, Child : in out Cursor) is
+ begin
+ if Impl.Checks then
+ if Parent.Container = null then
+ raise Constraint_Error with "Graph for parent cursor does not exist";
+ end if;
+ if Child.Container = null then
+ raise Constraint_Error with "Graph for child cursor does not exist";
+ end if;
+ if Parent.Container /= Child.Container then
+ raise Constraint_Error with "Cursors are for different graphs";
+ end if;
+ end if;
+ declare
+ Edge : Edge_Type := (From => Element (Parent), To => Element (Child));
+ begin
+ Parent.Container.Delete (Edge);
+ end;
+ end Delete;
+
+ procedure Delete
(Container : in out Graph;
Edges : in Edge_Array) is
begin
@@ -734,6 +805,27 @@ package body Directed_Graphs is
Container.Edge_Labels.Delete (Edge);
end Delete_Label;
+ procedure Delete_Label
+ (Parent, Child : in out Cursor) is
+ begin
+ if Impl.Checks then
+ if Parent.Container = null then
+ raise Constraint_Error with "Graph for parent cursor does not exist";
+ end if;
+ if Child.Container = null then
+ raise Constraint_Error with "Graph for child cursor does not exist";
+ end if;
+ if Parent.Container /= Child.Container then
+ raise Constraint_Error with "Cursors are for different graphs";
+ end if;
+ if not Has_Edge (Parent, Child) then
+ raise Constraint_Error with "Graph does not contain edge";
+ end if;
+ end if;
+ Parent.Container.Delete_Label
+ ((From => Element (Parent), To => Element (Child)));
+ end Delete_Label;
+
@@ -1041,6 +1133,32 @@ package body Directed_Graphs is
+ ------------
+ -- Follow --
+ ------------
+
+ function Follow
+ (Position : in Cursor;
+ Edge : in Edge_Type)
+ return Cursor is
+ begin
+ if Impl.Checks then
+ if Position.Container = null then
+ raise Constraint_Error with "Graph does not exist";
+ end if;
+ if not Has_Element (Position) then
+ raise Constraint_Error with "Cursor points to nothing";
+ end if;
+ if Element (Position) /= Edge.From then
+ raise Constraint_Error with "Cursor is not at tail of edge";
+ end if;
+ end if;
+ return Position.Container.To_Cursor (Edge.To);
+ end Follow;
+
+
+
+
--------------
-- Has_Edge --
--------------
@@ -1137,6 +1255,31 @@ package body Directed_Graphs is
return Container.Edge_Labels.Contains (Edge);
end Has_Label;
+ function Has_Label
+ (Parent, Child : in Cursor)
+ return Boolean is
+ begin
+ if Impl.Checks then
+ if Parent.Container = null then
+ raise Constraint_Error with "Graph for parent cursor does not exist";
+ end if;
+ if Child.Container = null then
+ raise Constraint_Error with "Graph for child cursor does not exist";
+ end if;
+ if Parent.Container /= Child.Container then
+ raise Constraint_Error with "Cursors are for different graphs";
+ end if;
+ if not Has_Element (Parent) then
+ raise Constraint_Error with "Parent cursor points to nothing";
+ end if;
+ if not Has_Element (Child) then
+ raise Constraint_Error with "Child cursor points to nothing";
+ end if;
+ end if;
+ return Parent.Container.Edge_Labels.Contains
+ ((From => Element (Parent), To => Element (Child)));
+ end Has_Label;
+
@@ -1361,6 +1504,38 @@ package body Directed_Graphs is
end Insert;
procedure Insert
+ (Parent, Child : in out Cursor) is
+ begin
+ if Impl.Checks then
+ if Parent.Container = null then
+ raise Constraint_Error with "Graph for parent cursor does not exist";
+ end if;
+ if Child.Container = null then
+ raise Constraint_Error with "Graph for child cursor does not exist";
+ end if;
+ if Parent.Container /= Child.Container then
+ raise Constraint_Error with "Cursors are for different graphs";
+ end if;
+ if not Has_Element (Parent) then
+ raise Constraint_Error with "Parent cursor points to nothing";
+ end if;
+ if not Has_Element (Child) then
+ raise Constraint_Error with "Child cursor points to nothing";
+ end if;
+ end if;
+ Parent.Container.Connections.Reference (Element (Parent)).Append (Element (Child));
+ end Insert;
+
+ procedure Insert
+ (Parent, Child : in out Cursor;
+ Label : in Edge_Label_Type) is
+ begin
+ Insert (Parent, Child);
+ Parent.Container.Edge_Labels.Insert
+ ((From => Element (Parent), To => Element (Child)), Label);
+ end Insert;
+
+ procedure Insert
(Container : in out Graph;
Edges : in Edge_Array) is
begin
@@ -1499,6 +1674,28 @@ package body Directed_Graphs is
return Container.Edge_Labels.Element (Edge);
end Label;
+ function Label
+ (Parent, Child : in Cursor)
+ return Edge_Label_Type is
+ begin
+ if Impl.Checks then
+ if Parent.Container = null then
+ raise Constraint_Error with "Graph for parent cursor does not exist";
+ end if;
+ if Child.Container = null then
+ raise Constraint_Error with "Graph for child cursor does not exist";
+ end if;
+ if Parent.Container /= Child.Container then
+ raise Constraint_Error with "Cursors are for different graphs";
+ end if;
+ if not Has_Edge (Parent, Child) then
+ raise Constraint_Error with "Graph does not contain edge";
+ end if;
+ end if;
+ return Parent.Container.Edge_Labels.Element
+ ((From => Element (Parent), To => Element (Child)));
+ end Label;
+
@@ -1571,41 +1768,40 @@ package body Directed_Graphs is
end;
end Label_Reference;
-
-
-
- ---------------------
- -- Labeled_Context --
- ---------------------
-
- procedure Labeled_Context
- (Container : in Graph;
- Node : in Node_Type;
- Parents : out Node_Array;
- Children : out Node_Array;
- Label : out Node_Label_Type) is
- begin
- Parents := Container.Parents (Node);
- Children := Container.Children (Node);
- Label := Container.Label (Node);
- end Labeled_Context;
-
- procedure Labeled_Context
- (Position : in Cursor;
- Parents : out Node_Array;
- Children : out Node_Array;
- Label : out Node_Label_Type) is
+ function Label_Reference
+ (Parent, Child : in Cursor)
+ return Edge_Label_Reference is
begin
if Impl.Checks then
- if Position.Container = null then
- raise Constraint_Error with "Graph does not exist";
+ if Parent.Container = null then
+ raise Constraint_Error with "Graph for parent cursor does not exist";
end if;
- if not Has_Element (Position) then
- raise Constraint_Error with "Cursor points to nothing";
+ if Child.Container = null then
+ raise Constraint_Error with "Graph for child cursor does not exist";
+ end if;
+ if Parent.Container /= Child.Container then
+ raise Constraint_Error with "Cursors are for different graphs";
+ end if;
+ if not Has_Edge (Parent, Child) then
+ raise Constraint_Error with "Graph does not contain edge";
+ end if;
+ if not Has_Label (Parent, Child) then
+ raise Constraint_Error with "Edge does not have a label";
end if;
end if;
- Position.Container.Labeled_Context (Element (Position), Parents, Children, Label);
- end Labeled_Context;
+ declare
+ Tamper : constant Help.Tamper_Counts_Access :=
+ Parent.Container.Tamper_Info'Unrestricted_Access;
+ Edge : Edge_Type := ((From => Element (Parent), To => Element (Child)));
+ begin
+ return Ref : constant Edge_Label_Reference :=
+ (Element => Parent.Container.Edge_Labels.Reference (Edge).Element,
+ Control => (Ada.Finalization.Controlled with Tamper))
+ do
+ Impl.Lock (Tamper.all);
+ end return;
+ end;
+ end Label_Reference;
@@ -2176,6 +2372,28 @@ package body Directed_Graphs is
Container.Edge_Labels.Replace (Edge, Label);
end Replace_Label;
+ procedure Replace_Label
+ (Parent, Child : in out Cursor;
+ Label : in Edge_Label_Type) is
+ begin
+ if Impl.Checks then
+ if Parent.Container = null then
+ raise Constraint_Error with "Graph for parent cursor does not exist";
+ end if;
+ if Child.Container = null then
+ raise Constraint_Error with "Graph for child cursor does not exist";
+ end if;
+ if Parent.Container /= Child.Container then
+ raise Constraint_Error with "Cursors belong to different graphs";
+ end if;
+ if not Has_Edge (Parent, Child) then
+ raise Constraint_Error with "Graph does not contain edge";
+ end if;
+ end if;
+ Parent.Container.Edge_Labels.Replace
+ ((From => Element (Parent), To => Element (Child)), Label);
+ end Replace_Label;
+
diff --git a/src/directed_graphs.ads b/src/directed_graphs.ads
index 17a0239..c8812a9 100644
--- a/src/directed_graphs.ads
+++ b/src/directed_graphs.ads
@@ -206,6 +206,13 @@ package Directed_Graphs is
Label : in Edge_Label_Type);
procedure Insert
+ (Parent, Child : in out Cursor);
+
+ procedure Insert
+ (Parent, Child : in out Cursor;
+ Label : in Edge_Label_Type);
+
+ procedure Insert
(Container : in out Graph;
Edges : in Edge_Array);
@@ -234,6 +241,9 @@ package Directed_Graphs is
Edge : in Edge_Type);
procedure Delete
+ (Parent, Child : in out Cursor);
+
+ procedure Delete
(Container : in out Graph;
Edges : in Edge_Array);
@@ -251,6 +261,10 @@ package Directed_Graphs is
Edge : in Edge_Type;
Label : in Edge_Label_Type);
+ procedure Append_Label
+ (Parent, Child : in out Cursor;
+ Label : in Edge_Label_Type);
+
procedure Replace_Label
(Container : in out Graph;
Node : in Node_Type;
@@ -265,6 +279,10 @@ package Directed_Graphs is
Edge : in Edge_Type;
Label : in Edge_Label_Type);
+ procedure Replace_Label
+ (Parent, Child : in out Cursor;
+ Label : in Edge_Label_Type);
+
procedure Delete_Label
(Container : in out Graph;
Node : in Node_Type);
@@ -276,6 +294,9 @@ package Directed_Graphs is
(Container : in out Graph;
Edge : in Edge_Type);
+ procedure Delete_Label
+ (Parent, Child : in out Cursor);
+
procedure Delete_Subgraph
(Position : in out Cursor);
@@ -289,58 +310,6 @@ package Directed_Graphs is
- procedure Context
- (Container : in Graph;
- Node : in Node_Type;
- Parents : out Node_Array;
- Children : out Node_Array);
-
- procedure Context
- (Position : in Cursor;
- Parents : out Node_Array;
- Children : out Node_Array);
-
- procedure Labeled_Context
- (Container : in Graph;
- Node : in Node_Type;
- Parents : out Node_Array;
- Children : out Node_Array;
- Label : out Node_Label_Type);
-
- procedure Labeled_Context
- (Position : in Cursor;
- Parents : out Node_Array;
- Children : out Node_Array;
- Label : out Node_Label_Type);
-
- function Has_Label
- (Container : in Graph;
- Node : in Node_Type)
- return Boolean;
-
- function Has_Label
- (Position : in Cursor)
- return Boolean;
-
- function Has_Label
- (Container : in Graph;
- Edge : in Edge_Type)
- return Boolean;
-
- function Label
- (Container : in Graph;
- Node : in Node_Type)
- return Node_Label_Type;
-
- function Label
- (Position : in Cursor)
- return Node_Label_Type;
-
- function Label
- (Container : in Graph;
- Edge : in Edge_Type)
- return Edge_Label_Type;
-
type Node_Label_Constant_Reference
(Element : not null access constant Node_Label_Type) is private
with Implicit_Dereference => Element;
@@ -376,6 +345,10 @@ package Directed_Graphs is
Edge : in Edge_Type)
return Edge_Label_Constant_Reference;
+ function Constant_Label_Reference
+ (Parent, Child : in Cursor)
+ return Edge_Label_Constant_Reference;
+
type Edge_Label_Reference
(Element : not null access Edge_Label_Type) is private
with Implicit_Dereference => Element;
@@ -385,6 +358,49 @@ package Directed_Graphs is
Edge : in Edge_Type)
return Edge_Label_Reference;
+ function Label_Reference
+ (Parent, Child : in Cursor)
+ return Edge_Label_Reference;
+
+
+
+
+ function Has_Label
+ (Container : in Graph;
+ Node : in Node_Type)
+ return Boolean;
+
+ function Has_Label
+ (Position : in Cursor)
+ return Boolean;
+
+ function Has_Label
+ (Container : in Graph;
+ Edge : in Edge_Type)
+ return Boolean;
+
+ function Has_Label
+ (Parent, Child : in Cursor)
+ return Boolean;
+
+ function Label
+ (Container : in Graph;
+ Node : in Node_Type)
+ return Node_Label_Type;
+
+ function Label
+ (Position : in Cursor)
+ return Node_Label_Type;
+
+ function Label
+ (Container : in Graph;
+ Edge : in Edge_Type)
+ return Edge_Label_Type;
+
+ function Label
+ (Parent, Child : in Cursor)
+ return Edge_Label_Type;
+
function Neighbors
(Container : in Graph;
Node : in Node_Type)
@@ -609,13 +625,22 @@ package Directed_Graphs is
procedure Previous
(Position : in out Cursor);
+ function Follow
+ (Position : in Cursor;
+ Edge : in Edge_Type)
+ return Cursor;
+
+ function Cursor_To
+ (Position : in Cursor;
+ Node : in Node_Type)
+ return Cursor;
+
private
pragma Inline (Append_Label);
pragma Inline (Assign);
- pragma Inline (Context);
pragma Inline (Copy);
pragma Inline (Degree);
pragma Inline (Delete_Label);
@@ -626,7 +651,6 @@ private
pragma Inline (Has_Neighbor);
pragma Inline (Is_Empty);
pragma Inline (Label);
- pragma Inline (Labeled_Context);
pragma Inline (Move);
pragma Inline (Replace_Label);
pragma Inline (To_Cursor);