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 30with Ada.Unchecked_Deallocation; 31 32package 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 procedure Dequeue 69 (List : in out List_Type; 70 At_Least : Queue_Priority; 71 Element : in out Queue_Interfaces.Element_Type; 72 Success : out Boolean) 73 is 74 begin 75 -- This operation dequeues a high priority item if it exists in the 76 -- queue. By "high priority" we mean an item whose priority is equal 77 -- or greater than the value At_Least. The generic formal operation 78 -- Before has the meaning "has higher priority than". To dequeue an 79 -- item (meaning that we return True as our Success value), we need 80 -- as our predicate the equivalent of "has equal or higher priority 81 -- than", but we cannot say that directly, so we require some logical 82 -- gymnastics to make it so. 83 84 -- If E is the element at the head of the queue, and symbol ">" 85 -- refers to the "is higher priority than" function Before, then we 86 -- derive our predicate as follows: 87 -- original: P(E) >= At_Least 88 -- same as: not (P(E) < At_Least) 89 -- same as: not (At_Least > P(E)) 90 -- same as: not Before (At_Least, P(E)) 91 92 -- But that predicate needs to be true in order to successfully 93 -- dequeue an item. If it's false, it means no item is dequeued, and 94 -- we return False as the Success value. 95 96 if List.Length = 0 97 or else Before (At_Least, Get_Priority (List.First.Element)) 98 then 99 Success := False; 100 return; 101 end if; 102 103 List.Dequeue (Element); 104 Success := True; 105 end Dequeue; 106 107 ------------- 108 -- Enqueue -- 109 ------------- 110 111 procedure Enqueue 112 (List : in out List_Type; 113 New_Item : Queue_Interfaces.Element_Type) 114 is 115 P : constant Queue_Priority := Get_Priority (New_Item); 116 117 Node : Node_Access; 118 Prev : Node_Access; 119 120 begin 121 Node := new Node_Type'(New_Item, null); 122 123 if List.First = null then 124 List.First := Node; 125 List.Last := List.First; 126 127 else 128 Prev := List.First; 129 130 if Before (P, Get_Priority (Prev.Element)) then 131 Node.Next := List.First; 132 List.First := Node; 133 134 else 135 while Prev.Next /= null loop 136 if Before (P, Get_Priority (Prev.Next.Element)) then 137 Node.Next := Prev.Next; 138 Prev.Next := Node; 139 140 exit; 141 end if; 142 143 Prev := Prev.Next; 144 end loop; 145 146 if Prev.Next = null then 147 List.Last.Next := Node; 148 List.Last := Node; 149 end if; 150 end if; 151 end if; 152 153 List.Length := List.Length + 1; 154 155 if List.Length > List.Max_Length then 156 List.Max_Length := List.Length; 157 end if; 158 end Enqueue; 159 160 -------------- 161 -- Finalize -- 162 -------------- 163 164 procedure Finalize (List : in out List_Type) is 165 X : Node_Access; 166 begin 167 while List.First /= null loop 168 X := List.First; 169 List.First := List.First.Next; 170 Free (X); 171 end loop; 172 end Finalize; 173 174 ------------ 175 -- Length -- 176 ------------ 177 178 function Length (List : List_Type) return Count_Type is 179 begin 180 return List.Length; 181 end Length; 182 183 ---------------- 184 -- Max_Length -- 185 ---------------- 186 187 function Max_Length (List : List_Type) return Count_Type is 188 begin 189 return List.Max_Length; 190 end Max_Length; 191 192 end Implementation; 193 194 protected body Queue is 195 196 ----------------- 197 -- Current_Use -- 198 ----------------- 199 200 function Current_Use return Count_Type is 201 begin 202 return List.Length; 203 end Current_Use; 204 205 ------------- 206 -- Dequeue -- 207 ------------- 208 209 entry Dequeue (Element : out Queue_Interfaces.Element_Type) 210 when List.Length > 0 211 is 212 begin 213 List.Dequeue (Element); 214 end Dequeue; 215 216 -------------------------------- 217 -- Dequeue_Only_High_Priority -- 218 -------------------------------- 219 220 procedure Dequeue_Only_High_Priority 221 (At_Least : Queue_Priority; 222 Element : in out Queue_Interfaces.Element_Type; 223 Success : out Boolean) 224 is 225 begin 226 List.Dequeue (At_Least, Element, Success); 227 end Dequeue_Only_High_Priority; 228 229 ------------- 230 -- Enqueue -- 231 ------------- 232 233 entry Enqueue (New_Item : Queue_Interfaces.Element_Type) when True is 234 begin 235 List.Enqueue (New_Item); 236 end Enqueue; 237 238 -------------- 239 -- Peak_Use -- 240 -------------- 241 242 function Peak_Use return Count_Type is 243 begin 244 return List.Max_Length; 245 end Peak_Use; 246 247 end Queue; 248 249end Ada.Containers.Unbounded_Priority_Queues; 250