1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT LIBRARY COMPONENTS                          --
4--                                                                          --
5--                 ADA.CONTAINERS.UNBOUNDED_PRIORITY_QUEUES                 --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--            Copyright (C) 2011-2018, 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
30package body Ada.Containers.Unbounded_Priority_Queues is
31
32   protected body Queue is
33
34      -----------------
35      -- Current_Use --
36      -----------------
37
38      function Current_Use return Count_Type is
39      begin
40         return Q_Elems.Length;
41      end Current_Use;
42
43      -------------
44      -- Dequeue --
45      -------------
46
47      entry Dequeue (Element : out Queue_Interfaces.Element_Type)
48        when Q_Elems.Length > 0
49      is
50         --  Grab the first item of the set, and remove it from the set
51
52         C : constant Cursor := First (Q_Elems);
53      begin
54         Element := Sets.Element (C).Item;
55         Delete_First (Q_Elems);
56      end Dequeue;
57
58      --------------------------------
59      -- Dequeue_Only_High_Priority --
60      --------------------------------
61
62      procedure Dequeue_Only_High_Priority
63        (At_Least : Queue_Priority;
64         Element  : in out Queue_Interfaces.Element_Type;
65         Success  : out Boolean)
66      is
67         --  Grab the first item. If it exists and has appropriate priority,
68         --  set Success to True, and remove that item. Otherwise, set Success
69         --  to False.
70
71         C : constant Cursor := First (Q_Elems);
72      begin
73         Success := Has_Element (C) and then
74            not Before (At_Least, Get_Priority (Sets.Element (C).Item));
75
76         if Success then
77            Element := Sets.Element (C).Item;
78            Delete_First (Q_Elems);
79         end if;
80      end Dequeue_Only_High_Priority;
81
82      -------------
83      -- Enqueue --
84      -------------
85
86      entry Enqueue (New_Item : Queue_Interfaces.Element_Type) when True is
87      begin
88         Insert (Q_Elems, (Next_Sequence_Number, New_Item));
89         Next_Sequence_Number := Next_Sequence_Number + 1;
90
91         --  If we reached a new high-water mark, increase Max_Length
92
93         if Q_Elems.Length > Max_Length then
94            pragma Assert (Max_Length + 1 = Q_Elems.Length);
95            Max_Length := Q_Elems.Length;
96         end if;
97      end Enqueue;
98
99      --------------
100      -- Peak_Use --
101      --------------
102
103      function Peak_Use return Count_Type is
104      begin
105         return Max_Length;
106      end Peak_Use;
107
108   end Queue;
109
110end Ada.Containers.Unbounded_Priority_Queues;
111