libgpr2_24.0.0_eda3c693/src/lib/gpr2-view_ids-dags.adb

--
--  Copyright (C) 2021-2023, AdaCore
--
--  SPDX-License-Identifier: Apache-2.0 WITH LLVM-Exception
--

with Ada.Containers.Vectors;

package body GPR2.View_Ids.DAGs is

   use type Ada.Containers.Count_Type;

   package Node_Vectors is new Ada.Containers.Vectors (Positive, Node_Id);
   subtype Node_Vector is Node_Vectors.Vector;

   package Node_Int_Maps is new Ada.Containers.Ordered_Maps (Node_Id, Natural);
   subtype Node_Int_Map is Node_Int_Maps.Map;

   function Allocate_Node
     (Self : in out DAG; Vertex : View_Id) return Node_Id;
   --  Return the Node_Id associated with a vertex name.

   function Min (List : Node_Sets.Set; Map : Node_Int_Map) return Node_Id;
   --  return the key that corresponds to the minimum value in the map

   function Shortest_Path
     (Self           : DAG;
      Source, Target : Node_Id) return View_Ids.Vector.Vector;

   procedure Update (Self  : in out Node_Node_Set_Maps.Map;
                     Key   : Node_Id;
                     Value : Node_Sets.Set);
   --  If Self contains Key then map Key to Value, otherwise map Key to the
   --  union of Value and previous mapping of Key.

   procedure Update
     (Self  : in out Node_Node_Set_Maps.Map;
      Key   : Node_Id;
      Value : Node_Id);
   --  Idem as previous function for the case only one Value should be
   --  inserted.

   ----------------
   -- Add_Vertex --
   ----------------

   procedure Add_Vertex
     (Self         : in out DAG;
      Vertex       : View_Id;
      Predecessors : View_Ids.Set.Set := View_Ids.Set.Empty_Set) is
   begin
      if Self.Contains (Vertex) then
         raise DAG_Error with
           "insert error: vertex " & String (Image (Vertex)) &
           " already exist";
      end if;

      Self.Update_Vertex
        (Vertex       => Vertex,
         Predecessors => Predecessors);
   end Add_Vertex;

   --------------------
   --  Allocate_Node --
   --------------------

   function Allocate_Node
     (Self : in out DAG; Vertex : View_Id) return Node_Id
   is
      use Name_Node_Maps;
      Node        : Node_Id;
      Name_Cursor : Cursor;
   begin
      --  Check if there is already a node called Vertex
      Name_Cursor := Self.Vertex_Names.Find (Vertex);

      if Name_Cursor = No_Element then
         --  If there is no node called Vertex allocate a node id and
         --  associate it with Vertex

         Node := Self.Next_Free_Node;
         pragma Assert (Self.Next_Free_Node < Node_Id'Last);
         Self.Next_Free_Node := Self.Next_Free_Node + 1;
         Self.Vertex_Names.Include (Vertex, Node);
         Self.Vertex_Ids.Include (Node, Vertex);
         Self.Predecessors.Include (Node, Node_Sets.Empty_Set);
         Self.Successors.Include (Node, Node_Sets.Empty_Set);
         Self.Cache_Valid := False;

      else
         --  A node id is already associated with Vertex

         Node := Element (Name_Cursor);
      end if;

      return Node;
   end Allocate_Node;

   ------------
   -- As_Dot --
   ------------

   function As_Dot (Self : DAG) return Unbounded_String
   is
      use Node_Node_Set_Maps;
      Result : Unbounded_String;

   begin
      Append (Result, "digraph G {" & ASCII.LF);
      Append (Result, "rankdir=""LR"";" & ASCII.LF);

      for Pred_Cursor in Self.Predecessors.Iterate loop
         Append (Result, """");
         Append
           (Result,
            String (Image (Self.Vertex_Ids.Element (Key (Pred_Cursor)))));
         Append (Result, """");
         Append (Result, ASCII.LF);

         if Element (Pred_Cursor).Length > 0 then
            for Pred of Element (Pred_Cursor) loop
               Append (Result, """");
               Append
                 (Result,
                  String
                    (Image (Self.Vertex_Ids.Element (Key (Pred_Cursor)))));

               Append (Result, """");
               Append (Result, " -> ");

               Append (Result, """");
               Append (Result,
                       String (Image (Self.Vertex_Ids.Element (Pred))));
               Append (Result, """" & ASCII.LF);
            end loop;
         end if;
      end loop;

      Append (Result, "}");

      return Result;
   end As_Dot;

   -----------
   -- Clear --
   -----------

   procedure Clear (Self : in out DAG)  is
   begin
      Self.Next_Free_Node := 1;
      Self.Predecessors.Clear;
      Self.Successors.Clear;
      Self.Vertex_Names.Clear;
      Self.Vertex_Ids.Clear;
      Self.Sort_Cache.Clear;
      Self.Cache_Valid := True;
   end Clear;

   --------------
   -- Contains --
   --------------

   function Contains (Self : DAG; Vertex : View_Id) return Boolean is
   begin
      return Self.Vertex_Names.Contains (Vertex);
   end Contains;

   ---------
   -- Min --
   ---------

   function Min (List : Node_Sets.Set; Map : Node_Int_Map) return Node_Id
   is
      Result : Node_Id;
      Value  : Integer := Integer'Last;
   begin
      for Key of List loop
         if Value > Map.Element (Key) then
            Value := Map.Element (Key);
            Result := Key;
         end if;
      end loop;

      return Result;
   end Min;

   ---------------------
   -- Shortest_Circle --
   ---------------------

   function Shortest_Circle (Self : DAG) return GPR2.View_Ids.Vector.Vector
   is
      Result : GPR2.View_Ids.Vector.Vector;
   begin
      if not Self.Has_Cycle then
         return GPR2.View_Ids.Vector.Empty_Vector;
      end if;

      for Id of Self.Vertex_Names loop
         Result := Shortest_Path (Self, Id, Id);
         if not Result.Is_Empty then
            return Result;
         end if;
      end loop;

      raise DAG_Error with "Has_Circularity set but no circularity found";
   end Shortest_Circle;

   -------------------
   -- Shortest_Path --
   -------------------

   function Shortest_Path
     (Self           : DAG;
      Source, Target : View_Id) return View_Ids.Vector.Vector
   is
   begin
      return Shortest_Path (Self,
                            Self.Vertex_Names.Element (Source),
                            Self.Vertex_Names.Element (Target));
   end Shortest_Path;

   function Shortest_Path
     (Self           : DAG;
      Source, Target : Node_Id) return View_Ids.Vector.Vector
   is
      Infinite    : constant Natural := Natural (Self.Vertex_Ids.Length) + 1;
      --  Maximum distance between two vertices is the number of nodes in the
      --  DAG - 1, unless Source and Target are equal in which case the
      --  maximum possible distance is the number of nodes. So infinity is
      --  Length (Nodes) + 1.

      Dist        : Node_Int_Map;
      --  This map will keep track of minimal distance between vertices and the
      --  source.

      Prev        : Node_Node_Maps.Map;
      --  This keeps track of the minimum distance

      Non_Visited : Node_Sets.Set;
      --  Non visited nodes

      T_Id        : Node_Id renames Target;
      S_Id        : Node_Id := Source;

      U, V        : Node_Id;
      Alt         : Natural;
      Result      : View_Ids.Vector.Vector;

   begin
      --  We use the Dijkstra algorithm to compute the shortest path.
      --  Note that this is a slight variation so that the algorithm
      --  can be used to compute shortest cycle on a given node.

      --  Initialize Dist:

      for Id of Self.Vertex_Names loop
         if Id = T_Id then
            --  Only known distance at startup
            Dist.Insert (Id, 0);
         else
            Dist.Insert (Id, Infinite);
         end if;
      end loop;

      --  Initialize Prev:

      for Id of Self.Vertex_Names loop
         Prev.Insert (Id, Undefined);
      end loop;

      for Id of Self.Vertex_Names loop
         Non_Visited.Insert (Id);
      end loop;

      if S_Id = T_Id then
         --  If Source is equal to target, default Dijkstra algorithm does
         --  not work. Add a fake node and use it as target. When iterating
         --  on predecessors, replace all occurrences of sources to that node.
         --  If we find a path between that node and the source, it means we
         --  have our shortest cycle.
         Dist.Insert (Undefined, Infinite);
         Prev.Insert (Undefined, Undefined);
         Non_Visited.Insert (Undefined);
         S_Id := Undefined;
      end if;

      while not Non_Visited.Is_Empty loop
         U := Min (Non_Visited, Dist);
         Non_Visited.Delete (U);

         if U = S_Id then
            --  We found the shortest path
            exit;

         elsif U /= Undefined then
            for U_Pred of Self.Predecessors.Element (U) loop
               if S_Id = Undefined and then U_Pred = T_Id then
                  --  Handle cycle detection case

                  V := Undefined;
               else
                  V := U_Pred;
               end if;

               Alt := Dist.Element (U) + 1;

               if Alt < Dist.Element (V) then
                  Dist.Replace (V, Alt);
                  Prev.Replace (V, U);
               end if;
            end loop;
         end if;
      end loop;

      if Dist.Element (S_Id) = Infinite then
         --  No path between source and target

         return View_Ids.Vector.Empty_Vector;
      end if;

      U := S_Id;
      Result.Append (Self.Vertex_Ids (Source));
      while Prev.Element (U) /= Undefined loop
         U := Prev.Element (U);
         Result.Append (Self.Vertex_Ids.Element (U));
      end loop;

      return Result;
   end Shortest_Path;

   ----------------------
   -- Topological_Sort --
   ----------------------

   function Topological_Sort (Self : DAG) return View_Ids.Vector.Vector
   is
   begin
      return Self.Sort_Cache;
   end Topological_Sort;

   ------------
   -- Update --
   ------------

   procedure Update
     (Self        : in out DAG;
      Circularity :    out Boolean)
   is
      Non_Visited       : Node_Int_Map;
      Result_Nodes      : Node_Vector;
      use Node_Node_Set_Maps;

   begin
      if Self.Cache_Valid then
         Circularity := Self.Has_Cycle;

         return;
      end if;

      Self.Sort_Cache.Clear;
      Self.Has_Cycle := False;

      --  First compute set of non visited nodes and the number of
      --  predecessors that should be visited first.

      for Cursor in Self.Predecessors.Iterate loop
         Non_Visited.Include (Key (Cursor),
                              Natural (Element (Cursor).Length));
      end loop;

      while not Non_Visited.Is_Empty loop
         declare
            Visited_Nodes : Node_Sets.Set;
            Excluded      : Boolean := False;

         begin
            --  Add nodes that have no more predecessors to visit

            for Cursor in Non_Visited.Iterate loop
               if Node_Int_Maps.Element (Cursor) = 0 then
                  Visited_Nodes.Include (Node_Int_Maps.Key (Cursor));
                  Result_Nodes.Append (Node_Int_Maps.Key (Cursor));
               end if;
            end loop;

            --  Remove visited from non_visited

            for Visited_Node of Visited_Nodes loop
               Non_Visited.Exclude (Visited_Node);
               Excluded := True;
            end loop;

            --  Update number of predecessors that should be visited
            --  for remaining nodes

            for Visited_Node of Visited_Nodes loop
               for Successor of Self.Successors (Visited_Node) loop
                  Non_Visited.Include
                    (Successor, Non_Visited.Element (Successor) - 1);
               end loop;
            end loop;

            if not Excluded then
               --  Non_Visited is not empty and no more nodes to remove:
               --  no leaf node, so there's some circular dependency.

               Self.Has_Cycle := True;

               exit;
            end if;
         end;
      end loop;

      if not Self.Has_Cycle then
         for Node of Result_Nodes loop
            Self.Sort_Cache.Append (Self.Vertex_Ids.Element (Node));
         end loop;
      end if;

      --  Do not re-compute unless we add/modify vertices
      Self.Cache_Valid := True;
      Circularity      := Self.Has_Cycle;
   end Update;

   procedure Update
     (Self  : in out Node_Node_Set_Maps.Map;
      Key   : Node_Id;
      Value : Node_Sets.Set)
   is
      use Node_Node_Set_Maps;
      Pred_Cursor : Cursor;
      Final_Value : Node_Sets.Set;
   begin
      Final_Value.Union (Value);

      Pred_Cursor := Self.Find (Key);

      if Pred_Cursor /= No_Element then
         Final_Value.Union (Element (Pred_Cursor));
      end if;

      Self.Include (Key, Final_Value);
   end Update;

   procedure Update
     (Self  : in out Node_Node_Set_Maps.Map;
      Key   : Node_Id;
      Value : Node_Id)
   is
      use Node_Node_Set_Maps;
      Pred_Cursor : Cursor;
      Final_Value : Node_Sets.Set;
   begin
      Final_Value.Include (Value);

      Pred_Cursor := Self.Find (Key);

      if Pred_Cursor /= No_Element then
         Final_Value.Union (Element (Pred_Cursor));
      end if;

      Self.Include (Key, Final_Value);
   end Update;

   -------------------
   -- Update_Vertex --
   -------------------

   procedure Update_Vertex
     (Self         : in out DAG;
      Vertex       : View_Id;
      Predecessors : View_Ids.Set.Set := View_Ids.Set.Empty_Set)
   is
      Node : Node_Id;
   begin
      Node := Self.Allocate_Node (Vertex);

      declare
         Pred_Nodes : Node_Sets.Set;
      begin

         --  Compute the corresponding list of nodes

         for Vertex_Name of Predecessors loop
            Pred_Nodes.Include (Self.Allocate_Node (Vertex_Name));
         end loop;

         --  Update predecessors

         Update (Self.Predecessors, Node, Pred_Nodes);

         --  Update successors

         for Pred_Node of Pred_Nodes loop
            Update (Self.Successors, Pred_Node, Node);
         end loop;

         Self.Cache_Valid := False;
      end;
   end Update_Vertex;

   procedure Update_Vertex
     (Self        : in out DAG;
      Vertex      : View_Id;
      Predecessor : View_Id)
   is
      Predecessors : View_Ids.Set.Set;
   begin
      Predecessors.Include (Predecessor);
      Self.Update_Vertex (Vertex, Predecessors);
   end Update_Vertex;

end GPR2.View_Ids.DAGs;