From 8ff5f7f854b450c787db21a44c0d1fa0ee9d6917 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Tue, 28 Apr 2020 17:15:49 +1000 Subject: Vector_To_Array function now generic --- src/directed_graphs.adb | 160 ++++++++++++------------------------------------ 1 file changed, 38 insertions(+), 122 deletions(-) (limited to 'src/directed_graphs.adb') diff --git a/src/directed_graphs.adb b/src/directed_graphs.adb index 82b6bff..3e32dff 100644 --- a/src/directed_graphs.adb +++ b/src/directed_graphs.adb @@ -1,69 +1,5 @@ --- Done list: --- --- "=" --- Append --- Append_Label --- Assign --- Children --- Clear --- Clear_Labels --- Constant_Label_Reference --- Contains --- Contains_In_Subgraph --- Contains_Label --- Contains_Label_In_Subgraph --- Context --- Copy --- Degree --- Delete --- Delete_Label --- Delete_Subgraph --- Edge_Count --- Edges --- Element --- Finalize --- Find --- Find_In_Subgraph --- First --- Has_Edge --- Has_Element --- Has_Label --- Has_Labeled_Edge --- Has_Neighbor --- Inbound --- Indegree --- Insert --- Is_Empty --- Iterate --- Iterate_Subgraph --- Keys --- Label --- Label_Reference --- Labeled_Context --- Last --- Move --- Neighbors --- Next --- Node_Count --- Node_Range --- Nodes --- Outbound --- Outdegree --- Parents --- Previous --- Read --- Replace_Label --- Swap --- To_Cursor --- To_Graph --- To_Hash --- Unused_Nodes --- Vector_To_Array --- Write - - package body Directed_Graphs is @@ -74,6 +10,7 @@ package body Directed_Graphs is + -- Make these Keys functions generic after switching to ordered maps function Keys (My_Map : in Node_Maps.Map) return Node_Vectors.Vector; @@ -86,23 +23,15 @@ package body Directed_Graphs is (My_Map : in Edge_Label_Maps.Map) return Edge_Vectors.Vector; - -- generic - -- type Base_Type is private; - -- with package Type_Vectors is new Ada.Containers.Vectors - -- (Index_Type => Positive, - -- Element_Type => Base_Type); - -- type Array_Type is array (Positive range <>) of Base_Type; - -- function Vector_To_Array - -- (Input : in Type_Vectors.Vector) - -- return Array_Type; - - function Vector_To_Array - (Input : in Node_Vectors.Vector) - return Node_Array; - + generic + type Base_Type is private; + type Array_Type is array (Positive range <>) of Base_Type; + with package Type_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Base_Type); function Vector_To_Array - (Input : in Edge_Vectors.Vector) - return Edge_Array; + (Input : in Type_Vectors.Vector) + return Array_Type; @@ -236,12 +165,12 @@ package body Directed_Graphs is return Node_Array is Lock : Impl.With_Lock (Container.Tamper_Info'Unrestricted_Access); - -- function Convert is new Vector_To_Array (Node_Type, Node_Vectors, Node_Array); + function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); begin if Impl.Checks and then not Container.Contains (Node) then raise Constraint_Error with "Graph does not contain node"; end if; - return Vector_To_Array (Container.Connections.Constant_Reference (Node)); + return V2A (Container.Connections.Constant_Reference (Node)); end Children; function Children @@ -751,6 +680,7 @@ package body Directed_Graphs is (Position : in out Cursor) is Nodes : Node_Vectors.Vector; + function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); begin if Impl.Checks and then Position.Container = null then raise Constraint_Error with "Graph does not exist"; @@ -758,7 +688,7 @@ package body Directed_Graphs is for C in Position.Container.Iterate_Subgraph (Position) loop Nodes.Append (C.Node); end loop; - Position.Container.Delete (Vector_To_Array (Nodes)); + Position.Container.Delete (V2A (Nodes)); end Delete_Subgraph; @@ -809,7 +739,7 @@ package body Directed_Graphs is return Edge_Array is Tos : Edge_Vectors.Vector; - -- function Convert is new Vector_To_Array (Edge_Type, Edge_Vectors, Edge_Array); + function V2A is new Vector_To_Array (Edge_Type, Edge_Array, Edge_Vectors); begin for C in Container.Connections.Iterate loop for N of Container.Connections.Constant_Reference (C) loop @@ -818,7 +748,7 @@ package body Directed_Graphs is To => N)); end loop; end loop; - return Vector_To_Array (Tos); + return V2A (Tos); end Edges; function Edges @@ -826,6 +756,7 @@ package body Directed_Graphs is return Edge_Array is Tos : Edge_Vectors.Vector; + function V2A is new Vector_To_Array (Edge_Type, Edge_Array, Edge_Vectors); begin if Impl.Checks and then Position.Container = null then raise Constraint_Error with "Graph does not exist"; @@ -835,7 +766,7 @@ package body Directed_Graphs is Tos.Append (E); end loop; end loop; - return Vector_To_Array (Tos); + return V2A (Tos); end Edges; @@ -893,13 +824,14 @@ package body Directed_Graphs is return Node_Array is Result : Node_Vectors.Vector; + function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); begin for C in Container.Node_Labels.Iterate loop if Container.Node_Labels.Constant_Reference (C) = Label then Result.Append (Node_Label_Maps.Key (C)); end if; end loop; - return Vector_To_Array (Result); + return V2A (Result); end Find; function Find @@ -908,13 +840,14 @@ package body Directed_Graphs is return Edge_Array is Result : Edge_Vectors.Vector; + function V2A is new Vector_To_Array (Edge_Type, Edge_Array, Edge_Vectors); begin for C in Container.Edge_Labels.Iterate loop if Container.Edge_Labels.Constant_Reference (C) = Label then Result.Append (Edge_Label_Maps.Key (C)); end if; end loop; - return Vector_To_Array (Result); + return V2A (Result); end Find; @@ -930,6 +863,7 @@ package body Directed_Graphs is return Node_Array is Result : Node_Vectors.Vector; + function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); begin if Impl.Checks and then Position.Container = null then raise Constraint_Error with "Graph does not exist"; @@ -939,7 +873,7 @@ package body Directed_Graphs is Result.Append (C.Node); end if; end loop; - return Vector_To_Array (Result); + return V2A (Result); end Find_In_Subgraph; function Find_In_Subgraph @@ -949,6 +883,7 @@ package body Directed_Graphs is is Nodes : Node_Vectors.Vector; Result : Edge_Vectors.Vector; + function V2A is new Vector_To_Array (Edge_Type, Edge_Array, Edge_Vectors); begin if Impl.Checks and then Position.Container = null then raise Constraint_Error with "Graph does not exist"; @@ -964,7 +899,7 @@ package body Directed_Graphs is Result.Append (E); end if; end loop; - return Vector_To_Array (Result); + return V2A (Result); end Find_In_Subgraph; @@ -1148,6 +1083,7 @@ package body Directed_Graphs is is Lock : Impl.With_Lock (Container.Tamper_Info'Unrestricted_Access); Edges : Edge_Vectors.Vector; + function V2A is new Vector_To_Array (Edge_Type, Edge_Array, Edge_Vectors); begin for C in Container.Connections.Iterate loop for N of Container.Connections.Constant_Reference (C) loop @@ -1158,7 +1094,7 @@ package body Directed_Graphs is end if; end loop; end loop; - return Vector_To_Array (Edges); + return V2A (Edges); end Inbound; function Inbound @@ -1560,6 +1496,7 @@ package body Directed_Graphs is Nodes : Node_Vectors.Vector; Ref : Node_Maps.Constant_Reference_Type := Container.Connections.Constant_Reference (Node); + function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); begin for C in Container.Connections.Iterate loop for N of Container.Connections.Constant_Reference (C) loop @@ -1569,7 +1506,7 @@ package body Directed_Graphs is end if; end loop; end loop; - return Vector_To_Array (Nodes); + return V2A (Nodes); end Neighbors; function Neighbors @@ -1728,9 +1665,9 @@ package body Directed_Graphs is (Container : in Graph) return Node_Array is - -- function Convert is new Vector_To_Array (Node_Type, Node_Vectors, Node_Array); + function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); begin - return Vector_To_Array (Keys (Container.Connections)); + return V2A (Keys (Container.Connections)); end Nodes; function Nodes @@ -1738,6 +1675,7 @@ package body Directed_Graphs is return Node_Array is Result : Node_Vectors.Vector; + function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); begin if Impl.Checks and then Position.Container = null then raise Constraint_Error with "Graph does not exist"; @@ -1745,7 +1683,7 @@ package body Directed_Graphs is for C in Position.Container.Iterate_Subgraph (Position) loop Result.Append (C.Node); end loop; - return Vector_To_Array (Result); + return V2A (Result); end Nodes; @@ -1824,7 +1762,7 @@ package body Directed_Graphs is is Lock : Impl.With_Lock (Container.Tamper_Info'Unrestricted_Access); Froms : Node_Vectors.Vector; - -- function Convert is new Vector_To_Array (Node_Type, Node_Vectors, Node_Array); + function V2A is new Vector_To_Array (Node_Type, Node_Array, Node_Vectors); begin for C in Container.Connections.Iterate loop for N of Container.Connections.Constant_Reference (C) loop @@ -1834,7 +1772,7 @@ package body Directed_Graphs is end if; end loop; end loop; - return Vector_To_Array (Froms); + return V2A (Froms); end Parents; function Parents @@ -2188,33 +2126,11 @@ package body Directed_Graphs is -- Vector_To_Array -- --------------------- - -- function Vector_To_Array - -- (Input : in Type_Vectors.Vector) - -- return Array_Type is - -- begin - -- return Result : Array_Type (1 .. Input.Last_Index) do - -- for I in Result'Range loop - -- Result (I) := Input (I); - -- end loop; - -- end return; - -- end Vector_To_Array; - - function Vector_To_Array - (Input : in Node_Vectors.Vector) - return Node_Array is - begin - return Result : Node_Array (1 .. Input.Last_Index) do - for I in Result'Range loop - Result (I) := Input (I); - end loop; - end return; - end Vector_To_Array; - function Vector_To_Array - (Input : in Edge_Vectors.Vector) - return Edge_Array is + (Input : in Type_Vectors.Vector) + return Array_Type is begin - return Result : Edge_Array (1 .. Input.Last_Index) do + return Result : Array_Type (1 .. Input.Last_Index) do for I in Result'Range loop Result (I) := Input (I); end loop; -- cgit