gcc/ada/a-cbprqu.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT LIBRARY COMPONENTS                          --
   4 --                                                                          --
   5 --                  ADA.CONTAINERS.BOUNDED_PRIORITY_QUEUES                  --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --            Copyright (C) 2011-2015, 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 package body Ada.Containers.Bounded_Priority_Queues is
  31
  32    package body Implementation is
  33
  34       -------------
  35       -- Dequeue --
  36       -------------
  37
  38       procedure Dequeue
  39         (List    : in out List_Type;
  40          Element : out Queue_Interfaces.Element_Type)
  41       is
  42       begin
  43          Element := List.Container.First_Element;
  44          List.Container.Delete_First;
  45       end Dequeue;
  46
  47       procedure Dequeue
  48         (List     : in out List_Type;
  49          At_Least : Queue_Priority;
  50          Element  : in out Queue_Interfaces.Element_Type;
  51          Success  : out Boolean)
  52       is
  53       begin
  54          --  This operation dequeues a high priority item if it exists in the
  55          --  queue. By "high priority" we mean an item whose priority is equal
  56          --  or greater than the value At_Least. The generic formal operation
  57          --  Before has the meaning "has higher priority than". To dequeue an
  58          --  item (meaning that we return True as our Success value), we need
  59          --  as our predicate the equivalent of "has equal or higher priority
  60          --  than", but we cannot say that directly, so we require some logical
  61          --  gymnastics to make it so.
  62
  63          --  If E is the element at the head of the queue, and symbol ">"
  64          --  refers to the "is higher priority than" function Before, then we
  65          --  derive our predicate as follows:
  66
  67          --    original: P(E) >= At_Least
  68          --    same as:  not (P(E) < At_Least)
  69          --    same as:  not (At_Least > P(E))
  70          --    same as:  not Before (At_Least, P(E))
  71
  72          --  But that predicate needs to be true in order to successfully
  73          --  dequeue an item. If it's false, it means no item is dequeued, and
  74          --  we return False as the Success value.
  75
  76          if List.Length = 0
  77            or else Before (At_Least,
  78                            Get_Priority (List.Container.First_Element))
  79          then
  80             Success := False;
  81             return;
  82          end if;
  83
  84          List.Dequeue (Element);
  85          Success := True;
  86       end Dequeue;
  87
  88       -------------
  89       -- Enqueue --
  90       -------------
  91
  92       procedure Enqueue
  93         (List     : in out List_Type;
  94          New_Item : Queue_Interfaces.Element_Type)
  95       is
  96          P : constant Queue_Priority := Get_Priority (New_Item);
  97
  98          C : List_Types.Cursor;
  99          use List_Types;
 100
 101          Count : Count_Type;
 102
 103       begin
 104          C := List.Container.First;
 105          while Has_Element (C) loop
 106
 107             --  ??? why is following commented out ???
 108             --  if Before (P, Get_Priority (List.Constant_Reference (C))) then
 109
 110             if Before (P, Get_Priority (Element (C))) then
 111                List.Container.Insert (C, New_Item);
 112                exit;
 113             end if;
 114
 115             Next (C);
 116          end loop;
 117
 118          if not Has_Element (C) then
 119             List.Container.Append (New_Item);
 120          end if;
 121
 122          Count := List.Container.Length;
 123
 124          if Count > List.Max_Length then
 125             List.Max_Length := Count;
 126          end if;
 127       end Enqueue;
 128
 129       -------------------
 130       -- First_Element --
 131       -------------------
 132
 133       function First_Element
 134         (List : List_Type) return Queue_Interfaces.Element_Type
 135       is
 136       begin
 137
 138          --  Use Constant_Reference for this.  ???
 139
 140          return List.Container.First_Element;
 141       end First_Element;
 142
 143       ------------
 144       -- Length --
 145       ------------
 146
 147       function Length (List : List_Type) return Count_Type is
 148       begin
 149          return List.Container.Length;
 150       end Length;
 151
 152       ----------------
 153       -- Max_Length --
 154       ----------------
 155
 156       function Max_Length (List : List_Type) return Count_Type is
 157       begin
 158          return List.Max_Length;
 159       end Max_Length;
 160
 161    end Implementation;
 162
 163    protected body Queue is
 164
 165       ------------------
 166       --  Current_Use --
 167       ------------------
 168
 169       function Current_Use return Count_Type is
 170       begin
 171          return List.Length;
 172       end Current_Use;
 173
 174       --------------
 175       --  Dequeue --
 176       --------------
 177
 178       entry Dequeue (Element : out Queue_Interfaces.Element_Type)
 179         when List.Length > 0
 180       is
 181       begin
 182          List.Dequeue (Element);
 183       end Dequeue;
 184
 185       --------------------------------
 186       -- Dequeue_Only_High_Priority --
 187       --------------------------------
 188
 189       procedure Dequeue_Only_High_Priority
 190         (At_Least : Queue_Priority;
 191          Element  : in out Queue_Interfaces.Element_Type;
 192          Success  : out Boolean)
 193       is
 194       begin
 195          List.Dequeue (At_Least, Element, Success);
 196       end Dequeue_Only_High_Priority;
 197
 198       --------------
 199       --  Enqueue --
 200       --------------
 201
 202       entry Enqueue (New_Item : Queue_Interfaces.Element_Type)
 203         when List.Length < Capacity
 204       is
 205       begin
 206          List.Enqueue (New_Item);
 207       end Enqueue;
 208
 209       ---------------
 210       --  Peak_Use --
 211       ---------------
 212
 213       function Peak_Use return Count_Type is
 214       begin
 215          return List.Max_Length;
 216       end Peak_Use;
 217
 218    end Queue;
 219
 220 end Ada.Containers.Bounded_Priority_Queues;