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