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, 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          if List.Length = 0
  55            or else not Before (At_Least, Get_Priority (List.First_Element))
  56          then
  57             Success := False;
  58             return;
  59          end if;
  60
  61          List.Dequeue (Element);
  62          Success := True;
  63       end Dequeue;
  64
  65       -------------
  66       -- Enqueue --
  67       -------------
  68
  69       procedure Enqueue
  70         (List     : in out List_Type;
  71          New_Item : Queue_Interfaces.Element_Type)
  72       is
  73          P : constant Queue_Priority := Get_Priority (New_Item);
  74
  75          C : List_Types.Cursor;
  76          use List_Types;
  77
  78          Count : Count_Type;
  79
  80       begin
  81          C := List.Container.First;
  82          while Has_Element (C) loop
  83             --  ???
  84             --  if Before (P, Get_Priority (List.Constant_Reference (C))) then
  85             if Before (P, Get_Priority (Element (C))) then
  86                List.Container.Insert (C, New_Item);
  87                exit;
  88             end if;
  89
  90             Next (C);
  91          end loop;
  92
  93          if not Has_Element (C) then
  94             List.Container.Append (New_Item);
  95          end if;
  96
  97          Count := List.Container.Length;
  98
  99          if Count > List.Max_Length then
 100             List.Max_Length := Count;
 101          end if;
 102       end Enqueue;
 103
 104       -------------------
 105       -- First_Element --
 106       -------------------
 107
 108       function First_Element
 109         (List : List_Type) return Queue_Interfaces.Element_Type
 110       is
 111       begin
 112          --  Use Constant_Reference for this.  ???
 113          return List.Container.First_Element;
 114       end First_Element;
 115
 116       ------------
 117       -- Length --
 118       ------------
 119
 120       function Length (List : List_Type) return Count_Type is
 121       begin
 122          return List.Container.Length;
 123       end Length;
 124
 125       ----------------
 126       -- Max_Length --
 127       ----------------
 128
 129       function Max_Length (List : List_Type) return Count_Type is
 130       begin
 131          return List.Max_Length;
 132       end Max_Length;
 133
 134    end Implementation;
 135
 136    protected body Queue is
 137
 138       ------------------
 139       --  Current_Use --
 140       ------------------
 141
 142       function Current_Use return Count_Type is
 143       begin
 144          return List.Length;
 145       end Current_Use;
 146
 147       --------------
 148       --  Dequeue --
 149       --------------
 150
 151       entry Dequeue (Element : out Queue_Interfaces.Element_Type)
 152         when List.Length > 0
 153       is
 154       begin
 155          List.Dequeue (Element);
 156       end Dequeue;
 157
 158       --------------------------------
 159       -- Dequeue_Only_High_Priority --
 160       --------------------------------
 161
 162       procedure Dequeue_Only_High_Priority
 163         (At_Least : Queue_Priority;
 164          Element  : in out Queue_Interfaces.Element_Type;
 165          Success  : out Boolean)
 166       is
 167       begin
 168          List.Dequeue (At_Least, Element, Success);
 169       end Dequeue_Only_High_Priority;
 170
 171       --------------
 172       --  Enqueue --
 173       --------------
 174
 175       entry Enqueue (New_Item : Queue_Interfaces.Element_Type)
 176         when List.Length < Capacity
 177       is
 178       begin
 179          List.Enqueue (New_Item);
 180       end Enqueue;
 181
 182       ---------------
 183       --  Peak_Use --
 184       ---------------
 185
 186       function Peak_Use return Count_Type is
 187       begin
 188          return List.Max_Length;
 189       end Peak_Use;
 190
 191    end Queue;
 192
 193 end Ada.Containers.Bounded_Priority_Queues;