Skip to content

R
riscv-gcc-1
Commit 5a428808 by Hristian Kirtchev Committed by Pierre-Marie de Rodat
Options

[Ada] Implement GNAT.Graphs 

This patch introduces new unit GNAT.Graphs which currently provides a
directed graph abstraction.

------------
-- Source --
------------

--  operations.adb

with Ada.Text_IO; use Ada.Text_IO;
with GNAT;        use GNAT;
with GNAT.Graphs; use GNAT.Graphs;
with GNAT.Sets;   use GNAT.Sets;

procedure Operations is
   type Vertex_Id is
     (No_V, VA, VB, VC, VD, VE, VF, VG, VH, VX, VY, VZ);
   No_Vertex_Id : constant Vertex_Id := No_V;

   function Hash_Vertex (V : Vertex_Id) return Bucket_Range_Type;

   type Edge_Id is
    (No_E, E1, E2, E3, E4, E5, E6, E7, E8, E9, E10, E97, E98, E99);
   No_Edge_Id : constant Edge_Id := No_E;

   function Hash_Edge (E : Edge_Id) return Bucket_Range_Type;

   package ES is new Membership_Set
     (Element_Type => Edge_Id,
      "="          => "=",
      Hash         => Hash_Edge);

   package DG is new Directed_Graph
     (Vertex_Id   => Vertex_Id,
      No_Vertex   => No_Vertex_Id,
      Hash_Vertex => Hash_Vertex,
      Same_Vertex => "=",
      Edge_Id     => Edge_Id,
      No_Edge     => No_Edge_Id,
      Hash_Edge   => Hash_Edge,
      Same_Edge   => "=");
   use DG;

   package VS is new Membership_Set
     (Element_Type => Vertex_Id,
      "="          => "=",
      Hash         => Hash_Vertex);

   -----------------------
   -- Local subprograms --
   -----------------------

   procedure Check_Belongs_To_Component
     (R        : String;
      G        : Instance;
      V        : Vertex_Id;
      Exp_Comp : Component_Id);
   --  Verify that vertex V of graph G belongs to component Exp_Comp. R is the
   --  calling routine.

   procedure Check_Belongs_To_Some_Component
     (R : String;
      G : Instance;
      V : Vertex_Id);
   --  Verify that vertex V of graph G belongs to some component. R is the
   --  calling routine.

   procedure Check_Destination_Vertex
     (R     : String;
      G     : Instance;
      E     : Edge_Id;
      Exp_V : Vertex_Id);
   --  Vertify that the destination vertex of edge E of grah G is Exp_V. R is
   --  the calling routine.

   procedure Check_Distinct_Components
     (R      : String;
      Comp_1 : Component_Id;
      Comp_2 : Component_Id);
   --  Verify that components Comp_1 and Comp_2 are distinct (not the same)

   procedure Check_Has_Component
     (R      : String;
      G      : Instance;
      G_Name : String;
      Comp   : Component_Id);
   --  Verify that graph G with name G_Name contains component Comp. R is the
   --  calling routine.

   procedure Check_Has_Edge
     (R : String;
      G : Instance;
      E : Edge_Id);
   --  Verify that graph G contains edge E. R is the calling routine.

   procedure Check_Has_Vertex
     (R : String;
      G : Instance;
      V : Vertex_Id);
   --  Verify that graph G contains vertex V. R is the calling routine.

   procedure Check_No_Component
     (R : String;
      G : Instance;
      V : Vertex_Id);
   --  Verify that vertex V does not belong to some component. R is the calling
   --  routine.

   procedure Check_No_Component
     (R      : String;
      G      : Instance;
      G_Name : String;
      Comp   : Component_Id);
   --  Verify that graph G with name G_Name does not contain component Comp. R
   --  is the calling routine.

   procedure Check_No_Edge
     (R : String;
      G : Instance;
      E : Edge_Id);
   --  Verify that graph G does not contain edge E. R is the calling routine.

   procedure Check_No_Vertex
     (R : String;
      G : Instance;
      V : Vertex_Id);
   --  Verify that graph G does not contain vertex V. R is the calling routine.

   procedure Check_Number_Of_Components
     (R       : String;
      G       : Instance;
      Exp_Num : Natural);
   --  Verify that graph G has exactly Exp_Num components. R is the calling
   --  routine.

   procedure Check_Number_Of_Edges
     (R       : String;
      G       : Instance;
      Exp_Num : Natural);
   --  Verify that graph G has exactly Exp_Num edges. R is the calling routine.

   procedure Check_Number_Of_Vertices
     (R       : String;
      G       : Instance;
      Exp_Num : Natural);
   --  Verify that graph G has exactly Exp_Num vertices. R is the calling
   --  routine.

   procedure Check_Outgoing_Edge_Iterator
     (R   : String;
      G   : Instance;
      V   : Vertex_Id;
      Set : ES.Instance);
   --  Verify that all outgoing edges of vertex V of graph G can be iterated
   --  and appear in set Set. R is the calling routine.

   procedure Check_Source_Vertex
     (R     : String;
      G     : Instance;
      E     : Edge_Id;
      Exp_V : Vertex_Id);
   --  Vertify that the source vertex of edge E of grah G is Exp_V. R is the
   --  calling routine.

   procedure Check_Vertex_Iterator
     (R    : String;
      G    : Instance;
      Comp : Component_Id;
      Set  : VS.Instance);
   --  Verify that all vertices of component Comp of graph G can be iterated
   --  and appear in set Set. R is the calling routine.

   function Create_And_Populate return Instance;
   --  Create a brand new graph (see body for the shape of the graph)

   procedure Error (R : String; Msg : String);
   --  Output an error message with text Msg within the context of routine R

   procedure Test_Add_Edge;
   --  Verify the semantics of routine Add_Edge

   procedure Test_Add_Vertex;
   --  Verify the semantics of routine Add_Vertex

   procedure Test_All_Edge_Iterator;
   --  Verify the semantics of All_Edge_Iterator

   procedure Test_All_Vertex_Iterator;
   --  Verify the semantics of All_Vertex_Iterator

   procedure Test_Component;
   --  Verify the semantics of routine Component

   procedure Test_Component_Iterator;
   --  Verify the semantics of Component_Iterator

   procedure Test_Contains_Component;
   --  Verify the semantics of routine Contains_Component

   procedure Test_Contains_Edge;
   --  Verify the semantics of routine Contains_Edge

   procedure Test_Contains_Vertex;
   --  Verify the semantics of routine Contains_Vertex

   procedure Test_Delete_Edge;
   --  Verify the semantics of routine Delete_Edge

   procedure Test_Destination_Vertex;
   --  Verify the semantics of routine Destination_Vertex

   procedure Test_Find_Components;
   --  Verify the semantics of routine Find_Components

   procedure Test_Is_Empty;
   --  Verify the semantics of routine Is_Empty

   procedure Test_Number_Of_Components;
   --  Verify the semantics of routine Number_Of_Components

   procedure Test_Number_Of_Edges;
   --  Verify the semantics of routine Number_Of_Edges

   procedure Test_Number_Of_Vertices;
   --  Verify the semantics of routine Number_Of_Vertices

   procedure Test_Outgoing_Edge_Iterator;
   --  Verify the semantics of Outgoing_Edge_Iterator

   procedure Test_Present;
   --  Verify the semantics of routine Present

   procedure Test_Source_Vertex;
   --  Verify the semantics of routine Source_Vertex

   procedure Test_Vertex_Iterator;
   --  Verify the semantics of Vertex_Iterator;

   procedure Unexpected_Exception (R : String);
   --  Output an error message concerning an unexpected exception within
   --  routine R.

   --------------------------------
   -- Check_Belongs_To_Component --
   --------------------------------

   procedure Check_Belongs_To_Component
     (R        : String;
      G        : Instance;
      V        : Vertex_Id;
      Exp_Comp : Component_Id)
   is
      Act_Comp : constant Component_Id := Component (G, V);

   begin
      if Act_Comp /= Exp_Comp then
         Error (R, "inconsistent component for vertex " & V'Img);
         Error (R, "  expected: " & Exp_Comp'Img);
         Error (R, "  got     : " & Act_Comp'Img);
      end if;
   end Check_Belongs_To_Component;

   -------------------------------------
   -- Check_Belongs_To_Some_Component --
   -------------------------------------

   procedure Check_Belongs_To_Some_Component
     (R : String;
      G : Instance;
      V : Vertex_Id)
   is
   begin
      if not Present (Component (G, V)) then
         Error (R, "vertex " & V'Img & " does not belong to a component");
      end if;
   end Check_Belongs_To_Some_Component;

   ------------------------------
   -- Check_Destination_Vertex --
   ------------------------------

   procedure Check_Destination_Vertex
     (R     : String;
      G     : Instance;
      E     : Edge_Id;
      Exp_V : Vertex_Id)
   is
      Act_V : constant Vertex_Id := Destination_Vertex (G, E);

   begin
      if Act_V /= Exp_V then
         Error (R, "inconsistent destination vertex for edge " & E'Img);
         Error (R, "  expected: " & Exp_V'Img);
         Error (R, "  got     : " & Act_V'Img);
      end if;
   end Check_Destination_Vertex;

   -------------------------------
   -- Check_Distinct_Components --
   -------------------------------

   procedure Check_Distinct_Components
     (R      : String;
      Comp_1 : Component_Id;
      Comp_2 : Component_Id)
   is
   begin
      if Comp_1 = Comp_2 then
         Error (R, "components are not distinct");
      end if;
   end Check_Distinct_Components;

   -------------------------
   -- Check_Has_Component --
   -------------------------

   procedure Check_Has_Component
     (R      : String;
      G      : Instance;
      G_Name : String;
      Comp   : Component_Id)
   is
   begin
      if not Contains_Component (G, Comp) then
         Error (R, "graph " & G_Name & " lacks component");
      end if;
   end Check_Has_Component;

   --------------------
   -- Check_Has_Edge --
   --------------------

   procedure Check_Has_Edge
     (R : String;
      G : Instance;
      E : Edge_Id)
   is
   begin
      if not Contains_Edge (G, E) then
         Error (R, "graph lacks edge " & E'Img);
      end if;
   end Check_Has_Edge;

   ----------------------
   -- Check_Has_Vertex --
   ----------------------

   procedure Check_Has_Vertex
     (R : String;
      G : Instance;
      V : Vertex_Id)
   is
   begin
      if not Contains_Vertex (G, V) then
         Error (R, "graph lacks vertex " & V'Img);
      end if;
   end Check_Has_Vertex;

   ------------------------
   -- Check_No_Component --
   ------------------------

   procedure Check_No_Component
     (R : String;
      G : Instance;
      V : Vertex_Id)
   is
   begin
      if Present (Component (G, V)) then
         Error (R, "vertex " & V'Img & " belongs to a component");
      end if;
   end Check_No_Component;

   procedure Check_No_Component
     (R      : String;
      G      : Instance;
      G_Name : String;
      Comp   : Component_Id)
   is
   begin
      if Contains_Component (G, Comp) then
         Error (R, "graph " & G_Name & " contains component");
      end if;
   end Check_No_Component;

   -------------------
   -- Check_No_Edge --
   -------------------

   procedure Check_No_Edge
     (R : String;
      G : Instance;
      E : Edge_Id)
   is
   begin
      if Contains_Edge (G, E) then
         Error (R, "graph contains edge " & E'Img);
      end if;
   end Check_No_Edge;

   ---------------------
   -- Check_No_Vertex --
   ---------------------

   procedure Check_No_Vertex
     (R : String;
      G : Instance;
      V : Vertex_Id)
   is
   begin
      if Contains_Vertex (G, V) then
         Error (R, "graph contains vertex " & V'Img);
      end if;
   end Check_No_Vertex;

   --------------------------------
   -- Check_Number_Of_Components --
   --------------------------------

   procedure Check_Number_Of_Components
     (R       : String;
      G       : Instance;
      Exp_Num : Natural)
   is
      Act_Num : constant Natural := Number_Of_Components (G);

   begin
      if Act_Num /= Exp_Num then
         Error (R, "inconsistent number of components");
         Error (R, "  expected: " & Exp_Num'Img);
         Error (R, "  got     : " & Act_Num'Img);
      end if;
   end Check_Number_Of_Components;

   ---------------------------
   -- Check_Number_Of_Edges --
   ---------------------------

   procedure Check_Number_Of_Edges
     (R       : String;
      G       : Instance;
      Exp_Num : Natural)
   is
      Act_Num : constant Natural := Number_Of_Edges (G);

   begin
      if Act_Num /= Exp_Num then
         Error (R, "inconsistent number of edges");
         Error (R, "  expected: " & Exp_Num'Img);
         Error (R, "  got     : " & Act_Num'Img);
      end if;
   end Check_Number_Of_Edges;

   ------------------------------
   -- Check_Number_Of_Vertices --
   ------------------------------

   procedure Check_Number_Of_Vertices
     (R       : String;
      G       : Instance;
      Exp_Num : Natural)
   is
      Act_Num : constant Natural := Number_Of_Vertices (G);

   begin
      if Act_Num /= Exp_Num then
         Error (R, "inconsistent number of vertices");
         Error (R, "  expected: " & Exp_Num'Img);
         Error (R, "  got     : " & Act_Num'Img);
      end if;
   end Check_Number_Of_Vertices;

   ----------------------------------
   -- Check_Outgoing_Edge_Iterator --
   ----------------------------------

   procedure Check_Outgoing_Edge_Iterator
     (R   : String;
      G   : Instance;
      V   : Vertex_Id;
      Set : ES.Instance)
   is
      E : Edge_Id;

      Out_E_Iter : Outgoing_Edge_Iterator;

   begin
      --  Iterate over all outgoing edges of vertex V while removing edges seen
      --  from the set.

      Out_E_Iter := Iterate_Outgoing_Edges (G, V);
      while Has_Next (Out_E_Iter) loop
         Next (Out_E_Iter, E);

         if ES.Contains (Set, E) then
            ES.Delete (Set, E);
         else
            Error (R, "outgoing edge " & E'Img & " is not iterated");
         end if;
      end loop;

      --  At this point the set of edges should be empty

      if not ES.Is_Empty (Set) then
         Error (R, "not all outgoing edges were iterated");
      end if;
   end Check_Outgoing_Edge_Iterator;

   -------------------------
   -- Check_Source_Vertex --
   -------------------------

   procedure Check_Source_Vertex
     (R     : String;
      G     : Instance;
      E     : Edge_Id;
      Exp_V : Vertex_Id)
   is
      Act_V : constant Vertex_Id := Source_Vertex (G, E);

   begin
      if Act_V /= Exp_V then
         Error (R, "inconsistent source vertex");
         Error (R, "  expected: " & Exp_V'Img);
         Error (R, "  got     : " & Act_V'Img);
      end if;
   end Check_Source_Vertex;

   ---------------------------
   -- Check_Vertex_Iterator --
   ---------------------------

   procedure Check_Vertex_Iterator
     (R    : String;
      G    : Instance;
      Comp : Component_Id;
      Set  : VS.Instance)
   is
      V : Vertex_Id;

      V_Iter : Vertex_Iterator;

   begin
      --  Iterate over all vertices of component Comp while removing vertices
      --  seen from the set.

      V_Iter := Iterate_Vertices (G, Comp);
      while Has_Next (V_Iter) loop
         Next (V_Iter, V);

         if VS.Contains (Set, V) then
            VS.Delete (Set, V);
         else
            Error (R, "vertex " & V'Img & " is not iterated");
         end if;
      end loop;

      --  At this point the set of vertices should be empty

      if not VS.Is_Empty (Set) then
         Error (R, "not all vertices were iterated");
      end if;
   end Check_Vertex_Iterator;

   -------------------------
   -- Create_And_Populate --
   -------------------------

   function Create_And_Populate return Instance is
      G : constant Instance :=
            Create (Initial_Vertices => Vertex_Id'Size,
                    Initial_Edges    => Edge_Id'Size);

   begin
      --       9         8           1        2
      --  G <------ F <------  A  ------> B -------> C
      --  |                  ^ | |        ^          ^
      --  +------------------+ | +-------------------+
      --       10              |          |   3
      --                    4  |        5 |
      --                       v          |
      --            H          D ---------+
      --                      | ^
      --                      | |
      --                    6 | | 7
      --                      | |
      --                      v |
      --                       E
      --
      --  Components:
      --
      --    [A, F, G]
      --    [B]
      --    [C]
      --    [D, E]
      --    [H]

      Add_Vertex (G, VA);
      Add_Vertex (G, VB);
      Add_Vertex (G, VC);
      Add_Vertex (G, VD);
      Add_Vertex (G, VE);
      Add_Vertex (G, VF);
      Add_Vertex (G, VG);
      Add_Vertex (G, VH);

      Add_Edge (G, E1,  Source => VA, Destination => VB);
      Add_Edge (G, E2,  Source => VB, Destination => VC);
      Add_Edge (G, E3,  Source => VA, Destination => VC);
      Add_Edge (G, E4,  Source => VA, Destination => VD);
      Add_Edge (G, E5,  Source => VD, Destination => VB);
      Add_Edge (G, E6,  Source => VD, Destination => VE);
      Add_Edge (G, E7,  Source => VE, Destination => VD);
      Add_Edge (G, E8,  Source => VA, Destination => VF);
      Add_Edge (G, E9,  Source => VF, Destination => VG);
      Add_Edge (G, E10, Source => VG, Destination => VA);

      return G;
   end Create_And_Populate;

   -----------
   -- Error --
   -----------

   procedure Error (R : String; Msg : String) is
   begin
      Put_Line ("ERROR: " & R & ": " & Msg);
   end Error;

   ---------------
   -- Hash_Edge --
   ---------------

   function Hash_Edge (E : Edge_Id) return Bucket_Range_Type is
   begin
      return Bucket_Range_Type (Edge_Id'Pos (E));
   end Hash_Edge;

   -----------------
   -- Hash_Vertex --
   -----------------

   function Hash_Vertex (V : Vertex_Id) return Bucket_Range_Type is
   begin
      return Bucket_Range_Type (Vertex_Id'Pos (V));
   end Hash_Vertex;

   -------------------
   -- Test_Add_Edge --
   -------------------

   procedure Test_Add_Edge is
      R : constant String := "Test_Add_Edge";

      E : Edge_Id;
      G : Instance := Create_And_Populate;

      All_E_Iter : All_Edge_Iterator;
      Out_E_Iter : Outgoing_Edge_Iterator;

   begin
      --  Try to add the same edge twice

      begin
         Add_Edge (G, E1, VB, VH);
         Error (R, "duplicate edge not detected");
      exception
         when Duplicate_Edge => null;
         when others         => Unexpected_Exception (R);
      end;

      --  Try to add an edge with a bogus source

      begin
         Add_Edge (G, E97, Source => VX, Destination => VC);
         Error (R, "missing vertex not detected");
      exception
         when Missing_Vertex => null;
         when others         => Unexpected_Exception (R);
      end;

      --  Try to add an edge with a bogus destination

      begin
         Add_Edge (G, E97, Source => VF, Destination => VY);
         Error (R, "missing vertex not detected");
      exception
         when Missing_Vertex => null;
         when others         => Unexpected_Exception (R);
      end;

      --  Delete edge E1 between vertices VA and VB

      begin
         Delete_Edge (G, E1);
      exception
         when others => Unexpected_Exception (R);
      end;

      --  Try to re-add edge E1

      begin
         Add_Edge (G, E1, Source => VA, Destination => VB);
      exception
         when others => Unexpected_Exception (R);
      end;

      --  Lock all edges in the graph

      All_E_Iter := Iterate_All_Edges (G);

      --  Try to add an edge given that all edges are locked

      begin
         Add_Edge (G, E97, Source => VG, Destination => VH);
         Error (R, "all edges not locked");
      exception
         when Iterated => null;
         when others   => Unexpected_Exception (R);
      end;

      --  Unlock all edges by iterating over them

      while Has_Next (All_E_Iter) loop Next (All_E_Iter, E); end loop;

      --  Lock all outgoing edges of vertex VD

      Out_E_Iter := Iterate_Outgoing_Edges (G, VD);

      --  Try to add an edge with source VD given that all edges of VD are
      --  locked.

      begin
         Add_Edge (G, E97, Source => VD, Destination => VG);
         Error (R, "outgoing edges of VD not locked");
      exception
         when Iterated => null;
         when others   => Unexpected_Exception (R);
      end;

      --  Unlock the edges of vertex VD by iterating over them

      while Has_Next (Out_E_Iter) loop Next (Out_E_Iter, E); end loop;

      Destroy (G);
   end Test_Add_Edge;

   ---------------------
   -- Test_Add_Vertex --
   ---------------------

   procedure Test_Add_Vertex is
      R : constant String := "Test_Add_Vertex";

      G : Instance := Create_And_Populate;
      V : Vertex_Id;

      All_V_Iter : All_Vertex_Iterator;

   begin
      --  Try to add the same vertex twice

      begin
         Add_Vertex (G, VD);
         Error (R, "duplicate vertex not detected");
      exception
         when Duplicate_Vertex => null;
         when others           => Unexpected_Exception (R);
      end;

      --  Lock all vertices in the graph

      All_V_Iter := Iterate_All_Vertices (G);

      --  Try to add a vertex given that all vertices are locked

      begin
         Add_Vertex (G, VZ);
         Error (R, "all vertices not locked");
      exception
         when Iterated => null;
         when others   => Unexpected_Exception (R);
      end;

      --  Unlock all vertices by iterating over them

      while Has_Next (All_V_Iter) loop Next (All_V_Iter, V); end loop;

      Destroy (G);
   end Test_Add_Vertex;

   ----------------------------
   -- Test_All_Edge_Iterator --
   ----------------------------

   procedure Test_All_Edge_Iterator is
      R : constant String := "Test_All_Edge_Iterator";

      E : Edge_Id;
      G : Instance := Create_And_Populate;

      All_E_Iter : All_Edge_Iterator;
      All_Edges  : ES.Instance;

   begin
      --  Collect all expected edges in a set

      All_Edges := ES.Create (Number_Of_Edges (G));

      for Curr_E in E1 .. E10 loop
         ES.Insert (All_Edges, Curr_E);
      end loop;

      --  Iterate over all edges while removing encountered edges from the set

      All_E_Iter := Iterate_All_Edges (G);
      while Has_Next (All_E_Iter) loop
         Next (All_E_Iter, E);

         if ES.Contains (All_Edges, E) then
            ES.Delete (All_Edges, E);
         else
            Error (R, "edge " & E'Img & " is not iterated");
         end if;
      end loop;

      --  At this point the set of edges should be empty

      if not ES.Is_Empty (All_Edges) then
         Error (R, "not all edges were iterated");
      end if;

      ES.Destroy (All_Edges);
      Destroy (G);
   end Test_All_Edge_Iterator;

   ------------------------------
   -- Test_All_Vertex_Iterator --
   ------------------------------

   procedure Test_All_Vertex_Iterator is
      R : constant String := "Test_All_Vertex_Iterator";

      G : Instance := Create_And_Populate;
      V : Vertex_Id;

      All_V_Iter   : All_Vertex_Iterator;
      All_Vertices : VS.Instance;

   begin
      --  Collect all expected vertices in a set

      All_Vertices := VS.Create (Number_Of_Vertices (G));

      for Curr_V in VA .. VH loop
         VS.Insert (All_Vertices, Curr_V);
      end loop;

      --  Iterate over all vertices while removing encountered vertices from
      --  the set.

      All_V_Iter := Iterate_All_Vertices (G);
      while Has_Next (All_V_Iter) loop
         Next (All_V_Iter, V);

         if VS.Contains (All_Vertices, V) then
            VS.Delete (All_Vertices, V);
         else
            Error (R, "vertex " & V'Img & " is not iterated");
         end if;
      end loop;

      --  At this point the set of vertices should be empty

      if not VS.Is_Empty (All_Vertices) then
         Error (R, "not all vertices were iterated");
      end if;

      VS.Destroy (All_Vertices);
      Destroy (G);
   end Test_All_Vertex_Iterator;

   --------------------
   -- Test_Component --
   --------------------

   procedure Test_Component is
      R : constant String := "Test_Component";

      G : Instance := Create (Initial_Vertices => 3, Initial_Edges => 2);

   begin
      --      E1
      --    ----->
      --  VA       VB     VC
      --    <-----
      --      E2
      --
      --  Components:
      --
      --    [VA, VB]
      --    [VC]

      Add_Vertex (G, VA);
      Add_Vertex (G, VB);
      Add_Vertex (G, VC);

      Add_Edge (G, E1, Source => VA, Destination => VB);
      Add_Edge (G, E2, Source => VB, Destination => VA);

      --  None of the vertices should belong to a component

      Check_No_Component (R, G, VA);
      Check_No_Component (R, G, VB);
      Check_No_Component (R, G, VC);

      --  Find the strongly connected components in the graph

      Find_Components (G);

      --  Vertices should belong to a component

      Check_Belongs_To_Some_Component (R, G, VA);
      Check_Belongs_To_Some_Component (R, G, VB);
      Check_Belongs_To_Some_Component (R, G, VC);

      Destroy (G);
   end Test_Component;

   -----------------------------
   -- Test_Component_Iterator --
   -----------------------------

   procedure Test_Component_Iterator is
      R : constant String := "Test_Component_Iterator";

      G : Instance := Create_And_Populate;

      Comp       : Component_Id;
      Comp_Count : Natural;
      Comp_Iter  : Component_Iterator;

   begin
      Find_Components (G);
      Check_Number_Of_Components (R, G, 5);

      Comp_Count := Number_Of_Components (G);

      --  Iterate over all components while decrementing their number

      Comp_Iter := Iterate_Components (G);
      while Has_Next (Comp_Iter) loop
         Next (Comp_Iter, Comp);

         Comp_Count := Comp_Count - 1;
      end loop;

      --  At this point all components should have been accounted for

      if Comp_Count /= 0 then
         Error (R, "not all components were iterated");
      end if;

      Destroy (G);
   end Test_Component_Iterator;

   -----------------------------
   -- Test_Contains_Component --
   -----------------------------

   procedure Test_Contains_Component is
      R : constant String := "Test_Contains_Component";

      G1 : Instance := Create (Initial_Vertices => 2, Initial_Edges => 2);
      G2 : Instance := Create (Initial_Vertices => 2, Initial_Edges => 2);

   begin
      --      E1
      --    ----->
      --  VA       VB
      --    <-----
      --      E2
      --
      --  Components:
      --
      --    [VA, VB]

      Add_Vertex (G1, VA);
      Add_Vertex (G1, VB);

      Add_Edge (G1, E1, Source => VA, Destination => VB);
      Add_Edge (G1, E2, Source => VB, Destination => VA);

      --      E97
      --    ----->
      --  VX       VY
      --    <-----
      --      E98
      --
      --  Components:
      --
      --    [VX, VY]

      Add_Vertex (G2, VX);
      Add_Vertex (G2, VY);

      Add_Edge (G2, E97, Source => VX, Destination => VY);
      Add_Edge (G2, E98, Source => VY, Destination => VX);

      --  Find the strongly connected components in both graphs

      Find_Components (G1);
      Find_Components (G2);

      --  Vertices should belong to a component

      Check_Belongs_To_Some_Component (R, G1, VA);
      Check_Belongs_To_Some_Component (R, G1, VB);
      Check_Belongs_To_Some_Component (R, G2, VX);
      Check_Belongs_To_Some_Component (R, G2, VY);

      --  Verify that each graph contains the correct component

      Check_Has_Component (R, G1, "G1", Component (G1, VA));
      Check_Has_Component (R, G1, "G1", Component (G1, VB));
      Check_Has_Component (R, G2, "G2", Component (G2, VX));
      Check_Has_Component (R, G2, "G2", Component (G2, VY));

      --  Verify that each graph does not contain components from the other
      --  graph.

      Check_No_Component (R, G1, "G1", Component (G2, VX));
      Check_No_Component (R, G1, "G1", Component (G2, VY));
      Check_No_Component (R, G2, "G2", Component (G1, VA));
      Check_No_Component (R, G2, "G2", Component (G1, VB));

      Destroy (G1);
      Destroy (G2);
   end Test_Contains_Component;

   ------------------------
   -- Test_Contains_Edge --
   ------------------------

   procedure Test_Contains_Edge is
      R : constant String := "Test_Contains_Edge";

      G : Instance := Create_And_Populate;

   begin
      --  Verify that all edges in the range E1 .. E10 exist

      for Curr_E in E1 .. E10 loop
         Check_Has_Edge (R, G, Curr_E);
      end loop;

      --  Verify that no extra edges are present

      for Curr_E in E97 .. E99 loop
         Check_No_Edge (R, G, Curr_E);
      end loop;

      --  Add new edges E97, E98, and E99

      Add_Edge (G, E97, Source => VG, Destination => VF);
      Add_Edge (G, E98, Source => VH, Destination => VE);
      Add_Edge (G, E99, Source => VD, Destination => VC);

      --  Verify that all edges in the range E1 .. E99 exist

      for Curr_E in E1 .. E99 loop
         Check_Has_Edge (R, G, Curr_E);
      end loop;

      --  Delete each edge that corresponds to an even position in Edge_Id

      for Curr_E in E1 .. E99 loop
         if Edge_Id'Pos (Curr_E) mod 2 = 0 then
            Delete_Edge (G, Curr_E);
         end if;
      end loop;

      --  Verify that all "even" edges are missing, and all "odd" edges are
      --  present.

      for Curr_E in E1 .. E99 loop
         if Edge_Id'Pos (Curr_E) mod 2 = 0 then
            Check_No_Edge (R, G, Curr_E);
         else
            Check_Has_Edge (R, G, Curr_E);
         end if;
      end loop;

      Destroy (G);
   end Test_Contains_Edge;

   --------------------------
   -- Test_Contains_Vertex --
   --------------------------

   procedure Test_Contains_Vertex is
      R : constant String := "Test_Contains_Vertex";

      G : Instance := Create_And_Populate;

   begin
      --  Verify that all vertices in the range VA .. VH exist

      for Curr_V in VA .. VH loop
         Check_Has_Vertex (R, G, Curr_V);
      end loop;

      --  Verify that no extra vertices are present

      for Curr_V in VX .. VZ loop
         Check_No_Vertex (R, G, Curr_V);
      end loop;

      --  Add new vertices VX, VY, and VZ

      Add_Vertex (G, VX);
      Add_Vertex (G, VY);
      Add_Vertex (G, VZ);

      --  Verify that all vertices in the range VA .. VZ exist

      for Curr_V in VA .. VZ loop
         Check_Has_Vertex (R, G, Curr_V);
      end loop;

      Destroy (G);
   end Test_Contains_Vertex;

   ----------------------
   -- Test_Delete_Edge --
   ----------------------

   procedure Test_Delete_Edge is
      R : constant String := "Test_Delete_Edge";

      E : Edge_Id;
      G : Instance := Create_And_Populate;
      V : Vertex_Id;

      All_E_Iter : All_Edge_Iterator;
      All_V_Iter : All_Vertex_Iterator;
      Out_E_Iter : Outgoing_Edge_Iterator;

   begin
      --  Try to delete a bogus edge

      begin
         Delete_Edge (G, E97);
         Error (R, "missing vertex deleted");
      exception
         when Missing_Edge => null;
         when others       => Unexpected_Exception (R);
      end;

      --  Delete edge E1 between vertices VA and VB

      begin
         Delete_Edge (G, E1);
      exception
         when others => Unexpected_Exception (R);
      end;

      --  Verify that edge E1 is gone from all edges in the graph

      All_E_Iter := Iterate_All_Edges (G);
      while Has_Next (All_E_Iter) loop
         Next (All_E_Iter, E);

         if E = E1 then
            Error (R, "edge " & E'Img & " not removed from all edges");
         end if;
      end loop;

      --  Verify that edge E1 is gone from the outgoing edges of vertex VA

      Out_E_Iter := Iterate_Outgoing_Edges (G, VA);
      while Has_Next (Out_E_Iter) loop
         Next (Out_E_Iter, E);

         if E = E1 then
            Error
              (R, "edge " & E'Img & "not removed from outgoing edges of VA");
         end if;
      end loop;

      --  Delete all edges in the range E2 .. E10

      for Curr_E in E2 .. E10 loop
         Delete_Edge (G, Curr_E);
      end loop;

      --  Verify that all edges are gone from the graph

      All_E_Iter := Iterate_All_Edges (G);
      while Has_Next (All_E_Iter) loop
         Next (All_E_Iter, E);

         Error (R, "edge " & E'Img & " not removed from all edges");
      end loop;

      --  Verify that all edges are gone from the respective source vertices

      All_V_Iter := Iterate_All_Vertices (G);
      while Has_Next (All_V_Iter) loop
         Next (All_V_Iter, V);

         Out_E_Iter := Iterate_Outgoing_Edges (G, V);
         while Has_Next (Out_E_Iter) loop
            Next (Out_E_Iter, E);

            Error (R, "edge " & E'Img & " not removed from vertex " & V'Img);
         end loop;
      end loop;

      Destroy (G);
   end Test_Delete_Edge;

   -----------------------------
   -- Test_Destination_Vertex --
   -----------------------------

   procedure Test_Destination_Vertex is
      R : constant String := "Test_Destination_Vertex";

      G : Instance := Create_And_Populate;

   begin
      --  Verify the destination vertices of all edges in the graph

      Check_Destination_Vertex (R, G, E1,  VB);
      Check_Destination_Vertex (R, G, E2,  VC);
      Check_Destination_Vertex (R, G, E3,  VC);
      Check_Destination_Vertex (R, G, E4,  VD);
      Check_Destination_Vertex (R, G, E5,  VB);
      Check_Destination_Vertex (R, G, E6,  VE);
      Check_Destination_Vertex (R, G, E7,  VD);
      Check_Destination_Vertex (R, G, E8,  VF);
      Check_Destination_Vertex (R, G, E9,  VG);
      Check_Destination_Vertex (R, G, E10, VA);

      Destroy (G);
   end Test_Destination_Vertex;

   --------------------------
   -- Test_Find_Components --
   --------------------------

   procedure Test_Find_Components is
      R : constant String := "Test_Find_Components";

      G : Instance := Create_And_Populate;

      Comp_1 : Component_Id;  --  [A, F, G]
      Comp_2 : Component_Id;  --  [B]
      Comp_3 : Component_Id;  --  [C]
      Comp_4 : Component_Id;  --  [D, E]
      Comp_5 : Component_Id;  --  [H]

   begin
      Find_Components (G);

      --  Vertices should belong to a component

      Check_Belongs_To_Some_Component (R, G, VA);
      Check_Belongs_To_Some_Component (R, G, VB);
      Check_Belongs_To_Some_Component (R, G, VC);
      Check_Belongs_To_Some_Component (R, G, VD);
      Check_Belongs_To_Some_Component (R, G, VH);

      --  Extract the ids of the components from the first vertices in each
      --  component.

      Comp_1 := Component (G, VA);
      Comp_2 := Component (G, VB);
      Comp_3 := Component (G, VC);
      Comp_4 := Component (G, VD);
      Comp_5 := Component (G, VH);

      --  Verify that the components are distinct

      Check_Distinct_Components (R, Comp_1, Comp_2);
      Check_Distinct_Components (R, Comp_1, Comp_3);
      Check_Distinct_Components (R, Comp_1, Comp_4);
      Check_Distinct_Components (R, Comp_1, Comp_5);

      Check_Distinct_Components (R, Comp_2, Comp_3);
      Check_Distinct_Components (R, Comp_2, Comp_4);
      Check_Distinct_Components (R, Comp_2, Comp_5);

      Check_Distinct_Components (R, Comp_3, Comp_4);
      Check_Distinct_Components (R, Comp_3, Comp_5);

      Check_Distinct_Components (R, Comp_4, Comp_5);

      --  Verify that the remaining nodes belong to the proper component

      Check_Belongs_To_Component (R, G, VF, Comp_1);
      Check_Belongs_To_Component (R, G, VG, Comp_1);
      Check_Belongs_To_Component (R, G, VE, Comp_4);

      Destroy (G);
   end Test_Find_Components;

   -------------------
   -- Test_Is_Empty --
   -------------------

   procedure Test_Is_Empty is
      R : constant String := "Test_Is_Empty";

      G : Instance := Create (Initial_Vertices => 3, Initial_Edges => 2);

   begin
      --  Verify that a graph without vertices and edges is empty

      if not Is_Empty (G) then
         Error (R, "graph is empty");
      end if;

      --  Add vertices

      Add_Vertex (G, VA);
      Add_Vertex (G, VB);

      --  Verify that a graph with vertices and no edges is not empty

      if Is_Empty (G) then
         Error (R, "graph is not empty");
      end if;

      --  Add edges

      Add_Edge (G, E1, Source => VA, Destination => VB);

      --  Verify that a graph with vertices and edges is not empty

      if Is_Empty (G) then
         Error (R, "graph is not empty");
      end if;

      Destroy (G);
   end Test_Is_Empty;

   -------------------------------
   -- Test_Number_Of_Components --
   -------------------------------

   procedure Test_Number_Of_Components is
      R : constant String := "Test_Number_Of_Components";

      G : Instance := Create (Initial_Vertices => 3, Initial_Edges => 2);

   begin
      --  Verify that an empty graph has exactly 0 components

      Check_Number_Of_Components (R, G, 0);

      --      E1
      --    ----->
      --  VA       VB     VC
      --    <-----
      --      E2
      --
      --  Components:
      --
      --    [VA, VB]
      --    [VC]

      Add_Vertex (G, VA);
      Add_Vertex (G, VB);
      Add_Vertex (G, VC);

      Add_Edge (G, E1, Source => VA, Destination => VB);
      Add_Edge (G, E2, Source => VB, Destination => VA);

      --  Verify that the graph has exact 0 components even though it contains
      --  vertices and edges.

      Check_Number_Of_Components (R, G, 0);

      Find_Components (G);

      --  Verify that the graph has exactly 2 components

      Check_Number_Of_Components (R, G, 2);

      Destroy (G);
   end Test_Number_Of_Components;

   --------------------------
   -- Test_Number_Of_Edges --
   --------------------------

   procedure Test_Number_Of_Edges is
      R : constant String := "Test_Number_Of_Edges";

      G : Instance := Create_And_Populate;

   begin
      --  Verify that the graph has exactly 10 edges

      Check_Number_Of_Edges (R, G, 10);

      --  Delete two edges

      Delete_Edge (G, E1);
      Delete_Edge (G, E2);

      --  Verify that the graph has exactly 8 edges

      Check_Number_Of_Edges (R, G, 8);

      --  Delete the remaining edge

      for Curr_E in E3 .. E10 loop
         Delete_Edge (G, Curr_E);
      end loop;

      --  Verify that the graph has exactly 0 edges

      Check_Number_Of_Edges (R, G, 0);

      --  Add two edges

      Add_Edge (G, E1, Source => VF, Destination => VA);
      Add_Edge (G, E2, Source => VC, Destination => VH);

      --  Verify that the graph has exactly 2 edges

      Check_Number_Of_Edges (R, G, 2);

      Destroy (G);
   end Test_Number_Of_Edges;

   -----------------------------
   -- Test_Number_Of_Vertices --
   -----------------------------

   procedure Test_Number_Of_Vertices is
      R : constant String := "Test_Number_Of_Vertices";

      G : Instance := Create (Initial_Vertices => 4, Initial_Edges => 12);

   begin
      --  Verify that an empty graph has exactly 0 vertices

      Check_Number_Of_Vertices (R, G, 0);

      --  Add three vertices

      Add_Vertex (G, VC);
      Add_Vertex (G, VG);
      Add_Vertex (G, VX);

      --  Verify that the graph has exactly 3 vertices

      Check_Number_Of_Vertices (R, G, 3);

      --  Add one edge

      Add_Edge (G, E8, Source => VX, Destination => VG);

      --  Verify that the graph has exactly 3 vertices

      Check_Number_Of_Vertices (R, G, 3);

      Destroy (G);
   end Test_Number_Of_Vertices;

   ---------------------------------
   -- Test_Outgoing_Edge_Iterator --
   ---------------------------------

   procedure Test_Outgoing_Edge_Iterator is
      R : constant String := "Test_Outgoing_Edge_Iterator";

      G   : Instance := Create_And_Populate;
      Set : ES.Instance;

   begin
      Set := ES.Create (4);

      ES.Insert (Set, E1);
      ES.Insert (Set, E3);
      ES.Insert (Set, E4);
      ES.Insert (Set, E8);
      Check_Outgoing_Edge_Iterator (R, G, VA, Set);

      ES.Insert (Set, E2);
      Check_Outgoing_Edge_Iterator (R, G, VB, Set);

      Check_Outgoing_Edge_Iterator (R, G, VC, Set);

      ES.Insert (Set, E5);
      ES.Insert (Set, E6);
      Check_Outgoing_Edge_Iterator (R, G, VD, Set);

      ES.Insert (Set, E7);
      Check_Outgoing_Edge_Iterator (R, G, VE, Set);

      ES.Insert (Set, E9);
      Check_Outgoing_Edge_Iterator (R, G, VF, Set);

      ES.Insert (Set, E10);
      Check_Outgoing_Edge_Iterator (R, G, VG, Set);

      Check_Outgoing_Edge_Iterator (R, G, VH, Set);

      ES.Destroy (Set);
      Destroy (G);
   end Test_Outgoing_Edge_Iterator;

   ------------------
   -- Test_Present --
   ------------------

   procedure Test_Present is
      R : constant String := "Test_Present";

      G : Instance := Nil;

   begin
      --  Verify that a non-existent graph is not present

      if Present (G) then
         Error (R, "graph is not present");
      end if;

      G := Create_And_Populate;

      --  Verify that an existing graph is present

      if not Present (G) then
         Error (R, "graph is present");
      end if;

      Destroy (G);

      --  Verify that a destroyed graph is not present

      if Present (G) then
         Error (R, "graph is not present");
      end if;
   end Test_Present;

   ------------------------
   -- Test_Source_Vertex --
   ------------------------

   procedure Test_Source_Vertex is
      R : constant String := "Test_Source_Vertex";

      G : Instance := Create_And_Populate;

   begin
      --  Verify the source vertices of all edges in the graph

      Check_Source_Vertex (R, G, E1,  VA);
      Check_Source_Vertex (R, G, E2,  VB);
      Check_Source_Vertex (R, G, E3,  VA);
      Check_Source_Vertex (R, G, E4,  VA);
      Check_Source_Vertex (R, G, E5,  VD);
      Check_Source_Vertex (R, G, E6,  VD);
      Check_Source_Vertex (R, G, E7,  VE);
      Check_Source_Vertex (R, G, E8,  VA);
      Check_Source_Vertex (R, G, E9,  VF);
      Check_Source_Vertex (R, G, E10, VG);

      Destroy (G);
   end Test_Source_Vertex;

   --------------------------
   -- Test_Vertex_Iterator --
   --------------------------

   procedure Test_Vertex_Iterator is
      R : constant String := "Test_Vertex_Iterator";

      G   : Instance := Create_And_Populate;
      Set : VS.Instance;

   begin
      Find_Components (G);

      Set := VS.Create (3);

      VS.Insert (Set, VA);
      VS.Insert (Set, VF);
      VS.Insert (Set, VG);
      Check_Vertex_Iterator (R, G, Component (G, VA), Set);

      VS.Insert (Set, VB);
      Check_Vertex_Iterator (R, G, Component (G, VB), Set);

      VS.Insert (Set, VC);
      Check_Vertex_Iterator (R, G, Component (G, VC), Set);

      VS.Insert (Set, VD);
      VS.Insert (Set, VE);
      Check_Vertex_Iterator (R, G, Component (G, VD), Set);

      VS.Insert (Set, VH);
      Check_Vertex_Iterator (R, G, Component (G, VH), Set);

      VS.Destroy (Set);
      Destroy (G);
   end Test_Vertex_Iterator;

   --------------------------
   -- Unexpected_Exception --
   --------------------------

   procedure Unexpected_Exception (R : String) is
   begin
      Error (R, "unexpected exception");
   end Unexpected_Exception;

--  Start of processing for Operations

begin
   Test_Add_Edge;
   Test_Add_Vertex;
   Test_All_Edge_Iterator;
   Test_All_Vertex_Iterator;
   Test_Component;
   Test_Component_Iterator;
   Test_Contains_Component;
   Test_Contains_Edge;
   Test_Contains_Vertex;
   Test_Delete_Edge;
   Test_Destination_Vertex;
   Test_Find_Components;
   Test_Is_Empty;
   Test_Number_Of_Components;
   Test_Number_Of_Edges;
   Test_Number_Of_Vertices;
   Test_Outgoing_Edge_Iterator;
   Test_Present;
   Test_Source_Vertex;
   Test_Vertex_Iterator;

end Operations;

----------------------------
-- Compilation and output --
----------------------------

$ gnatmake -q operations.adb -largs -lgmem
$ ./operations
$ gnatmem operations > leaks.txt
$ grep -c "non freed allocations" leaks.txt
0

2019-07-01  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* impunit.adb: Add GNAT.Graphs to list Non_Imp_File_Names_95.
	* Makefile.rtl, gcc-interface/Make-lang.in: Register unit
	GNAT.Graphs.
	* libgnat/g-dynhta.adb: Various minor cleanups (use Present
	rather than direct comparisons).
	(Delete): Reimplement to use Delete_Node.
	(Delete_Node): New routine.
	(Destroy_Bucket): Invoke the provided destructor.
	(Present): New routines.
	* libgnat/g-dynhta.ads: Add new generic formal Destroy_Value.
	Use better names for the components of iterators.
	* libgnat/g-graphs.adb, libgnat/g-graphs.ads: New unit.
	* libgnat/g-lists.adb: Various minor cleanups (use Present
	rather than direct comparisons).
	(Delete_Node): Invoke the provided destructor.
	(Present): New routine.
	* libgnat/g-lists.ads: Add new generic formal Destroy_Element.
	Use better names for the components of iterators.
	(Present): New routine.
	* libgnat/g-sets.adb, libgnat/g-sets.ads (Destroy, Preset,
	Reset): New routines.

From-SVN: r272857
parent 7c46e926
Showing with 2258 additions and 113 deletions
gcc/ada/ChangeLog
2019-07-01 Hristian Kirtchev <kirtchev@adacore.com>
* impunit.adb: Add GNAT.Graphs to list Non_Imp_File_Names_95.
* Makefile.rtl, gcc-interface/Make-lang.in: Register unit
GNAT.Graphs.
* libgnat/g-dynhta.adb: Various minor cleanups (use Present
rather than direct comparisons).
(Delete): Reimplement to use Delete_Node.
(Delete_Node): New routine.
(Destroy_Bucket): Invoke the provided destructor.
(Present): New routines.
* libgnat/g-dynhta.ads: Add new generic formal Destroy_Value.
Use better names for the components of iterators.
* libgnat/g-graphs.adb, libgnat/g-graphs.ads: New unit.
* libgnat/g-lists.adb: Various minor cleanups (use Present
rather than direct comparisons).
(Delete_Node): Invoke the provided destructor.
(Present): New routine.
* libgnat/g-lists.ads: Add new generic formal Destroy_Element.
Use better names for the components of iterators.
(Present): New routine.
* libgnat/g-sets.adb, libgnat/g-sets.ads (Destroy, Preset,
Reset): New routines.
2019-07-01 Dmitriy Anisimkov <anisimko@adacore.com>
* libgnat/g-sothco.adb (Get_Address): Fix the case when AF_INET6
......
gcc/ada/Makefile.rtl
......@@ -421,6 +421,7 @@ GNATRTL_NONTASKING_OBJS= \
g-exptty$(objext) \
g-flocon$(objext) \
g-forstr$(objext) \
g-graphs$(objext) \
g-heasor$(objext) \
g-hesora$(objext) \
g-hesorg$(objext) \
......
gcc/ada/gcc-interface/Make-lang.in
......@@ -317,6 +317,7 @@ GNAT_ADA_OBJS = \
ada/frontend.o \
ada/libgnat/g-byorma.o \
ada/libgnat/g-dynhta.o \
ada/libgnat/g-graphs.o \
ada/libgnat/g-hesora.o \
ada/libgnat/g-htable.o \
ada/libgnat/g-lists.o \
......
gcc/ada/impunit.adb
......@@ -275,6 +275,7 @@ package body Impunit is
("g-exptty", F), -- GNAT.Expect.TTY
("g-flocon", F), -- GNAT.Float_Control
("g-forstr", F), -- GNAT.Formatted_String
("g-graphs", F), -- GNAT.Graphs
("g-heasor", F), -- GNAT.Heap_Sort
("g-hesora", F), -- GNAT.Heap_Sort_A
("g-hesorg", F), -- GNAT.Heap_Sort_G
......
gcc/ada/libgnat/g-dynhta.adb
......@@ -382,6 +382,10 @@ package body GNAT.Dynamic_HTables is
-- Maximum safe size for hash table expansion. Beyond this size, an
-- expansion will overflow the buckets.
procedure Delete_Node (T : Instance; Nod : Node_Ptr);
pragma Inline (Delete_Node);
-- Detach and delete node Nod from table T
procedure Destroy_Buckets (Bkts : Bucket_Table_Ptr);
pragma Inline (Destroy_Buckets);
-- Destroy all nodes within buckets Bkts
......@@ -464,6 +468,14 @@ package body GNAT.Dynamic_HTables is
pragma Inline (Prepend);
-- Insert node Nod immediately after dummy head Head
function Present (Bkts : Bucket_Table_Ptr) return Boolean;
pragma Inline (Present);
-- Determine whether buckets Bkts exist
function Present (Nod : Node_Ptr) return Boolean;
pragma Inline (Present);
-- Determine whether node Nod exists
procedure Unlock (T : Instance);
pragma Inline (Unlock);
-- Unlock all mutation functionality of hash table T
......@@ -492,6 +504,34 @@ package body GNAT.Dynamic_HTables is
------------
procedure Delete (T : Instance; Key : Key_Type) is
Head : Node_Ptr;
Nod : Node_Ptr;
begin
Ensure_Created (T);
Ensure_Unlocked (T);
-- Obtain the dummy head of the bucket which should house the
-- key-value pair.
Head := Find_Bucket (T.Buckets, Key);
-- Try to find a node in the bucket which matches the key
Nod := Find_Node (Head, Key);
-- If such a node exists, remove it from the bucket and deallocate it
if Is_Valid (Nod, Head) then
Delete_Node (T, Nod);
end if;
end Delete;
-----------------
-- Delete_Node --
-----------------
procedure Delete_Node (T : Instance; Nod : Node_Ptr) is
procedure Compress;
pragma Inline (Compress);
-- Determine whether hash table T requires compression, and if so,
......@@ -502,8 +542,8 @@ package body GNAT.Dynamic_HTables is
--------------
procedure Compress is
pragma Assert (T /= null);
pragma Assert (T.Buckets /= null);
pragma Assert (Present (T));
pragma Assert (Present (T.Buckets));
Old_Size : constant Bucket_Range_Type := T.Buckets'Length;
......@@ -520,41 +560,27 @@ package body GNAT.Dynamic_HTables is
-- Local variables
Head : Node_Ptr;
Nod : Node_Ptr;
Ref : Node_Ptr := Nod;
-- Start of processing for Delete
-- Start of processing for Delete_Node
begin
Ensure_Created (T);
Ensure_Unlocked (T);
pragma Assert (Present (Ref));
pragma Assert (Present (T));
-- Obtain the dummy head of the bucket which should house the
-- key-value pair.
Head := Find_Bucket (T.Buckets, Key);
-- Try to find a node in the bucket which matches the key
Nod := Find_Node (Head, Key);
Detach (Ref);
Free (Ref);
-- If such a node exists, remove it from the bucket and deallocate it
if Is_Valid (Nod, Head) then
Detach (Nod);
Free (Nod);
-- The number of key-value pairs is updated when the hash table
-- contains a valid node which represents the pair.
-- The number of key-value pairs is updated when the hash table
-- contains a valid node which represents the pair.
T.Pairs := T.Pairs - 1;
T.Pairs := T.Pairs - 1;
-- Compress the hash table if the load factor drops below
-- Compression_Threshold.
-- Compress the hash table if the load factor drops below the value
-- of Compression_Threshold.
Compress;
end if;
end Delete;
Compress;
end Delete_Node;
-------------
-- Destroy --
......@@ -594,6 +620,10 @@ package body GNAT.Dynamic_HTables is
while Is_Valid (Head.Next, Head) loop
Nod := Head.Next;
-- Invoke the value destructor before deallocating the node
Destroy_Value (Nod.Value);
Detach (Nod);
Free (Nod);
end loop;
......@@ -602,7 +632,7 @@ package body GNAT.Dynamic_HTables is
-- Start of processing for Destroy_Buckets
begin
pragma Assert (Bkts /= null);
pragma Assert (Present (Bkts));
for Scan_Idx in Bkts'Range loop
Destroy_Bucket (Bkts (Scan_Idx)'Access);
......@@ -614,17 +644,17 @@ package body GNAT.Dynamic_HTables is
------------
procedure Detach (Nod : Node_Ptr) is
pragma Assert (Nod /= null);
pragma Assert (Present (Nod));
Next : constant Node_Ptr := Nod.Next;
Prev : constant Node_Ptr := Nod.Prev;
begin
pragma Assert (Next /= null);
pragma Assert (Prev /= null);
pragma Assert (Present (Next));
pragma Assert (Present (Prev));
Prev.Next := Next;
Next.Prev := Prev;
Prev.Next := Next; -- Prev ---> Next
Next.Prev := Prev; -- Prev <--> Next
Nod.Next := null;
Nod.Prev := null;
......@@ -635,10 +665,10 @@ package body GNAT.Dynamic_HTables is
---------------------
procedure Ensure_Circular (Head : Node_Ptr) is
pragma Assert (Head /= null);
pragma Assert (Present (Head));
begin
if Head.Next = null and then Head.Prev = null then
if not Present (Head.Next) and then not Present (Head.Prev) then
Head.Next := Head;
Head.Prev := Head;
end if;
......@@ -650,7 +680,7 @@ package body GNAT.Dynamic_HTables is
procedure Ensure_Created (T : Instance) is
begin
if T = null then
if not Present (T) then
raise Not_Created;
end if;
end Ensure_Created;
......@@ -661,7 +691,7 @@ package body GNAT.Dynamic_HTables is
procedure Ensure_Unlocked (T : Instance) is
begin
pragma Assert (T /= null);
pragma Assert (Present (T));
-- The hash table has at least one outstanding iterator
......@@ -678,7 +708,7 @@ package body GNAT.Dynamic_HTables is
(Bkts : Bucket_Table_Ptr;
Key : Key_Type) return Node_Ptr
is
pragma Assert (Bkts /= null);
pragma Assert (Present (Bkts));
Idx : constant Bucket_Range_Type := Hash (Key) mod Bkts'Length;
......@@ -691,7 +721,7 @@ package body GNAT.Dynamic_HTables is
---------------
function Find_Node (Head : Node_Ptr; Key : Key_Type) return Node_Ptr is
pragma Assert (Head /= null);
pragma Assert (Present (Head));
Nod : Node_Ptr;
......@@ -725,8 +755,8 @@ package body GNAT.Dynamic_HTables is
Head : Node_Ptr;
begin
pragma Assert (T /= null);
pragma Assert (T.Buckets /= null);
pragma Assert (Present (T));
pragma Assert (Present (T.Buckets));
-- Assume that no valid node exists
......@@ -788,7 +818,7 @@ package body GNAT.Dynamic_HTables is
T : constant Instance := Iter.Table;
begin
pragma Assert (T /= null);
pragma Assert (Present (T));
-- The iterator is no longer valid which indicates that it has been
-- exhausted. Unlock all mutation functionality of the hash table
......@@ -821,7 +851,7 @@ package body GNAT.Dynamic_HTables is
-- The invariant of Iterate and Next ensures that the iterator always
-- refers to a valid node if there exists one.
return Iter.Nod /= null;
return Present (Iter.Curr_Nod);
end Is_Valid;
--------------
......@@ -833,7 +863,7 @@ package body GNAT.Dynamic_HTables is
-- A node is valid if it is non-null, and does not refer to the dummy
-- head of some bucket.
return Nod /= null and then Nod /= Head;
return Present (Nod) and then Nod /= Head;
end Is_Valid;
-------------
......@@ -845,7 +875,7 @@ package body GNAT.Dynamic_HTables is
begin
Ensure_Created (T);
pragma Assert (T.Buckets /= null);
pragma Assert (Present (T.Buckets));
-- Initialize the iterator to reference the first valid node in
-- the full range of hash table buckets. If no such node exists,
......@@ -856,8 +886,8 @@ package body GNAT.Dynamic_HTables is
(T => T,
Low_Bkt => T.Buckets'First,
High_Bkt => T.Buckets'Last,
Idx => Iter.Idx,
Nod => Iter.Nod);
Idx => Iter.Curr_Idx,
Nod => Iter.Curr_Nod);
-- Associate the iterator with the hash table to allow for future
-- mutation functionality unlocking.
......@@ -877,8 +907,8 @@ package body GNAT.Dynamic_HTables is
-----------------
function Load_Factor (T : Instance) return Threshold_Type is
pragma Assert (T /= null);
pragma Assert (T.Buckets /= null);
pragma Assert (Present (T));
pragma Assert (Present (T.Buckets));
begin
-- The load factor is the ratio of key-value pairs to buckets
......@@ -922,8 +952,8 @@ package body GNAT.Dynamic_HTables is
procedure Rehash (From : Bucket_Table_Ptr; To : Bucket_Table_Ptr) is
begin
pragma Assert (From /= null);
pragma Assert (To /= null);
pragma Assert (Present (From));
pragma Assert (Present (To));
for Scan_Idx in From'Range loop
Rehash_Bucket (From (Scan_Idx)'Access, To);
......@@ -935,7 +965,7 @@ package body GNAT.Dynamic_HTables is
-------------------
procedure Rehash_Bucket (Head : Node_Ptr; To : Bucket_Table_Ptr) is
pragma Assert (Head /= null);
pragma Assert (Present (Head));
Nod : Node_Ptr;
......@@ -955,7 +985,7 @@ package body GNAT.Dynamic_HTables is
-----------------
procedure Rehash_Node (Nod : Node_Ptr; To : Bucket_Table_Ptr) is
pragma Assert (Nod /= null);
pragma Assert (Present (Nod));
Head : Node_Ptr;
......@@ -982,7 +1012,7 @@ package body GNAT.Dynamic_HTables is
-- Start of processing for Mutate_And_Rehash
begin
pragma Assert (T /= null);
pragma Assert (Present (T));
Old_Bkts := T.Buckets;
T.Buckets := new Bucket_Table (0 .. Size - 1);
......@@ -1000,13 +1030,13 @@ package body GNAT.Dynamic_HTables is
procedure Next (Iter : in out Iterator; Key : out Key_Type) is
Is_OK : constant Boolean := Is_Valid (Iter);
Saved : constant Node_Ptr := Iter.Nod;
Saved : constant Node_Ptr := Iter.Curr_Nod;
T : constant Instance := Iter.Table;
Head : Node_Ptr;
begin
pragma Assert (T /= null);
pragma Assert (T.Buckets /= null);
pragma Assert (Present (T));
pragma Assert (Present (T.Buckets));
-- The iterator is no longer valid which indicates that it has been
-- exhausted. Unlock all mutation functionality of the hash table as
......@@ -1019,21 +1049,21 @@ package body GNAT.Dynamic_HTables is
-- Advance to the next node along the same bucket
Iter.Nod := Iter.Nod.Next;
Head := T.Buckets (Iter.Idx)'Access;
Iter.Curr_Nod := Iter.Curr_Nod.Next;
Head := T.Buckets (Iter.Curr_Idx)'Access;
-- If the new node is no longer valid, then this indicates that the
-- current bucket has been exhausted. Advance to the next valid node
-- within the remaining range of buckets. If no such node exists, the
-- iterator is left in a state which does not allow it to advance.
if not Is_Valid (Iter.Nod, Head) then
if not Is_Valid (Iter.Curr_Nod, Head) then
First_Valid_Node
(T => T,
Low_Bkt => Iter.Idx + 1,
(T => T,
Low_Bkt => Iter.Curr_Idx + 1,
High_Bkt => T.Buckets'Last,
Idx => Iter.Idx,
Nod => Iter.Nod);
Idx => Iter.Curr_Idx,
Nod => Iter.Curr_Nod);
end if;
Key := Saved.Key;
......@@ -1044,8 +1074,8 @@ package body GNAT.Dynamic_HTables is
-------------
procedure Prepend (Nod : Node_Ptr; Head : Node_Ptr) is
pragma Assert (Nod /= null);
pragma Assert (Head /= null);
pragma Assert (Present (Nod));
pragma Assert (Present (Head));
Next : constant Node_Ptr := Head.Next;
......@@ -1057,6 +1087,33 @@ package body GNAT.Dynamic_HTables is
Nod.Prev := Head;
end Prepend;
-------------
-- Present --
-------------
function Present (Bkts : Bucket_Table_Ptr) return Boolean is
begin
return Bkts /= null;
end Present;
-------------
-- Present --
-------------
function Present (Nod : Node_Ptr) return Boolean is
begin
return Nod /= null;
end Present;
-------------
-- Present --
-------------
function Present (T : Instance) return Boolean is
begin
return T /= Nil;
end Present;
---------
-- Put --
---------
......@@ -1078,8 +1135,8 @@ package body GNAT.Dynamic_HTables is
------------
procedure Expand is
pragma Assert (T /= null);
pragma Assert (T.Buckets /= null);
pragma Assert (Present (T));
pragma Assert (Present (T.Buckets));
Old_Size : constant Bucket_Range_Type := T.Buckets'Length;
......@@ -1099,7 +1156,7 @@ package body GNAT.Dynamic_HTables is
------------------------
procedure Prepend_Or_Replace (Head : Node_Ptr) is
pragma Assert (Head /= null);
pragma Assert (Present (Head));
Nod : Node_Ptr;
......
gcc/ada/libgnat/g-dynhta.ads
......@@ -265,9 +265,9 @@ package GNAT.Dynamic_HTables is
-- The following package offers a hash table abstraction with the following
-- characteristics:
--
-- * Dynamic resizing based on load factor.
-- * Creation of multiple instances, of different sizes.
-- * Iterable keys.
-- * Dynamic resizing based on load factor
-- * Creation of multiple instances, of different sizes
-- * Iterable keys
--
-- This type of hash table is best used in scenarios where the size of the
-- key set is not known. The dynamic resizing aspect allows for performance
......@@ -327,6 +327,9 @@ package GNAT.Dynamic_HTables is
(Left : Key_Type;
Right : Key_Type) return Boolean;
with procedure Destroy_Value (Val : in out Value_Type);
-- Value destructor
with function Hash (Key : Key_Type) return Bucket_Range_Type;
-- Map an arbitrary key into the range of buckets
......@@ -366,6 +369,9 @@ package GNAT.Dynamic_HTables is
function Is_Empty (T : Instance) return Boolean;
-- Determine whether hash table T is empty
function Present (T : Instance) return Boolean;
-- Determine whether hash table T exists
procedure Put (T : Instance; Key : Key_Type; Value : Value_Type);
-- Associate value Value with key Key in hash table T. If the table
-- already contains a mapping of the same key to a previous value, the
......@@ -401,15 +407,15 @@ package GNAT.Dynamic_HTables is
type Iterator is private;
function Iterate (T : Instance) return Iterator;
-- Obtain an iterator over the keys of hash table T. This action locks
-- all mutation functionality of the associated hash table.
function Has_Next (Iter : Iterator) return Boolean;
-- Determine whether iterator Iter has more keys to examine. If the
-- iterator has been exhausted, restore all mutation functionality of
-- the associated hash table.
function Iterate (T : Instance) return Iterator;
-- Obtain an iterator over the keys of hash table T. This action locks
-- all mutation functionality of the associated hash table.
procedure Next (Iter : in out Iterator; Key : out Key_Type);
-- Return the current key referenced by iterator Iter and advance to
-- the next available key. If the iterator has been exhausted and
......@@ -475,11 +481,11 @@ package GNAT.Dynamic_HTables is
-- The following type represents a key iterator
type Iterator is record
Idx : Bucket_Range_Type := 0;
Curr_Idx : Bucket_Range_Type := 0;
-- Index of the current bucket being examined. This index is always
-- kept within the range of the buckets.
Nod : Node_Ptr := null;
Curr_Nod : Node_Ptr := null;
-- Reference to the current node being examined within the current
-- bucket. The invariant of the iterator requires that this field
-- always point to a valid node. A value of null indicates that the
......
gcc/ada/libgnat/g-graphs.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- G N A T . G R A P H S --
-- --
-- B o d y --
-- --
-- Copyright (C) 2018-2019, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
package body GNAT.Graphs is
-----------------------
-- Local subprograms --
-----------------------
function Sequence_Next_Component return Component_Id;
-- Produce the next handle for a component. The handle is guaranteed to be
-- unique across all graphs.
--------------------
-- Directed_Graph --
--------------------
package body Directed_Graph is
-----------------------
-- Local subprograms --
-----------------------
procedure Add_Component
(G : Instance;
Comp : Component_Id;
Vertices : Vertex_List.Instance);
pragma Inline (Add_Component);
-- Add component Comp which houses vertices Vertices to graph G
procedure Ensure_Created (G : Instance);
pragma Inline (Ensure_Created);
-- Verify that graph G is created. Raise Not_Created if this is not the
-- case.
procedure Ensure_Not_Present
(G : Instance;
E : Edge_Id);
pragma Inline (Ensure_Not_Present);
-- Verify that graph G lacks edge E. Raise Duplicate_Edge if this is not
-- the case.
procedure Ensure_Not_Present
(G : Instance;
V : Vertex_Id);
pragma Inline (Ensure_Not_Present);
-- Verify that graph G lacks vertex V. Raise Duplicate_Vertex if this is
-- not the case.
procedure Ensure_Present
(G : Instance;
Comp : Component_Id);
pragma Inline (Ensure_Present);
-- Verify that component Comp exists in graph G. Raise Missing_Component
-- if this is not the case.
procedure Ensure_Present
(G : Instance;
E : Edge_Id);
pragma Inline (Ensure_Present);
-- Verify that edge E is present in graph G. Raise Missing_Edge if this
-- is not the case.
procedure Ensure_Present
(G : Instance;
V : Vertex_Id);
pragma Inline (Ensure_Present);
-- Verify that vertex V is present in graph G. Raise Missing_Vertex if
-- this is not the case.
procedure Free is new Ada.Unchecked_Deallocation (Graph, Instance);
function Get_Component_Attributes
(G : Instance;
Comp : Component_Id) return Component_Attributes;
pragma Inline (Get_Component_Attributes);
-- Obtain the attributes of component Comp of graph G
function Get_Edge_Attributes
(G : Instance;
E : Edge_Id) return Edge_Attributes;
pragma Inline (Get_Edge_Attributes);
-- Obtain the attributes of edge E of graph G
function Get_Vertex_Attributes
(G : Instance;
V : Vertex_Id) return Vertex_Attributes;
pragma Inline (Get_Vertex_Attributes);
-- Obtain the attributes of vertex V of graph G
function Get_Outgoing_Edges
(G : Instance;
V : Vertex_Id) return Edge_Set.Instance;
pragma Inline (Get_Outgoing_Edges);
-- Obtain the Outgoing_Edges attribute of vertex V of graph G
function Get_Vertices
(G : Instance;
Comp : Component_Id) return Vertex_List.Instance;
pragma Inline (Get_Vertices);
-- Obtain the Vertices attribute of component Comp of graph G
procedure Set_Component
(G : Instance;
V : Vertex_Id;
Val : Component_Id);
pragma Inline (Set_Component);
-- Set attribute Component of vertex V of graph G to value Val
procedure Set_Outgoing_Edges
(G : Instance;
V : Vertex_Id;
Val : Edge_Set.Instance);
pragma Inline (Set_Outgoing_Edges);
-- Set attribute Outgoing_Edges of vertex V of graph G to value Val
procedure Set_Vertex_Attributes
(G : Instance;
V : Vertex_Id;
Val : Vertex_Attributes);
pragma Inline (Set_Vertex_Attributes);
-- Set the attributes of vertex V of graph G to value Val
-------------------
-- Add_Component --
-------------------
procedure Add_Component
(G : Instance;
Comp : Component_Id;
Vertices : Vertex_List.Instance)
is
begin
pragma Assert (Present (G));
-- Add the component to the set of all components in the graph
Component_Map.Put
(T => G.Components,
Key => Comp,
Value => (Vertices => Vertices));
end Add_Component;
--------------
-- Add_Edge --
--------------
procedure Add_Edge
(G : Instance;
E : Edge_Id;
Source : Vertex_Id;
Destination : Vertex_Id)
is
begin
Ensure_Created (G);
Ensure_Not_Present (G, E);
Ensure_Present (G, Source);
Ensure_Present (G, Destination);
-- Add the edge to the set of all edges in the graph
Edge_Map.Put
(T => G.All_Edges,
Key => E,
Value =>
(Destination => Destination,
Source => Source));
-- Associate the edge with its source vertex which effectively "owns"
-- the edge.
Edge_Set.Insert
(S => Get_Outgoing_Edges (G, Source),
Elem => E);
end Add_Edge;
----------------
-- Add_Vertex --
----------------
procedure Add_Vertex
(G : Instance;
V : Vertex_Id)
is
begin
Ensure_Created (G);
Ensure_Not_Present (G, V);
-- Add the vertex to the set of all vertices in the graph
Vertex_Map.Put
(T => G.All_Vertices,
Key => V,
Value =>
(Component => No_Component,
Outgoing_Edges => Edge_Set.Nil));
-- It is assumed that the vertex will have at least one outgoing
-- edge. It is important not to create the set of edges above as
-- the call to Put may fail in case the vertices are iterated.
-- This would lead to a memory leak because the set would not be
-- reclaimed.
Set_Outgoing_Edges (G, V, Edge_Set.Create (1));
end Add_Vertex;
---------------
-- Component --
---------------
function Component
(G : Instance;
V : Vertex_Id) return Component_Id
is
begin
Ensure_Created (G);
Ensure_Present (G, V);
return Get_Vertex_Attributes (G, V).Component;
end Component;
------------------------
-- Contains_Component --
------------------------
function Contains_Component
(G : Instance;
Comp : Component_Id) return Boolean
is
begin
Ensure_Created (G);
return Get_Component_Attributes (G, Comp) /= No_Component_Attributes;
end Contains_Component;
-------------------
-- Contains_Edge --
-------------------
function Contains_Edge
(G : Instance;
E : Edge_Id) return Boolean
is
begin
Ensure_Created (G);
return Get_Edge_Attributes (G, E) /= No_Edge_Attributes;
end Contains_Edge;
---------------------
-- Contains_Vertex --
---------------------
function Contains_Vertex
(G : Instance;
V : Vertex_Id) return Boolean
is
begin
Ensure_Created (G);
return Get_Vertex_Attributes (G, V) /= No_Vertex_Attributes;
end Contains_Vertex;
------------
-- Create --
------------
function Create
(Initial_Vertices : Positive;
Initial_Edges : Positive) return Instance
is
G : constant Instance := new Graph;
begin
G.All_Edges := Edge_Map.Create (Initial_Edges);
G.All_Vertices := Vertex_Map.Create (Initial_Vertices);
G.Components := Component_Map.Create (Initial_Vertices);
return G;
end Create;
-----------------
-- Delete_Edge --
-----------------
procedure Delete_Edge
(G : Instance;
E : Edge_Id)
is
Source : Vertex_Id;
begin
Ensure_Created (G);
Ensure_Present (G, E);
Source := Source_Vertex (G, E);
Ensure_Present (G, Source);
-- Delete the edge from its source vertex which effectively "owns"
-- the edge.
Edge_Set.Delete (Get_Outgoing_Edges (G, Source), E);
-- Delete the edge from the set of all edges
Edge_Map.Delete (G.All_Edges, E);
end Delete_Edge;
------------------------
-- Destination_Vertex --
------------------------
function Destination_Vertex
(G : Instance;
E : Edge_Id) return Vertex_Id
is
begin
Ensure_Created (G);
Ensure_Present (G, E);
return Get_Edge_Attributes (G, E).Destination;
end Destination_Vertex;
-------------
-- Destroy --
-------------
procedure Destroy (G : in out Instance) is
begin
Ensure_Created (G);
Edge_Map.Destroy (G.All_Edges);
Vertex_Map.Destroy (G.All_Vertices);
Component_Map.Destroy (G.Components);
Free (G);
end Destroy;
----------------------------------
-- Destroy_Component_Attributes --
----------------------------------
procedure Destroy_Component_Attributes
(Attrs : in out Component_Attributes)
is
begin
Vertex_List.Destroy (Attrs.Vertices);
end Destroy_Component_Attributes;
-----------------------------
-- Destroy_Edge_Attributes --
-----------------------------
procedure Destroy_Edge_Attributes (Attrs : in out Edge_Attributes) is
pragma Unreferenced (Attrs);
begin
null;
end Destroy_Edge_Attributes;
--------------------
-- Destroy_Vertex --
--------------------
procedure Destroy_Vertex (V : in out Vertex_Id) is
pragma Unreferenced (V);
begin
null;
end Destroy_Vertex;
-------------------------------
-- Destroy_Vertex_Attributes --
-------------------------------
procedure Destroy_Vertex_Attributes (Attrs : in out Vertex_Attributes) is
begin
Edge_Set.Destroy (Attrs.Outgoing_Edges);
end Destroy_Vertex_Attributes;
--------------------
-- Ensure_Created --
--------------------
procedure Ensure_Created (G : Instance) is
begin
if not Present (G) then
raise Not_Created;
end if;
end Ensure_Created;
------------------------
-- Ensure_Not_Present --
------------------------
procedure Ensure_Not_Present
(G : Instance;
E : Edge_Id)
is
begin
if Contains_Edge (G, E) then
raise Duplicate_Edge;
end if;
end Ensure_Not_Present;
------------------------
-- Ensure_Not_Present --
------------------------
procedure Ensure_Not_Present
(G : Instance;
V : Vertex_Id)
is
begin
if Contains_Vertex (G, V) then
raise Duplicate_Vertex;
end if;
end Ensure_Not_Present;
--------------------
-- Ensure_Present --
--------------------
procedure Ensure_Present
(G : Instance;
Comp : Component_Id)
is
begin
if not Contains_Component (G, Comp) then
raise Missing_Component;
end if;
end Ensure_Present;
--------------------
-- Ensure_Present --
--------------------
procedure Ensure_Present
(G : Instance;
E : Edge_Id)
is
begin
if not Contains_Edge (G, E) then
raise Missing_Edge;
end if;
end Ensure_Present;
--------------------
-- Ensure_Present --
--------------------
procedure Ensure_Present
(G : Instance;
V : Vertex_Id)
is
begin
if not Contains_Vertex (G, V) then
raise Missing_Vertex;
end if;
end Ensure_Present;
---------------------
-- Find_Components --
---------------------
procedure Find_Components (G : Instance) is
-- The components of graph G are discovered using Tarjan's strongly
-- connected component algorithm. Do not modify this code unless you
-- intimately understand the algorithm.
----------------
-- Tarjan_Map --
----------------
type Visitation_Number is new Natural;
No_Visitation_Number : constant Visitation_Number :=
Visitation_Number'First;
First_Visitation_Number : constant Visitation_Number :=
No_Visitation_Number + 1;
type Tarjan_Attributes is record
Index : Visitation_Number := No_Visitation_Number;
-- Visitation number
Low_Link : Visitation_Number := No_Visitation_Number;
-- Lowest visitation number
On_Stack : Boolean := False;
-- Set when the library item appears in Stack
end record;
No_Tarjan_Attributes : constant Tarjan_Attributes :=
(Index => No_Visitation_Number,
Low_Link => No_Visitation_Number,
On_Stack => False);
procedure Destroy_Tarjan_Attributes
(Attrs : in out Tarjan_Attributes);
-- Destroy the contents of attributes Attrs
package Tarjan_Map is new Dynamic_HTable
(Key_Type => Vertex_Id,
Value_Type => Tarjan_Attributes,
No_Value => No_Tarjan_Attributes,
Expansion_Threshold => 1.5,
Expansion_Factor => 2,
Compression_Threshold => 0.3,
Compression_Factor => 2,
"=" => Same_Vertex,
Destroy_Value => Destroy_Tarjan_Attributes,
Hash => Hash_Vertex);
------------------
-- Tarjan_Stack --
------------------
package Tarjan_Stack is new Doubly_Linked_List
(Element_Type => Vertex_Id,
"=" => Same_Vertex,
Destroy_Element => Destroy_Vertex);
-----------------
-- Global data --
-----------------
Attrs : Tarjan_Map.Instance := Tarjan_Map.Nil;
Stack : Tarjan_Stack.Instance := Tarjan_Stack.Nil;
-----------------------
-- Local subprograms --
-----------------------
procedure Associate_All_Vertices;
pragma Inline (Associate_All_Vertices);
-- Associate all vertices in the graph with the corresponding
-- components that house them.
procedure Associate_Vertices (Comp : Component_Id);
pragma Inline (Associate_Vertices);
-- Associate all vertices of component Comp with the component
procedure Create_Component (V : Vertex_Id);
pragma Inline (Create_Component);
-- Create a new component with root vertex V
function Get_Tarjan_Attributes
(V : Vertex_Id) return Tarjan_Attributes;
pragma Inline (Get_Tarjan_Attributes);
-- Obtain the Tarjan attributes of vertex V
function Index (V : Vertex_Id) return Visitation_Number;
pragma Inline (Index);
-- Obtain the Index attribute of vertex V
procedure Initialize_Components;
pragma Inline (Initialize_Components);
-- Initialize or reinitialize the components of the graph
function Is_Visited (V : Vertex_Id) return Boolean;
pragma Inline (Is_Visited);
-- Determine whether vertex V has been visited
function Low_Link (V : Vertex_Id) return Visitation_Number;
pragma Inline (Low_Link);
-- Obtain the Low_Link attribute of vertex V
function On_Stack (V : Vertex_Id) return Boolean;
pragma Inline (On_Stack);
-- Obtain the On_Stack attribute of vertex V
function Pop return Vertex_Id;
pragma Inline (Pop);
-- Pop a vertex off Stack
procedure Push (V : Vertex_Id);
pragma Inline (Push);
-- Push vertex V on Stack
procedure Record_Visit (V : Vertex_Id);
pragma Inline (Record_Visit);
-- Save the visitation of vertex V by setting relevant attributes
function Sequence_Next_Index return Visitation_Number;
pragma Inline (Sequence_Next_Index);
-- Procedure the next visitation number of the DFS traversal
procedure Set_Index
(V : Vertex_Id;
Val : Visitation_Number);
pragma Inline (Set_Index);
-- Set attribute Index of vertex V to value Val
procedure Set_Low_Link
(V : Vertex_Id;
Val : Visitation_Number);
pragma Inline (Set_Low_Link);
-- Set attribute Low_Link of vertex V to value Val
procedure Set_On_Stack
(V : Vertex_Id;
Val : Boolean);
pragma Inline (Set_On_Stack);
-- Set attribute On_Stack of vertex V to value Val
procedure Set_Tarjan_Attributes
(V : Vertex_Id;
Val : Tarjan_Attributes);
pragma Inline (Set_Tarjan_Attributes);
-- Set the attributes of vertex V to value Val
procedure Visit_Successors (V : Vertex_Id);
pragma Inline (Visit_Successors);
-- Visit the successors of vertex V
procedure Visit_Vertex (V : Vertex_Id);
pragma Inline (Visit_Vertex);
-- Visit single vertex V
procedure Visit_Vertices;
pragma Inline (Visit_Vertices);
-- Visit all vertices in the graph
----------------------------
-- Associate_All_Vertices --
----------------------------
procedure Associate_All_Vertices is
Comp : Component_Id;
Iter : Component_Iterator;
begin
Iter := Iterate_Components (G);
while Has_Next (Iter) loop
Next (Iter, Comp);
Associate_Vertices (Comp);
end loop;
end Associate_All_Vertices;
------------------------
-- Associate_Vertices --
------------------------
procedure Associate_Vertices (Comp : Component_Id) is
Iter : Vertex_Iterator;
V : Vertex_Id;
begin
Iter := Iterate_Vertices (G, Comp);
while Has_Next (Iter) loop
Next (Iter, V);
Set_Component (G, V, Comp);
end loop;
end Associate_Vertices;
----------------------
-- Create_Component --
----------------------
procedure Create_Component (V : Vertex_Id) is
Curr_V : Vertex_Id;
Vertices : Vertex_List.Instance;
begin
Vertices := Vertex_List.Create;
-- Collect all vertices that comprise the current component by
-- popping the stack until reaching the root vertex V.
loop
Curr_V := Pop;
Vertex_List.Append (Vertices, Curr_V);
exit when Same_Vertex (Curr_V, V);
end loop;
Add_Component
(G => G,
Comp => Sequence_Next_Component,
Vertices => Vertices);
end Create_Component;
-------------------------------
-- Destroy_Tarjan_Attributes --
-------------------------------
procedure Destroy_Tarjan_Attributes
(Attrs : in out Tarjan_Attributes)
is
pragma Unreferenced (Attrs);
begin
null;
end Destroy_Tarjan_Attributes;
---------------------------
-- Get_Tarjan_Attributes --
---------------------------
function Get_Tarjan_Attributes
(V : Vertex_Id) return Tarjan_Attributes
is
begin
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
return Tarjan_Map.Get (Attrs, V);
end Get_Tarjan_Attributes;
-----------
-- Index --
-----------
function Index (V : Vertex_Id) return Visitation_Number is
begin
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
return Get_Tarjan_Attributes (V).Index;
end Index;
---------------------------
-- Initialize_Components --
---------------------------
procedure Initialize_Components is
begin
pragma Assert (Present (G));
-- The graph already contains a set of components. Reinitialize
-- them in order to accommodate the new set of components about to
-- be computed.
if Number_Of_Components (G) > 0 then
Component_Map.Destroy (G.Components);
G.Components := Component_Map.Create (Number_Of_Vertices (G));
end if;
end Initialize_Components;
----------------
-- Is_Visited --
----------------
function Is_Visited (V : Vertex_Id) return Boolean is
begin
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
return Index (V) /= No_Visitation_Number;
end Is_Visited;
--------------
-- Low_Link --
--------------
function Low_Link (V : Vertex_Id) return Visitation_Number is
begin
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
return Get_Tarjan_Attributes (V).Low_Link;
end Low_Link;
--------------
-- On_Stack --
--------------
function On_Stack (V : Vertex_Id) return Boolean is
begin
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
return Get_Tarjan_Attributes (V).On_Stack;
end On_Stack;
---------
-- Pop --
---------
function Pop return Vertex_Id is
V : Vertex_Id;
begin
V := Tarjan_Stack.Last (Stack);
Tarjan_Stack.Delete_Last (Stack);
Set_On_Stack (V, False);
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
return V;
end Pop;
----------
-- Push --
----------
procedure Push (V : Vertex_Id) is
begin
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
Tarjan_Stack.Append (Stack, V);
Set_On_Stack (V, True);
end Push;
------------------
-- Record_Visit --
------------------
procedure Record_Visit (V : Vertex_Id) is
Index : constant Visitation_Number := Sequence_Next_Index;
begin
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
Set_Index (V, Index);
Set_Low_Link (V, Index);
end Record_Visit;
-------------------------
-- Sequence_Next_Index --
-------------------------
Index_Sequencer : Visitation_Number := First_Visitation_Number;
-- The counter for visitation numbers. Do not directly manipulate its
-- value because this will destroy the Index and Low_Link invariants
-- of the algorithm.
function Sequence_Next_Index return Visitation_Number is
Index : constant Visitation_Number := Index_Sequencer;
begin
Index_Sequencer := Index_Sequencer + 1;
return Index;
end Sequence_Next_Index;
---------------
-- Set_Index --
---------------
procedure Set_Index
(V : Vertex_Id;
Val : Visitation_Number)
is
TA : Tarjan_Attributes;
begin
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
TA := Get_Tarjan_Attributes (V);
TA.Index := Val;
Set_Tarjan_Attributes (V, TA);
end Set_Index;
------------------
-- Set_Low_Link --
------------------
procedure Set_Low_Link
(V : Vertex_Id;
Val : Visitation_Number)
is
TA : Tarjan_Attributes;
begin
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
TA := Get_Tarjan_Attributes (V);
TA.Low_Link := Val;
Set_Tarjan_Attributes (V, TA);
end Set_Low_Link;
------------------
-- Set_On_Stack --
------------------
procedure Set_On_Stack
(V : Vertex_Id;
Val : Boolean)
is
TA : Tarjan_Attributes;
begin
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
TA := Get_Tarjan_Attributes (V);
TA.On_Stack := Val;
Set_Tarjan_Attributes (V, TA);
end Set_On_Stack;
---------------------------
-- Set_Tarjan_Attributes --
---------------------------
procedure Set_Tarjan_Attributes
(V : Vertex_Id;
Val : Tarjan_Attributes)
is
begin
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
Tarjan_Map.Put (Attrs, V, Val);
end Set_Tarjan_Attributes;
----------------------
-- Visit_Successors --
----------------------
procedure Visit_Successors (V : Vertex_Id) is
E : Edge_Id;
Iter : Outgoing_Edge_Iterator;
Succ : Vertex_Id;
begin
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
Iter := Iterate_Outgoing_Edges (G, V);
while Has_Next (Iter) loop
Next (Iter, E);
Succ := Destination_Vertex (G, E);
pragma Assert (Contains_Vertex (G, Succ));
-- The current successor has not been visited yet. Extend the
-- DFS traversal into it.
if not Is_Visited (Succ) then
Visit_Vertex (Succ);
Set_Low_Link (V,
Visitation_Number'Min (Low_Link (V), Low_Link (Succ)));
-- The current successor has been visited, and still remains on
-- the stack which indicates that it does not participate in a
-- component yet.
elsif On_Stack (Succ) then
Set_Low_Link (V,
Visitation_Number'Min (Low_Link (V), Index (Succ)));
end if;
end loop;
end Visit_Successors;
------------------
-- Visit_Vertex --
------------------
procedure Visit_Vertex (V : Vertex_Id) is
begin
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
if not Is_Visited (V) then
Record_Visit (V);
Push (V);
Visit_Successors (V);
-- The current vertex is the root of a component
if Low_Link (V) = Index (V) then
Create_Component (V);
end if;
end if;
end Visit_Vertex;
--------------------
-- Visit_Vertices --
--------------------
procedure Visit_Vertices is
Iter : All_Vertex_Iterator;
V : Vertex_Id;
begin
Iter := Iterate_All_Vertices (G);
while Has_Next (Iter) loop
Next (Iter, V);
Visit_Vertex (V);
end loop;
end Visit_Vertices;
-- Start of processing for Find_Components
begin
-- Initialize or reinitialize the components of the graph
Initialize_Components;
-- Prepare the extra attributes needed for each vertex, global
-- visitation number, and the stack where examined vertices are
-- placed.
Attrs := Tarjan_Map.Create (Number_Of_Vertices (G));
Stack := Tarjan_Stack.Create;
-- Start the DFS traversal of Tarjan's SCC algorithm
Visit_Vertices;
Tarjan_Map.Destroy (Attrs);
Tarjan_Stack.Destroy (Stack);
-- Associate each vertex with the component it belongs to
Associate_All_Vertices;
end Find_Components;
------------------------------
-- Get_Component_Attributes --
------------------------------
function Get_Component_Attributes
(G : Instance;
Comp : Component_Id) return Component_Attributes
is
begin
pragma Assert (Present (G));
pragma Assert (Contains_Component (G, Comp));
return Component_Map.Get (G.Components, Comp);
end Get_Component_Attributes;
-------------------------
-- Get_Edge_Attributes --
-------------------------
function Get_Edge_Attributes
(G : Instance;
E : Edge_Id) return Edge_Attributes
is
begin
pragma Assert (Present (G));
pragma Assert (Contains_Edge (G, E));
return Edge_Map.Get (G.All_Edges, E);
end Get_Edge_Attributes;
---------------------------
-- Get_Vertex_Attributes --
---------------------------
function Get_Vertex_Attributes
(G : Instance;
V : Vertex_Id) return Vertex_Attributes
is
begin
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
return Vertex_Map.Get (G.All_Vertices, V);
end Get_Vertex_Attributes;
------------------------
-- Get_Outgoing_Edges --
------------------------
function Get_Outgoing_Edges
(G : Instance;
V : Vertex_Id) return Edge_Set.Instance
is
begin
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
return Get_Vertex_Attributes (G, V).Outgoing_Edges;
end Get_Outgoing_Edges;
------------------
-- Get_Vertices --
------------------
function Get_Vertices
(G : Instance;
Comp : Component_Id) return Vertex_List.Instance
is
begin
pragma Assert (Present (G));
pragma Assert (Contains_Component (G, Comp));
return Get_Component_Attributes (G, Comp).Vertices;
end Get_Vertices;
--------------
-- Has_Next --
--------------
function Has_Next (Iter : All_Edge_Iterator) return Boolean is
begin
return Edge_Map.Has_Next (Edge_Map.Iterator (Iter));
end Has_Next;
--------------
-- Has_Next --
--------------
function Has_Next (Iter : All_Vertex_Iterator) return Boolean is
begin
return Vertex_Map.Has_Next (Vertex_Map.Iterator (Iter));
end Has_Next;
--------------
-- Has_Next --
--------------
function Has_Next (Iter : Component_Iterator) return Boolean is
begin
return Component_Map.Has_Next (Component_Map.Iterator (Iter));
end Has_Next;
--------------
-- Has_Next --
--------------
function Has_Next (Iter : Outgoing_Edge_Iterator) return Boolean is
begin
return Edge_Set.Has_Next (Edge_Set.Iterator (Iter));
end Has_Next;
--------------
-- Has_Next --
--------------
function Has_Next (Iter : Vertex_Iterator) return Boolean is
begin
return Vertex_List.Has_Next (Vertex_List.Iterator (Iter));
end Has_Next;
--------------
-- Is_Empty --
--------------
function Is_Empty (G : Instance) return Boolean is
begin
Ensure_Created (G);
return
Edge_Map.Is_Empty (G.All_Edges)
and then Vertex_Map.Is_Empty (G.All_Vertices);
end Is_Empty;
-----------------------
-- Iterate_All_Edges --
-----------------------
function Iterate_All_Edges (G : Instance) return All_Edge_Iterator is
begin
Ensure_Created (G);
return All_Edge_Iterator (Edge_Map.Iterate (G.All_Edges));
end Iterate_All_Edges;
--------------------------
-- Iterate_All_Vertices --
--------------------------
function Iterate_All_Vertices
(G : Instance) return All_Vertex_Iterator
is
begin
Ensure_Created (G);
return All_Vertex_Iterator (Vertex_Map.Iterate (G.All_Vertices));
end Iterate_All_Vertices;
------------------------
-- Iterate_Components --
------------------------
function Iterate_Components (G : Instance) return Component_Iterator is
begin
Ensure_Created (G);
return Component_Iterator (Component_Map.Iterate (G.Components));
end Iterate_Components;
----------------------------
-- Iterate_Outgoing_Edges --
----------------------------
function Iterate_Outgoing_Edges
(G : Instance;
V : Vertex_Id) return Outgoing_Edge_Iterator
is
begin
Ensure_Created (G);
Ensure_Present (G, V);
return
Outgoing_Edge_Iterator
(Edge_Set.Iterate (Get_Outgoing_Edges (G, V)));
end Iterate_Outgoing_Edges;
----------------------
-- Iterate_Vertices --
----------------------
function Iterate_Vertices
(G : Instance;
Comp : Component_Id) return Vertex_Iterator
is
begin
Ensure_Created (G);
Ensure_Present (G, Comp);
return Vertex_Iterator (Vertex_List.Iterate (Get_Vertices (G, Comp)));
end Iterate_Vertices;
----------
-- Next --
----------
procedure Next
(Iter : in out All_Edge_Iterator;
E : out Edge_Id)
is
begin
Edge_Map.Next (Edge_Map.Iterator (Iter), E);
end Next;
----------
-- Next --
----------
procedure Next
(Iter : in out All_Vertex_Iterator;
V : out Vertex_Id)
is
begin
Vertex_Map.Next (Vertex_Map.Iterator (Iter), V);
end Next;
----------
-- Next --
----------
procedure Next
(Iter : in out Component_Iterator;
Comp : out Component_Id)
is
begin
Component_Map.Next (Component_Map.Iterator (Iter), Comp);
end Next;
----------
-- Next --
----------
procedure Next
(Iter : in out Outgoing_Edge_Iterator;
E : out Edge_Id)
is
begin
Edge_Set.Next (Edge_Set.Iterator (Iter), E);
end Next;
----------
-- Next --
----------
procedure Next
(Iter : in out Vertex_Iterator;
V : out Vertex_Id)
is
begin
Vertex_List.Next (Vertex_List.Iterator (Iter), V);
end Next;
--------------------------
-- Number_Of_Components --
--------------------------
function Number_Of_Components (G : Instance) return Natural is
begin
Ensure_Created (G);
return Component_Map.Size (G.Components);
end Number_Of_Components;
---------------------
-- Number_Of_Edges --
---------------------
function Number_Of_Edges (G : Instance) return Natural is
begin
Ensure_Created (G);
return Edge_Map.Size (G.All_Edges);
end Number_Of_Edges;
------------------------
-- Number_Of_Vertices --
------------------------
function Number_Of_Vertices (G : Instance) return Natural is
begin
Ensure_Created (G);
return Vertex_Map.Size (G.All_Vertices);
end Number_Of_Vertices;
-------------
-- Present --
-------------
function Present (G : Instance) return Boolean is
begin
return G /= Nil;
end Present;
-------------------
-- Set_Component --
-------------------
procedure Set_Component
(G : Instance;
V : Vertex_Id;
Val : Component_Id)
is
VA : Vertex_Attributes;
begin
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
VA := Get_Vertex_Attributes (G, V);
VA.Component := Val;
Set_Vertex_Attributes (G, V, VA);
end Set_Component;
------------------------
-- Set_Outgoing_Edges --
------------------------
procedure Set_Outgoing_Edges
(G : Instance;
V : Vertex_Id;
Val : Edge_Set.Instance)
is
VA : Vertex_Attributes;
begin
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
VA := Get_Vertex_Attributes (G, V);
VA.Outgoing_Edges := Val;
Set_Vertex_Attributes (G, V, VA);
end Set_Outgoing_Edges;
---------------------------
-- Set_Vertex_Attributes --
---------------------------
procedure Set_Vertex_Attributes
(G : Instance;
V : Vertex_Id;
Val : Vertex_Attributes)
is
begin
pragma Assert (Present (G));
pragma Assert (Contains_Vertex (G, V));
Vertex_Map.Put (G.All_Vertices, V, Val);
end Set_Vertex_Attributes;
-------------------
-- Source_Vertex --
-------------------
function Source_Vertex
(G : Instance;
E : Edge_Id) return Vertex_Id
is
begin
Ensure_Created (G);
Ensure_Present (G, E);
return Get_Edge_Attributes (G, E).Source;
end Source_Vertex;
end Directed_Graph;
--------------------
-- Hash_Component --
--------------------
function Hash_Component (Comp : Component_Id) return Bucket_Range_Type is
begin
return Bucket_Range_Type (Comp);
end Hash_Component;
-------------
-- Present --
-------------
function Present (Comp : Component_Id) return Boolean is
begin
return Comp /= No_Component;
end Present;
-----------------------------
-- Sequence_Next_Component --
-----------------------------
Component_Sequencer : Component_Id := First_Component;
-- The counter for component handles. Do not directly manipulate its value
-- because this will destroy the invariant of the handles.
function Sequence_Next_Component return Component_Id is
Component : constant Component_Id := Component_Sequencer;
begin
Component_Sequencer := Component_Sequencer + 1;
return Component;
end Sequence_Next_Component;
end GNAT.Graphs;
gcc/ada/libgnat/g-graphs.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- G N A T . G R A P H S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2018-2019, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
pragma Compiler_Unit_Warning;
with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
with GNAT.Lists; use GNAT.Lists;
with GNAT.Sets; use GNAT.Sets;
package GNAT.Graphs is
---------------
-- Componant --
---------------
-- The following type denotes a strongly connected component handle
-- (referred to as simply "component") in a graph.
type Component_Id is new Natural;
No_Component : constant Component_Id;
function Hash_Component (Comp : Component_Id) return Bucket_Range_Type;
-- Map component Comp into the range of buckets
function Present (Comp : Component_Id) return Boolean;
-- Determine whether component Comp exists
--------------------
-- Directed_Graph --
--------------------
-- The following package offers a directed graph abstraction with the
-- following characteristics:
--
-- * Dynamic resizing based on number of vertices and edges
-- * Creation of multiple instances, of different sizes
-- * Discovery of strongly connected components
-- * Iterable attributes
--
-- The following use pattern must be employed when operating this graph:
--
-- Graph : Instance := Create (<some size>, <some size>);
--
-- <various operations>
--
-- Destroy (Graph);
--
-- The destruction of the graph reclaims all storage occupied by it.
generic
--------------
-- Vertices --
--------------
type Vertex_Id is private;
-- The handle of a vertex
No_Vertex : Vertex_Id;
-- An indicator for a nonexistent vertex
with function Hash_Vertex (V : Vertex_Id) return Bucket_Range_Type;
-- Map vertex V into the range of buckets
with function Same_Vertex
(Left : Vertex_Id;
Right : Vertex_Id) return Boolean;
-- Compare vertex Left to vertex Right for identity
-----------
-- Edges --
-----------
type Edge_Id is private;
-- The handle of an edge
No_Edge : Edge_Id;
-- An indicator for a nonexistent edge
with function Hash_Edge (E : Edge_Id) return Bucket_Range_Type;
-- Map edge E into the range of buckets
with function Same_Edge
(Left : Edge_Id;
Right : Edge_Id) return Boolean;
-- Compare edge Left to edge Right for identity
package Directed_Graph is
-- The following exceptions are raised when an attempt is made to add
-- the same edge or vertex in a graph.
Duplicate_Edge : exception;
Duplicate_Vertex : exception;
-- The following exceptions are raised when an attempt is made to delete
-- or reference a nonexistent component, edge, or vertex in a graph.
Missing_Component : exception;
Missing_Edge : exception;
Missing_Vertex : exception;
----------------------
-- Graph operations --
----------------------
-- The following type denotes a graph handle. Each instance must be
-- created using routine Create.
type Instance is private;
Nil : constant Instance;
procedure Add_Edge
(G : Instance;
E : Edge_Id;
Source : Vertex_Id;
Destination : Vertex_Id);
-- Add edge E to graph G which links vertex source Source and desination
-- vertex Destination. The edge is "owned" by vertex Source. This action
-- raises the following exceptions:
--
-- * Duplicate_Edge, when the edge is already present in the graph
--
-- * Iterated, when the graph has an outstanding edge iterator
--
-- * Missing_Vertex, when either the source or desination are not
-- present in the graph.
procedure Add_Vertex
(G : Instance;
V : Vertex_Id);
-- Add vertex V to graph G. This action raises the following exceptions:
--
-- * Duplicate_Vertex, when the vertex is already present in the graph
--
-- * Iterated, when the graph has an outstanding vertex iterator
function Component
(G : Instance;
V : Vertex_Id) return Component_Id;
-- Obtain the component where vertex V of graph G resides. This action
-- raises the following exceptions:
--
-- * Missing_Vertex, when the vertex is not present in the graph
function Contains_Component
(G : Instance;
Comp : Component_Id) return Boolean;
-- Determine whether graph G contains component Comp
function Contains_Edge
(G : Instance;
E : Edge_Id) return Boolean;
-- Determine whether graph G contains edge E
function Contains_Vertex
(G : Instance;
V : Vertex_Id) return Boolean;
-- Determine whether graph G contains vertex V
function Create
(Initial_Vertices : Positive;
Initial_Edges : Positive) return Instance;
-- Create a new graph with vertex capacity Initial_Vertices and edge
-- capacity Initial_Edges. This routine must be called at the start of
-- a graph's lifetime.
procedure Delete_Edge
(G : Instance;
E : Edge_Id);
-- Delete edge E from graph G. This action raises these exceptions:
--
-- * Iterated, when the graph has an outstanding edge iterator
--
-- * Missing_Edge, when the edge is not present in the graph
--
-- * Missing_Vertex, when the source vertex that "owns" the edge is
-- not present in the graph.
function Destination_Vertex
(G : Instance;
E : Edge_Id) return Vertex_Id;
-- Obtain the destination vertex of edge E of graph G. This action
-- raises the following exceptions:
--
-- * Missing_Edge, when the edge is not present in the graph
procedure Destroy (G : in out Instance);
-- Destroy the contents of graph G, rendering it unusable. This routine
-- must be called at the end of a graph's lifetime. This action raises
-- the following exceptions:
--
-- * Iterated, if the graph has any outstanding iterator
procedure Find_Components (G : Instance);
-- Find all components of graph G. This action raises the following
-- exceptions:
--
-- * Iterated, when the components or vertices of the graph have an
-- outstanding iterator.
function Is_Empty (G : Instance) return Boolean;
-- Determine whether graph G is empty
function Number_Of_Components (G : Instance) return Natural;
-- Obtain the total number of components of graph G
function Number_Of_Edges (G : Instance) return Natural;
-- Obtain the total number of edges of graph G
function Number_Of_Vertices (G : Instance) return Natural;
-- Obtain the total number of vertices of graph G
function Present (G : Instance) return Boolean;
-- Determine whether graph G exists
function Source_Vertex
(G : Instance;
E : Edge_Id) return Vertex_Id;
-- Obtain the source vertex that "owns" edge E of graph G. This action
-- raises the following exceptions:
--
-- * Missing_Edge, when the edge is not present in the graph
-------------------------
-- Iterator operations --
-------------------------
-- The following types represent iterators over various attributes of a
-- graph. Each iterator locks all mutation operations of its associated
-- attribute, and unlocks them once it is exhausted. The iterators must
-- be used with the following pattern:
--
-- Iter : Iterate_XXX (Graph);
-- while Has_Next (Iter) loop
-- Next (Iter, Element);
-- end loop;
--
-- It is possible to advance the iterators by using Next only, however
-- this risks raising Iterator_Exhausted.
-- The following type represents an iterator over all edges of a graph
type All_Edge_Iterator is private;
function Has_Next (Iter : All_Edge_Iterator) return Boolean;
-- Determine whether iterator Iter has more edges to examine
function Iterate_All_Edges (G : Instance) return All_Edge_Iterator;
-- Obtain an iterator over all edges of graph G
procedure Next
(Iter : in out All_Edge_Iterator;
E : out Edge_Id);
-- Return the current edge referenced by iterator Iter and advance to
-- the next available edge. This action raises the following exceptions:
--
-- * Iterator_Exhausted, when the iterator has been exhausted and
-- further attempts are made to advance it.
-- The following type represents an iterator over all vertices of a
-- graph.
type All_Vertex_Iterator is private;
function Has_Next (Iter : All_Vertex_Iterator) return Boolean;
-- Determine whether iterator Iter has more vertices to examine
function Iterate_All_Vertices (G : Instance) return All_Vertex_Iterator;
-- Obtain an iterator over all vertices of graph G
procedure Next
(Iter : in out All_Vertex_Iterator;
V : out Vertex_Id);
-- Return the current vertex referenced by iterator Iter and advance
-- to the next available vertex. This action raises the following
-- exceptions:
--
-- * Iterator_Exhausted, when the iterator has been exhausted and
-- further attempts are made to advance it.
-- The following type represents an iterator over all components of a
-- graph.
type Component_Iterator is private;
function Has_Next (Iter : Component_Iterator) return Boolean;
-- Determine whether iterator Iter has more components to examine
function Iterate_Components (G : Instance) return Component_Iterator;
-- Obtain an iterator over all components of graph G
procedure Next
(Iter : in out Component_Iterator;
Comp : out Component_Id);
-- Return the current component referenced by iterator Iter and advance
-- to the next component. This action raises the following exceptions:
--
-- * Iterator_Exhausted, when the iterator has been exhausted and
-- further attempts are made to advance it.
-- The following type represents an iterator over all outgoing edges of
-- a vertex.
type Outgoing_Edge_Iterator is private;
function Has_Next (Iter : Outgoing_Edge_Iterator) return Boolean;
-- Determine whether iterator Iter has more outgoing edges to examine
function Iterate_Outgoing_Edges
(G : Instance;
V : Vertex_Id) return Outgoing_Edge_Iterator;
-- Obtain an iterator over all the outgoing edges "owned" by vertex V of
-- graph G.
procedure Next
(Iter : in out Outgoing_Edge_Iterator;
E : out Edge_Id);
-- Return the current outgoing edge referenced by iterator Iter and
-- advance to the next available outgoing edge. This action raises the
-- following exceptions:
--
-- * Iterator_Exhausted, when the iterator has been exhausted and
-- further attempts are made to advance it.
-- The following type prepresents an iterator over all vertices of a
-- component.
type Vertex_Iterator is private;
function Has_Next (Iter : Vertex_Iterator) return Boolean;
-- Determine whether iterator Iter has more vertices to examine
function Iterate_Vertices
(G : Instance;
Comp : Component_Id) return Vertex_Iterator;
-- Obtain an iterator over all vertices that comprise component Comp of
-- graph G.
procedure Next
(Iter : in out Vertex_Iterator;
V : out Vertex_Id);
-- Return the current vertex referenced by iterator Iter and advance to
-- the next vertex. This action raises the following exceptions:
--
-- * Iterator_Exhausted, when the iterator has been exhausted and
-- further attempts are made to advance it.
private
pragma Unreferenced (No_Edge);
--------------
-- Edge_Map --
--------------
type Edge_Attributes is record
Destination : Vertex_Id := No_Vertex;
-- The target of a directed edge
Source : Vertex_Id := No_Vertex;
-- The origin of a directed edge. The source vertex "owns" the edge.
end record;
No_Edge_Attributes : constant Edge_Attributes :=
(Destination => No_Vertex,
Source => No_Vertex);
procedure Destroy_Edge_Attributes (Attrs : in out Edge_Attributes);
-- Destroy the contents of attributes Attrs
package Edge_Map is new Dynamic_HTable
(Key_Type => Edge_Id,
Value_Type => Edge_Attributes,
No_Value => No_Edge_Attributes,
Expansion_Threshold => 1.5,
Expansion_Factor => 2,
Compression_Threshold => 0.3,
Compression_Factor => 2,
"=" => Same_Edge,
Destroy_Value => Destroy_Edge_Attributes,
Hash => Hash_Edge);
--------------
-- Edge_Set --
--------------
package Edge_Set is new Membership_Set
(Element_Type => Edge_Id,
"=" => "=",
Hash => Hash_Edge);
-----------------
-- Vertex_List --
-----------------
procedure Destroy_Vertex (V : in out Vertex_Id);
-- Destroy the contents of a vertex
package Vertex_List is new Doubly_Linked_List
(Element_Type => Vertex_Id,
"=" => Same_Vertex,
Destroy_Element => Destroy_Vertex);
----------------
-- Vertex_Map --
----------------
type Vertex_Attributes is record
Component : Component_Id := No_Component;
-- The component where a vertex lives
Outgoing_Edges : Edge_Set.Instance := Edge_Set.Nil;
-- The set of edges that extend out from a vertex
end record;
No_Vertex_Attributes : constant Vertex_Attributes :=
(Component => No_Component,
Outgoing_Edges => Edge_Set.Nil);
procedure Destroy_Vertex_Attributes (Attrs : in out Vertex_Attributes);
-- Destroy the contents of attributes Attrs
package Vertex_Map is new Dynamic_HTable
(Key_Type => Vertex_Id,
Value_Type => Vertex_Attributes,
No_Value => No_Vertex_Attributes,
Expansion_Threshold => 1.5,
Expansion_Factor => 2,
Compression_Threshold => 0.3,
Compression_Factor => 2,
"=" => Same_Vertex,
Destroy_Value => Destroy_Vertex_Attributes,
Hash => Hash_Vertex);
-------------------
-- Component_Map --
-------------------
type Component_Attributes is record
Vertices : Vertex_List.Instance := Vertex_List.Nil;
end record;
No_Component_Attributes : constant Component_Attributes :=
(Vertices => Vertex_List.Nil);
procedure Destroy_Component_Attributes
(Attrs : in out Component_Attributes);
-- Destroy the contents of attributes Attrs
package Component_Map is new Dynamic_HTable
(Key_Type => Component_Id,
Value_Type => Component_Attributes,
No_Value => No_Component_Attributes,
Expansion_Threshold => 1.5,
Expansion_Factor => 2,
Compression_Threshold => 0.3,
Compression_Factor => 2,
"=" => "=",
Destroy_Value => Destroy_Component_Attributes,
Hash => Hash_Component);
-----------
-- Graph --
-----------
type Graph is record
All_Edges : Edge_Map.Instance := Edge_Map.Nil;
-- The map of edge -> edge attributes for all edges in the graph
All_Vertices : Vertex_Map.Instance := Vertex_Map.Nil;
-- The map of vertex -> vertex attributes for all vertices in the
-- graph.
Components : Component_Map.Instance := Component_Map.Nil;
-- The map of component -> component attributes for all components
-- in the graph.
end record;
--------------
-- Instance --
--------------
type Instance is access Graph;
Nil : constant Instance := null;
---------------
-- Iterators --
---------------
type All_Edge_Iterator is new Edge_Map.Iterator;
type All_Vertex_Iterator is new Vertex_Map.Iterator;
type Component_Iterator is new Component_Map.Iterator;
type Outgoing_Edge_Iterator is new Edge_Set.Iterator;
type Vertex_Iterator is new Vertex_List.Iterator;
end Directed_Graph;
private
No_Component : constant Component_Id := Component_Id'First;
First_Component : constant Component_Id := No_Component + 1;
end GNAT.Graphs;
gcc/ada/libgnat/g-lists.adb
......@@ -90,6 +90,10 @@ package body GNAT.Lists is
pragma Inline (Lock);
-- Lock all mutation functionality of list L
function Present (Nod : Node_Ptr) return Boolean;
pragma Inline (Present);
-- Determine whether node Nod exists
procedure Unlock (L : Instance);
pragma Inline (Unlock);
-- Unlock all mutation functionality of list L
......@@ -217,15 +221,15 @@ package body GNAT.Lists is
procedure Delete_Node (L : Instance; Nod : Node_Ptr) is
Ref : Node_Ptr := Nod;
pragma Assert (Ref /= null);
pragma Assert (Present (Ref));
Next : constant Node_Ptr := Ref.Next;
Prev : constant Node_Ptr := Ref.Prev;
begin
pragma Assert (L /= null);
pragma Assert (Next /= null);
pragma Assert (Prev /= null);
pragma Assert (Present (L));
pragma Assert (Present (Next));
pragma Assert (Present (Prev));
Prev.Next := Next; -- Prev ---> Next
Next.Prev := Prev; -- Prev <--> Next
......@@ -235,6 +239,10 @@ package body GNAT.Lists is
L.Elements := L.Elements - 1;
-- Invoke the element destructor before deallocating the node
Destroy_Element (Nod.Elem);
Free (Ref);
end Delete_Node;
......@@ -263,10 +271,10 @@ package body GNAT.Lists is
---------------------
procedure Ensure_Circular (Head : Node_Ptr) is
pragma Assert (Head /= null);
pragma Assert (Present (Head));
begin
if Head.Next = null and then Head.Prev = null then
if not Present (Head.Next) and then not Present (Head.Prev) then
Head.Next := Head;
Head.Prev := Head;
end if;
......@@ -278,7 +286,7 @@ package body GNAT.Lists is
procedure Ensure_Created (L : Instance) is
begin
if L = null then
if not Present (L) then
raise Not_Created;
end if;
end Ensure_Created;
......@@ -289,7 +297,7 @@ package body GNAT.Lists is
procedure Ensure_Full (L : Instance) is
begin
pragma Assert (L /= null);
pragma Assert (Present (L));
if L.Elements = 0 then
raise List_Empty;
......@@ -302,7 +310,7 @@ package body GNAT.Lists is
procedure Ensure_Unlocked (L : Instance) is
begin
pragma Assert (L /= null);
pragma Assert (Present (L));
-- The list has at least one outstanding iterator
......@@ -319,7 +327,7 @@ package body GNAT.Lists is
(Head : Node_Ptr;
Elem : Element_Type) return Node_Ptr
is
pragma Assert (Head /= null);
pragma Assert (Present (Head));
Nod : Node_Ptr;
......@@ -435,9 +443,9 @@ package body GNAT.Lists is
Left : Node_Ptr;
Right : Node_Ptr)
is
pragma Assert (L /= null);
pragma Assert (Left /= null);
pragma Assert (Right /= null);
pragma Assert (Present (L));
pragma Assert (Present (Left));
pragma Assert (Present (Right));
Nod : constant Node_Ptr :=
new Node'(Elem => Elem,
......@@ -471,7 +479,7 @@ package body GNAT.Lists is
-- The invariant of Iterate and Next ensures that the iterator always
-- refers to a valid node if there exists one.
return Is_Valid (Iter.Nod, Iter.List.Nodes'Access);
return Is_Valid (Iter.Curr_Nod, Iter.List.Nodes'Access);
end Is_Valid;
--------------
......@@ -483,7 +491,7 @@ package body GNAT.Lists is
-- A node is valid if it is non-null, and does not refer to the dummy
-- head of some list.
return Nod /= null and then Nod /= Head;
return Present (Nod) and then Nod /= Head;
end Is_Valid;
-------------
......@@ -499,7 +507,7 @@ package body GNAT.Lists is
Lock (L);
return (List => L, Nod => L.Nodes.Next);
return (List => L, Curr_Nod => L.Nodes.Next);
end Iterate;
----------
......@@ -520,7 +528,7 @@ package body GNAT.Lists is
procedure Lock (L : Instance) is
begin
pragma Assert (L /= null);
pragma Assert (Present (L));
-- The list may be locked multiple times if multiple iterators are
-- operating over it.
......@@ -534,7 +542,7 @@ package body GNAT.Lists is
procedure Next (Iter : in out Iterator; Elem : out Element_Type) is
Is_OK : constant Boolean := Is_Valid (Iter);
Saved : constant Node_Ptr := Iter.Nod;
Saved : constant Node_Ptr := Iter.Curr_Nod;
begin
-- The iterator is no linger valid which indicates that it has been
......@@ -548,8 +556,9 @@ package body GNAT.Lists is
-- Advance to the next node along the list
Iter.Nod := Iter.Nod.Next;
Elem := Saved.Elem;
Iter.Curr_Nod := Iter.Curr_Nod.Next;
Elem := Saved.Elem;
end Next;
-------------
......@@ -580,6 +589,24 @@ package body GNAT.Lists is
end Prepend;
-------------
-- Present --
-------------
function Present (L : Instance) return Boolean is
begin
return L /= Nil;
end Present;
-------------
-- Present --
-------------
function Present (Nod : Node_Ptr) return Boolean is
begin
return Nod /= null;
end Present;
-------------
-- Replace --
-------------
......@@ -620,7 +647,7 @@ package body GNAT.Lists is
procedure Unlock (L : Instance) is
begin
pragma Assert (L /= null);
pragma Assert (Present (L));
-- The list may be locked multiple times if multiple iterators are
-- operating over it.
......
gcc/ada/libgnat/g-lists.ads
......@@ -40,8 +40,8 @@ package GNAT.Lists is
-- The following package offers a doubly linked list abstraction with the
-- following characteristics:
--
-- * Creation of multiple instances, of different sizes.
-- * Iterable elements.
-- * Creation of multiple instances, of different sizes
-- * Iterable elements
--
-- The following use pattern must be employed with this list:
--
......@@ -60,6 +60,9 @@ package GNAT.Lists is
(Left : Element_Type;
Right : Element_Type) return Boolean;
with procedure Destroy_Element (Elem : in out Element_Type);
-- Element destructor
package Doubly_Linked_List is
---------------------
......@@ -139,6 +142,9 @@ package GNAT.Lists is
-- Insert element Elem at the start of list L. This action will raise
-- Iterated if the list has outstanding iterators.
function Present (L : Instance) return Boolean;
-- Determine whether list L exists
procedure Replace
(L : Instance;
Old_Elem : Element_Type;
......@@ -168,15 +174,15 @@ package GNAT.Lists is
type Iterator is private;
function Iterate (L : Instance) return Iterator;
-- Obtain an iterator over the elements of list L. This action locks all
-- mutation functionality of the associated list.
function Has_Next (Iter : Iterator) return Boolean;
-- Determine whether iterator Iter has more elements to examine. If the
-- iterator has been exhausted, restore all mutation functionality of
-- the associated list.
function Iterate (L : Instance) return Iterator;
-- Obtain an iterator over the elements of list L. This action locks all
-- mutation functionality of the associated list.
procedure Next (Iter : in out Iterator; Elem : out Element_Type);
-- Return the current element referenced by iterator Iter and advance
-- to the next available element. If the iterator has been exhausted
......@@ -215,13 +221,13 @@ package GNAT.Lists is
-- The following type represents an element iterator
type Iterator is record
List : Instance := null;
-- Reference to the associated list
Nod : Node_Ptr := null;
Curr_Nod : Node_Ptr := null;
-- Reference to the current node being examined. The invariant of the
-- iterator requires that this field always points to a valid node. A
-- value of null indicates that the iterator is exhausted.
List : Instance := null;
-- Reference to the associated list
end record;
end Doubly_Linked_List;
......
gcc/ada/libgnat/g-sets.adb
......@@ -68,6 +68,16 @@ package body GNAT.Sets is
-- Destroy --
-------------
procedure Destroy (B : in out Boolean) is
pragma Unreferenced (B);
begin
null;
end Destroy;
-------------
-- Destroy --
-------------
procedure Destroy (S : in out Instance) is
begin
Hashed_Set.Destroy (Hashed_Set.Instance (S));
......@@ -118,6 +128,24 @@ package body GNAT.Sets is
Hashed_Set.Next (Hashed_Set.Iterator (Iter), Elem);
end Next;
-------------
-- Present --
-------------
function Present (S : Instance) return Boolean is
begin
return Hashed_Set.Present (Hashed_Set.Instance (S));
end Present;
-----------
-- Reset --
-----------
procedure Reset (S : Instance) is
begin
Hashed_Set.Reset (Hashed_Set.Instance (S));
end Reset;
----------
-- Size --
----------
......
gcc/ada/libgnat/g-sets.ads
......@@ -42,8 +42,8 @@ package GNAT.Sets is
-- The following package offers a membership set abstraction with the
-- following characteristics:
--
-- * Creation of multiple instances, of different sizes.
-- * Iterable elements.
-- * Creation of multiple instances, of different sizes
-- * Iterable elements
--
-- The following use pattern must be employed with this set:
--
......@@ -103,6 +103,14 @@ package GNAT.Sets is
function Is_Empty (S : Instance) return Boolean;
-- Determine whether set S is empty
function Present (S : Instance) return Boolean;
-- Determine whether set S exists
procedure Reset (S : Instance);
-- Destroy the contents of membership set S, and reset it to its initial
-- created state. This action will raise Iterated if the membership set
-- has outstanding iterators.
function Size (S : Instance) return Natural;
-- Obtain the number of elements in membership set S
......@@ -141,6 +149,9 @@ package GNAT.Sets is
-- raises Iterator_Exhausted.
private
procedure Destroy (B : in out Boolean);
-- Destroy boolean B
package Hashed_Set is new Dynamic_HTable
(Key_Type => Element_Type,
Value_Type => Boolean,
......@@ -150,6 +161,7 @@ package GNAT.Sets is
Compression_Threshold => 0.3,
Compression_Factor => 2,
"=" => "=",
Destroy_Value => Destroy,
Hash => Hash);
type Instance is new Hashed_Set.Instance;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment