diff options
| -rw-r--r-- | src/directed_graphs.adb | 344 | ||||
| -rw-r--r-- | src/directed_graphs.ads | 132 |
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); |