gcc/ada/a-cuprqu.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT LIBRARY COMPONENTS                          --
   4 --                                                                          --
   5 --                 ADA.CONTAINERS.UNBOUNDED_PRIORITY_QUEUES                 --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --            Copyright (C) 2011, Free Software Foundation, Inc.            --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- This unit was originally developed by Matthew J Heaney.                  --
  28 ------------------------------------------------------------------------------
  29
  30 with Ada.Unchecked_Deallocation;
  31
  32 package body Ada.Containers.Unbounded_Priority_Queues is
  33
  34    package body Implementation is
  35
  36       -----------------------
  37       -- Local Subprograms --
  38       -----------------------
  39
  40       procedure Free is
  41          new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
  42
  43       -------------
  44       -- Dequeue --
  45       -------------
  46
  47       procedure Dequeue
  48         (List    : in out List_Type;
  49          Element : out Queue_Interfaces.Element_Type)
  50       is
  51          X : Node_Access;
  52
  53       begin
  54          Element := List.First.Element;
  55
  56          X := List.First;
  57          List.First := List.First.Next;
  58
  59          if List.First = null then
  60             List.Last := null;
  61          end if;
  62
  63          List.Length := List.Length - 1;
  64
  65          Free (X);
  66       end Dequeue;
  67
  68       -------------
  69       -- Enqueue --
  70       -------------
  71
  72       procedure Enqueue
  73         (List     : in out List_Type;
  74          New_Item : Queue_Interfaces.Element_Type)
  75       is
  76          P : constant Queue_Priority := Get_Priority (New_Item);
  77
  78          Node : Node_Access;
  79          Prev : Node_Access;
  80
  81       begin
  82          Node := new Node_Type'(New_Item, null);
  83
  84          if List.First = null then
  85             List.First := Node;
  86             List.Last := List.First;
  87
  88          else
  89             Prev := List.First;
  90
  91             if Before (P, Get_Priority (Prev.Element)) then
  92                Node.Next := List.First;
  93                List.First := Node;
  94
  95             else
  96                while Prev.Next /= null loop
  97                   if Before (P, Get_Priority (Prev.Next.Element)) then
  98                      Node.Next := Prev.Next;
  99                      Prev.Next := Node;
 100
 101                      exit;
 102                   end if;
 103
 104                   Prev := Prev.Next;
 105                end loop;
 106
 107                if Prev.Next = null then
 108                   List.Last.Next := Node;
 109                   List.Last := Node;
 110                end if;
 111             end if;
 112          end if;
 113
 114          List.Length := List.Length + 1;
 115
 116          if List.Length > List.Max_Length then
 117             List.Max_Length := List.Length;
 118          end if;
 119       end Enqueue;
 120
 121       --------------
 122       -- Finalize --
 123       --------------
 124
 125       procedure Finalize (List : in out List_Type) is
 126          X : Node_Access;
 127       begin
 128          while List.First /= null loop
 129             X := List.First;
 130             List.First := List.First.Next;
 131             Free (X);
 132          end loop;
 133       end Finalize;
 134
 135       ------------------------
 136       -- Have_High_Priority --
 137       ------------------------
 138
 139       --  ???
 140       --  function Have_High_Priority
 141       --    (List         : List_Type;
 142       --     Low_Priority : Queue_Priority) return Boolean
 143       --  is
 144       --  begin
 145       --     if List.Length = 0 then
 146       --        return False;
 147       --     end if;
 148       --     return Before (Get_Priority (List.First.Element), Low_Priority);
 149       --  end Have_High_Priority;
 150
 151       ------------
 152       -- Length --
 153       ------------
 154
 155       function Length (List : List_Type) return Count_Type is
 156       begin
 157          return List.Length;
 158       end Length;
 159
 160       ----------------
 161       -- Max_Length --
 162       ----------------
 163
 164       function Max_Length (List : List_Type) return Count_Type is
 165       begin
 166          return List.Max_Length;
 167       end Max_Length;
 168
 169    end Implementation;
 170
 171    protected body Queue is
 172
 173       -----------------
 174       -- Current_Use --
 175       -----------------
 176
 177       function Current_Use return Count_Type is
 178       begin
 179          return List.Length;
 180       end Current_Use;
 181
 182       -------------
 183       -- Dequeue --
 184       -------------
 185
 186       entry Dequeue (Element : out Queue_Interfaces.Element_Type)
 187         when List.Length > 0
 188       is
 189       begin
 190          List.Dequeue (Element);
 191       end Dequeue;
 192
 193       --  ???
 194       --  entry Dequeue_Only_High_Priority
 195       --    (Low_Priority : Queue_Priority;
 196       --     Element      : out Queue_Interfaces.Element_Type) when True
 197       --  is
 198       --  begin
 199       --     null;
 200       --  end Dequeue_Only_High_Priority;
 201
 202       -------------
 203       -- Enqueue --
 204       -------------
 205
 206       entry Enqueue (New_Item : Queue_Interfaces.Element_Type) when True is
 207       begin
 208          List.Enqueue (New_Item);
 209       end Enqueue;
 210
 211       --------------
 212       -- Peak_Use --
 213       --------------
 214
 215       function Peak_Use return Count_Type is
 216       begin
 217          return List.Max_Length;
 218       end Peak_Use;
 219
 220    end Queue;
 221
 222 end Ada.Containers.Unbounded_Priority_Queues;