From 01a397b9c565e60171434e2b2d0d694d8a54b1e8 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Fri, 24 Apr 2020 21:21:07 +1000 Subject: Library skeleton now compiles, with skeleton-related warnings --- src/directed_graphs.ads | 795 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 795 insertions(+) create mode 100644 src/directed_graphs.ads (limited to 'src/directed_graphs.ads') diff --git a/src/directed_graphs.ads b/src/directed_graphs.ads new file mode 100644 index 0000000..98b19af --- /dev/null +++ b/src/directed_graphs.ads @@ -0,0 +1,795 @@ + + +with + + Ada.Iterator_Interfaces; + +private with + + Ada.Containers.Helpers, + Ada.Finalization, + Ada.Streams, + Ada.Containers.Hashed_Maps, + Ada.Containers.Vectors; + + +generic + + type Node_Type is (<>); + type Node_Array is array (Positive range <>) of Node_Type; + + type Node_Label_Type is private; + type Edge_Label_Type is private; + + with function "=" + (Left, Right : in Node_Label_Type) + return Boolean is <>; + + with function "=" + (Left, Right : in Edge_Label_Type) + return Boolean is <>; + +package Directed_Graphs is + + + subtype Path is Node_Array; + + subtype Extended_Node_Type is Node_Type'Base + range Node_Type'Pred (Node_Type'First) .. Node_Type'Succ + (Node_Type'Min (Node_Type'Base'Pred (Node_Type'Base'Last), Node_Type'Last)); + + No_Node : constant Extended_Node_Type := Extended_Node_Type'First; + + + + + type Edge_Type is record + From : Node_Type; + To : Node_Type; + end record; + + type Edge_Array is array (Positive range <>) of Edge_Type; + + + + + type Graph is tagged private; + + type Cursor is private; + + No_Element : constant Cursor; + + function Has_Element + (Position : in Cursor) + return Boolean; + + package Graph_Iterator_Interfaces is new + Ada.Iterator_Interfaces (Cursor, Has_Element); + + Empty_Graph : constant Graph; + + overriding function "=" + (Left, Right : in Graph) + return Boolean; + + function To_Graph + (Nodes : in Node_Array; + Edges : in Edge_Array) + return Graph; + + function To_Cursor + (Container : in Graph; + Node : in Node_Type) + return Cursor; + + + + + procedure Assign + (Target : in out Graph; + Source : in Graph); + + function Copy + (Source : in Graph) + return Graph; + + procedure Move + (Target, Source : in out Graph); + + + + + function Is_Empty + (Container : in Graph) + return Boolean; + + procedure Clear + (Container : in out Graph); + + procedure Clear_Labels + (Container : in out Graph); + + + + + function Node_Count + (Container : in Graph) + return Ada.Containers.Count_Type; + + function Edge_Count + (Container : in Graph) + return Ada.Containers.Count_Type; + + function Nodes + (Container : in Graph) + return Node_Array; + + function Edges + (Container : in Graph) + return Edge_Array; + + procedure Node_Range + (Container : in Graph; + Minimum : out Node_Type; + Maximum : out Node_Type); + + function Unused_Nodes + (Container : in Graph; + Count : in Positive := 1) + return Node_Array; + + + + + procedure Insert + (Container : in out Graph; + Node : in Node_Type); + + procedure Insert + (Container : in out Graph; + Node : in Node_Type; + Label : in Node_Label_Type); + + procedure Insert + (Container : in out Graph; + Nodes : in Node_Array); + + procedure Insert + (Container : in out Graph; + Edge : in Edge_Type); + + procedure Insert + (Container : in out Graph; + Edge : in Edge_Type; + Label : in Edge_Label_Type); + + procedure Insert + (Container : in out Graph; + Edges : in Edge_Array); + + procedure Append + (Container : in out Graph; + Position : out Cursor); + + procedure Append + (Container : in out Graph; + Label : in Node_Label_Type; + Position : out Cursor); + + procedure Delete + (Container : in out Graph; + Node : in Node_Type); + + procedure Delete + (Position : in out Cursor); + + procedure Delete + (Container : in out Graph; + Nodes : in Node_Array); + + procedure Delete + (Container : in out Graph; + Edge : in Edge_Type); + + procedure Delete + (Container : in out Graph; + Edges : in Edge_Array); + + procedure Append_Label + (Container : in out Graph; + Node : in Node_Type; + Label : in Node_Label_Type); + + procedure Append_Label + (Position : in out Cursor; + Label : in Node_Label_Type); + + procedure Append_Label + (Container : in out Graph; + Edge : in Edge_Type; + Label : in Edge_Label_Type); + + procedure Replace_Label + (Container : in out Graph; + Node : in Node_Type; + Label : in Node_Label_Type); + + procedure Replace_Label + (Position : in out Cursor; + Label : in Node_Label_Type); + + procedure Replace_Label + (Container : in out Graph; + Edge : in Edge_Type; + Label : in Edge_Label_Type); + + procedure Delete_Label + (Container : in out Graph; + Node : in Node_Type); + + procedure Delete_Label + (Position : in out Cursor); + + procedure Delete_Label + (Container : in out Graph; + Edge : in Edge_Type); + + procedure Delete_Subgraph + (Position : in out Cursor); + + procedure Swap + (Container : in out Graph; + Left, Right : in Node_Type); + + procedure Swap + (Left, Right : in out Cursor); + + + + + 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; + + function Constant_Label_Reference + (Container : in Graph; + Node : in Node_Type) + return Node_Label_Constant_Reference; + + function Constant_Label_Reference + (Position : in Cursor) + return Node_Label_Constant_Reference; + + type Node_Label_Reference + (Element : not null access Node_Label_Type) is private + with Implicit_Dereference => Element; + + function Label_Reference + (Container : in Graph; + Node : in Node_Type) + return Node_Label_Reference; + + function Label_Reference + (Position : in Cursor) + return Node_Label_Reference; + + type Edge_Label_Constant_Reference + (Element : not null access constant Edge_Label_Type) is private + with Implicit_Dereference => Element; + + function Constant_Label_Reference + (Container : in Graph; + Edge : in Edge_Type) + return Edge_Label_Constant_Reference; + + type Edge_Label_Reference + (Element : not null access Edge_Label_Type) is private + with Implicit_Dereference => Element; + + function Label_Reference + (Container : in Graph; + Edge : in Edge_Type) + return Edge_Label_Reference; + + function Neighbors + (Container : in Graph; + Node : in Node_Type) + return Node_Array; + + function Neighbors + (Position : in Cursor) + return Node_Array; + + function Parents + (Container : in Graph; + Node : in Node_Type) + return Node_Array; + + function Parents + (Position : in Cursor) + return Node_Array; + + function Children + (Container : in Graph; + Node : in Node_Type) + return Node_Array; + + function Children + (Position : in Cursor) + return Node_Array; + + function Outbound + (Container : in Graph; + Node : in Node_Type) + return Edge_Array; + + function Outbound + (Position : in Cursor) + return Edge_Array; + + function Inbound + (Container : in Graph; + Node : in Node_Type) + return Edge_Array; + + function Inbound + (Position : in Cursor) + return Edge_Array; + + function Outdegree + (Container : in Graph; + Node : in Node_Type) + return Ada.Containers.Count_Type; + + function Outdegree + (Position : in Cursor) + return Ada.Containers.Count_Type; + + function Indegree + (Container : in Graph; + Node : in Node_Type) + return Ada.Containers.Count_Type; + + function Indegree + (Position : in Cursor) + return Ada.Containers.Count_Type; + + function Degree + (Container : in Graph; + Node : in Node_Type) + return Ada.Containers.Count_Type; + + function Degree + (Position : in Cursor) + return Ada.Containers.Count_Type; + + function Has_Edge + (Container : in Graph; + Parent, Child : in Node_Type) + return Boolean; + + function Has_Edge + (Parent, Child : in Cursor) + return Boolean; + + function Has_Labeled_Edge + (Container : in Graph; + Parent, Child : Node_Type) + return Boolean; + + function Has_Labeled_Edge + (Parent, Child : in Cursor) + return Boolean; + + function Has_Neighbor + (Container : in Graph; + Left, Right : in Node_Type) + return Boolean; + + function Has_Neighbor + (Left, Right : in Cursor) + return Boolean; + + + + + function Find + (Container : in Graph; + Label : in Node_Label_Type) + return Node_Array; + + function Find + (Container : in Graph; + Label : in Edge_Label_Type) + return Edge_Array; + + function Find_In_Subgraph + (Position : in Cursor; + Label : in Node_Label_Type) + return Node_Array; + + function Find_In_Subgraph + (Position : in Cursor; + Label : in Edge_Label_Type) + return Edge_Array; + + function Contains + (Container : in Graph; + Node : in Node_Type) + return Boolean; + + function Contains + (Container : in Graph; + Node : in Node_Type; + Label : in Node_Label_Type) + return Boolean; + + function Contains + (Container : in Graph; + Edge : in Edge_Type) + return Boolean; + + function Contains + (Container : in Graph; + Edge : in Edge_Type; + Label : in Edge_Label_Type) + return Boolean; + + function Contains_Label + (Container : in Graph; + Label : in Node_Label_Type) + return Boolean; + + function Contains_Label + (Container : in Graph; + Label : in Edge_Label_Type) + return Boolean; + + function Contains_In_Subgraph + (Position : in Cursor; + Node : in Node_Type) + return Boolean; + + function Contains_In_Subgraph + (Position : in Cursor; + Node : in Node_Type; + Label : in Node_Label_Type) + return Boolean; + + function Contains_In_Subgraph + (Position : in Cursor; + Edge : in Edge_Type) + return Boolean; + + function Contains_In_Subgraph + (Position : in Cursor; + Edge : in Edge_Type; + Label : in Edge_Label_Type) + return Boolean; + + function Contains_Label_In_Subgraph + (Position : in Cursor; + Label : in Node_Label_Type) + return Boolean; + + function Contains_Label_In_Subgraph + (Position : in Cursor; + Label : in Edge_Label_Type) + return Boolean; + + + + + function Iterate + (Container : in Graph) + return Graph_Iterator_Interfaces.Reversible_Iterator'Class; + + function Iterate_Subgraph + (Container : in Graph; + Position : in Cursor) + return Graph_Iterator_Interfaces.Forward_Iterator'Class; + + function First + (Container : in Graph) + return Cursor; + + function Last + (Container : in Graph) + return Cursor; + + function Next + (Position : in Cursor) + return Cursor; + + procedure Next + (Position : in out Cursor); + + function Previous + (Position : in Cursor) + return Cursor; + + procedure Previous + (Position : in out Cursor); + + +private + + + -- Put Inline Pragmas here + + + + + package Help renames Ada.Containers.Helpers; + package Impl is new Help.Generic_Implementation; + package Streams renames Ada.Streams; + + package Node_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Node_Type); + + function To_Hash + (Node : in Node_Type) + return Ada.Containers.Hash_Type; + + function To_Hash + (Edge : in Edge_Type) + return Ada.Containers.Hash_Type; + + package Node_Maps is new Ada.Containers.Hashed_Maps + (Key_Type => Node_Type, + Element_Type => Node_Vectors.Vector, + Hash => To_Hash, + Equivalent_Keys => "=", + "=" => Node_Vectors."="); + + package Node_Label_Maps is new Ada.Containers.Hashed_Maps + (Key_Type => Node_Type, + Element_Type => Node_Label_Type, + Hash => To_Hash, + Equivalent_Keys => "=", + "=" => "="); + + package Edge_Label_Maps is new Ada.Containers.Hashed_Maps + (Key_Type => Edge_Type, + Element_Type => Edge_Label_Type, + Hash => To_Hash, + Equivalent_Keys => "=", + "=" => "="); + + + + + type Graph is new Ada.Finalization.Controlled with record + Connections : Node_Maps.Map; + Node_Labels : Node_Label_Maps.Map; + Edge_Labels : Edge_Label_Maps.Map; + Tamper_Info : aliased Help.Tamper_Counts; + end record; + + overriding procedure Adjust + (Container : in out Graph); + + overriding procedure Finalize + (Container : in out Graph); + + procedure Write + (Stream : not null access Streams.Root_Stream_Type'Class; + Container : in Graph); + for Graph'Write use Write; + + procedure Read + (Stream : not null access Streams.Root_Stream_Type'Class; + Container : out Graph); + for Graph'Read use Read; + + type Graph_Access is access all Graph; + + Empty_Graph : constant Graph := (Ada.Finalization.Controlled with others => <>); + + + + + type Cursor is record + Container : Graph_Access; + Node : Node_Type := Node_Type'First; + end record; + + procedure Write + (Stream : not null access Streams.Root_Stream_Type'Class; + Position : in Cursor); + for Cursor'Write use Write; + + procedure Read + (Stream : not null access Streams.Root_Stream_Type'Class; + Position : out Cursor); + for Cursor'Read use Read; + + No_Element : constant Cursor := Cursor'(null, Node_Type'First); + + + + + subtype Reference_Control_Type is Impl.Reference_Control_Type; + + type Node_Label_Constant_Reference + (Element : not null access constant Node_Label_Type) is + record + Control : Reference_Control_Type := + raise Program_Error with "uninitialized reference"; + end record; + + procedure Write + (Stream : not null access Streams.Root_Stream_Type'Class; + Item : in Node_Label_Constant_Reference); + for Node_Label_Constant_Reference'Write use Write; + + procedure Read + (Stream : not null access Streams.Root_Stream_Type'Class; + Item : out Node_Label_Constant_Reference); + for Node_Label_Constant_Reference'Read use Read; + + type Node_Label_Reference + (Element : not null access Node_Label_Type) is + record + Control : Reference_Control_Type := + raise Program_Error with "uninitialized reference"; + end record; + + procedure Write + (Stream : not null access Streams.Root_Stream_Type'Class; + Item : in Node_Label_Reference); + for Node_Label_Reference'Write use Write; + + procedure Read + (Stream : not null access Streams.Root_Stream_Type'Class; + Item : out Node_Label_Reference); + for Node_Label_Reference'Read use Read; + + type Edge_Label_Constant_Reference + (Element : not null access constant Edge_Label_Type) is + record + Control : Reference_Control_Type := + raise Program_Error with "uninitialized reference"; + end record; + + procedure Write + (Stream : not null access Streams.Root_Stream_Type'Class; + Item : in Edge_Label_Constant_Reference); + for Edge_Label_Constant_Reference'Write use Write; + + procedure Read + (Stream : not null access Streams.Root_Stream_Type'Class; + Item : out Edge_Label_Constant_Reference); + for Edge_Label_Constant_Reference'Read use Read; + + type Edge_Label_Reference + (Element : not null access Edge_Label_Type) is + record + Control : Reference_Control_Type := + raise Program_Error with "uninitialized reference"; + end record; + + procedure Write + (Stream : not null access Streams.Root_Stream_Type'Class; + Item : in Edge_Label_Reference); + for Edge_Label_Reference'Write use Write; + + procedure Read + (Stream : not null access Streams.Root_Stream_Type'Class; + Item : out Edge_Label_Reference); + for Edge_Label_Reference'Read use Read; + + + + + type Iterator is new Ada.Finalization.Limited_Controlled and + Graph_Iterator_Interfaces.Reversible_Iterator with + record + Container : Graph_Access; + Node : Extended_Node_Type; + end record + with Disable_Controlled => not Impl.T_Check; + + overriding procedure Finalize + (Object : in out Iterator); + + overriding function First + (Object : in Iterator) + return Cursor; + + overriding function Last + (Object : in Iterator) + return Cursor; + + overriding function Next + (Object : in Iterator; + Position : in Cursor) + return Cursor; + + overriding function Previous + (Object : in Iterator; + Position : in Cursor) + return Cursor; + + + + + type Subgraph_Iterator is new Ada.Finalization.Limited_Controlled and + Graph_Iterator_Interfaces.Forward_Iterator with + record + Container : Graph_Access; + Root_Node : Node_Type; + Visited : Node_Vectors.Vector; + Current : Extended_Node_Type; + end record + with Disable_Controlled => not Impl.T_Check; + + overriding procedure Finalize + (Object : in out Subgraph_Iterator); + + overriding function First + (Object : in Subgraph_Iterator) + return Cursor; + + overriding function Next + (Object : in Subgraph_Iterator; + Position : in Cursor) + return Cursor; + + +end Directed_Graphs; + + -- cgit