/src/yolk-cache-discrete_keys.adb
Ada | 306 lines | 174 code | 51 blank | 81 comment | 3 complexity | 407b4b4db231b45005b0ab7693c8422c MD5 | raw file
1------------------------------------------------------------------------------- 2-- -- 3-- Copyright (C) 2010-, Thomas Løcke -- 4-- -- 5-- This library is free software; you can redistribute it and/or modify -- 6-- it under terms of the GNU General Public License as published by the -- 7-- Free Software Foundation; either version 3, or (at your option) any -- 8-- later version. This library is distributed in the hope that it will be -- 9-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of -- 10-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 11-- -- 12-- As a special exception under Section 7 of GPL version 3, you are -- 13-- granted additional permissions described in the GCC Runtime Library -- 14-- Exception, version 3.1, as published by the Free Software Foundation. -- 15-- -- 16-- You should have received a copy of the GNU General Public License and -- 17-- a copy of the GCC Runtime Library Exception along with this program; -- 18-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 19-- <http://www.gnu.org/licenses/>. -- 20-- -- 21------------------------------------------------------------------------------- 22 23with Ada.Calendar; 24with Ada.Containers.Hashed_Maps; 25 26package body Yolk.Cache.Discrete_Keys is 27 28 use Ada.Containers; 29 30 type Element_Container is 31 record 32 Added_Timestamp : Ada.Calendar.Time; 33 Element : Element_Type; 34 end record; 35 36 function Equivalent_Keys 37 (Left : in Key_Type; 38 Right : in Key_Type) 39 return Boolean; 40 -- Used by the Element_Map to determine equivalence between values. 41 42 function Key_Hash 43 (Key : in Key_Type) 44 return Hash_Type; 45 -- Used by Element_Map to hash keys. 46 47 package Element_Map is new Hashed_Maps 48 (Key_Type => Key_Type, 49 Element_Type => Element_Container, 50 Hash => Key_Hash, 51 Equivalent_Keys => Equivalent_Keys); 52 53 Null_Container : Element_Container; 54 pragma Unmodified (Null_Container); 55 56 protected P_Element_List is 57 procedure Cleanup; 58 -- ???? 59 60 procedure Clear; 61 -- ???? 62 63 procedure Clear 64 (Key : in Key_Type); 65 -- ???? 66 67 function Is_Valid 68 (Key : in Key_Type) 69 return Boolean; 70 -- ???? 71 72 function Length 73 return Natural; 74 -- ???? 75 76 procedure Read 77 (Key : in Key_Type; 78 Valid : out Boolean; 79 Value : out Element_Type); 80 -- ???? 81 82 procedure Write 83 (Key : in Key_Type; 84 Value : in Element_Type); 85 -- ???? 86 private 87 Element_List : Element_Map.Map; 88 end P_Element_List; 89 90 ---------------------- 91 -- P_Element_List -- 92 ---------------------- 93 94 protected body P_Element_List is 95 --------------- 96 -- Cleanup -- 97 --------------- 98 99 procedure Cleanup 100 is 101 use Ada.Calendar; 102 use Element_Map; 103 104 Cursor : Element_Map.Cursor := Element_List.First; 105 Now : constant Time := Clock; 106 begin 107 while Has_Element (Cursor) loop 108 if (Now - Element (Cursor).Added_Timestamp) >= Max_Element_Age then 109 Element_List.Delete (Position => Cursor); 110 end if; 111 Next (Cursor); 112 end loop; 113 end Cleanup; 114 115 ------------- 116 -- Clear -- 117 ------------- 118 119 procedure Clear 120 is 121 begin 122 Element_List.Clear; 123 end Clear; 124 125 ------------- 126 -- Clear -- 127 ------------- 128 129 procedure Clear 130 (Key : in Key_Type) 131 is 132 begin 133 Element_List.Exclude (Key => Key); 134 end Clear; 135 136 ---------------- 137 -- Is_Valid - - 138 ---------------- 139 140 function Is_Valid 141 (Key : in Key_Type) 142 return Boolean 143 is 144 use Ada.Calendar; 145 begin 146 return (Element_List.Contains (Key => Key)) and then 147 (Clock - Element_List.Element (Key => Key).Added_Timestamp < 148 Max_Element_Age); 149 end Is_Valid; 150 151 -------------- 152 -- Length -- 153 -------------- 154 155 function Length 156 return Natural 157 is 158 begin 159 return Natural (Element_List.Length); 160 end Length; 161 162 ------------ 163 -- Read -- 164 ------------ 165 166 procedure Read 167 (Key : in Key_Type; 168 Valid : out Boolean; 169 Value : out Element_Type) 170 is 171 use Ada.Calendar; 172 begin 173 Valid := Is_Valid (Key => Key); 174 175 if Valid then 176 Value := Element_List.Element (Key => Key).Element; 177 else 178 Clear (Key => Key); 179 Value := Null_Container.Element; 180 end if; 181 end Read; 182 183 ------------- 184 -- Write -- 185 ------------- 186 187 procedure Write 188 (Key : in Key_Type; 189 Value : in Element_Type) 190 is 191 begin 192 Element_List.Include 193 (Key => Key, 194 New_Item => (Added_Timestamp => Ada.Calendar.Clock, 195 Element => Value)); 196 end Write; 197 end P_Element_List; 198 199 --------------- 200 -- Cleanup -- 201 --------------- 202 203 procedure Cleanup 204 is 205 begin 206 P_Element_List.Cleanup; 207 end Cleanup; 208 209 ------------- 210 -- Clear -- 211 ------------- 212 213 procedure Clear 214 is 215 begin 216 P_Element_List.Clear; 217 end Clear; 218 219 ------------- 220 -- Clear -- 221 ------------- 222 223 procedure Clear 224 (Key : in Key_Type) 225 is 226 begin 227 P_Element_List.Clear (Key => Key); 228 end Clear; 229 230 ----------------------- 231 -- Equivalent_Keys -- 232 ----------------------- 233 234 function Equivalent_Keys 235 (Left : in Key_Type; 236 Right : in Key_Type) 237 return Boolean 238 is 239 begin 240 return Left = Right; 241 end Equivalent_Keys; 242 243 ---------------- 244 -- Is_Valid -- 245 ---------------- 246 247 function Is_Valid 248 (Key : in Key_Type) 249 return Boolean 250 is 251 begin 252 return P_Element_List.Is_Valid (Key => Key); 253 end Is_Valid; 254 255 ---------------- 256 -- Key_Hash -- 257 ---------------- 258 259 function Key_Hash 260 (Key : in Key_Type) 261 return Hash_Type 262 is 263 begin 264 return Hash_Type (Key_Type'Pos (Key)); 265 end Key_Hash; 266 267 -------------- 268 -- Length -- 269 -------------- 270 271 function Length 272 return Natural 273 is 274 begin 275 return P_Element_List.Length; 276 end Length; 277 278 ------------ 279 -- Read -- 280 ------------ 281 282 procedure Read 283 (Key : in Key_Type; 284 Is_Valid : out Boolean; 285 Value : out Element_Type) 286 is 287 begin 288 P_Element_List.Read (Key => Key, 289 Valid => Is_Valid, 290 Value => Value); 291 end Read; 292 293 ------------- 294 -- Write -- 295 ------------- 296 297 procedure Write 298 (Key : in Key_Type; 299 Value : in Element_Type) 300 is 301 begin 302 P_Element_List.Write (Key => Key, 303 Value => Value); 304 end Write; 305 306end Yolk.Cache.Discrete_Keys;