1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- G N A T . D Y N A M I C _ H T A B L E S --
9 -- Copyright (C) 2002-2018, AdaCore --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada
.Unchecked_Deallocation
;
34 package body GNAT
.Dynamic_HTables
is
40 package body Static_HTable
is
42 function Get_Non_Null
(T
: Instance
) return Elmt_Ptr
;
43 -- Returns Null_Ptr if Iterator_Started is False or if the Table is
44 -- empty. Returns Iterator_Ptr if non null, or the next non null
45 -- element in table if any.
51 function Get
(T
: Instance
; K
: Key
) return Elmt_Ptr
is
59 Elmt
:= T
.Table
(Hash
(K
));
62 if Elmt
= Null_Ptr
then
65 elsif Equal
(Get_Key
(Elmt
), K
) then
78 function Get_First
(T
: Instance
) return Elmt_Ptr
is
84 T
.Iterator_Started
:= True;
85 T
.Iterator_Index
:= T
.Table
'First;
86 T
.Iterator_Ptr
:= T
.Table
(T
.Iterator_Index
);
87 return Get_Non_Null
(T
);
94 function Get_Next
(T
: Instance
) return Elmt_Ptr
is
96 if T
= null or else not T
.Iterator_Started
then
100 T
.Iterator_Ptr
:= Next
(T
.Iterator_Ptr
);
101 return Get_Non_Null
(T
);
108 function Get_Non_Null
(T
: Instance
) return Elmt_Ptr
is
114 while T
.Iterator_Ptr
= Null_Ptr
loop
115 if T
.Iterator_Index
= T
.Table
'Last then
116 T
.Iterator_Started
:= False;
120 T
.Iterator_Index
:= T
.Iterator_Index
+ 1;
121 T
.Iterator_Ptr
:= T
.Table
(T
.Iterator_Index
);
124 return T
.Iterator_Ptr
;
131 procedure Remove
(T
: Instance
; K
: Key
) is
132 Index
: constant Header_Num
:= Hash
(K
);
134 Next_Elmt
: Elmt_Ptr
;
141 Elmt
:= T
.Table
(Index
);
143 if Elmt
= Null_Ptr
then
146 elsif Equal
(Get_Key
(Elmt
), K
) then
147 T
.Table
(Index
) := Next
(Elmt
);
151 Next_Elmt
:= Next
(Elmt
);
153 if Next_Elmt
= Null_Ptr
then
156 elsif Equal
(Get_Key
(Next_Elmt
), K
) then
157 Set_Next
(Elmt
, Next
(Next_Elmt
));
171 procedure Reset
(T
: in out Instance
) is
173 new Ada
.Unchecked_Deallocation
(Instance_Data
, Instance
);
180 for J
in T
.Table
'Range loop
181 T
.Table
(J
) := Null_Ptr
;
191 procedure Set
(T
: in out Instance
; E
: Elmt_Ptr
) is
196 T
:= new Instance_Data
;
199 Index
:= Hash
(Get_Key
(E
));
200 Set_Next
(E
, T
.Table
(Index
));
201 T
.Table
(Index
) := E
;
210 package body Simple_HTable
is
211 procedure Free
is new
212 Ada
.Unchecked_Deallocation
(Element_Wrapper
, Elmt_Ptr
);
218 function Get
(T
: Instance
; K
: Key
) return Element
is
226 Tmp
:= Tab
.Get
(Tab
.Instance
(T
), K
);
239 function Get_First
(T
: Instance
) return Element
is
240 Tmp
: constant Elmt_Ptr
:= Tab
.Get_First
(Tab
.Instance
(T
));
254 function Get_First_Key
(T
: Instance
) return Key_Option
is
255 Tmp
: constant Elmt_Ptr
:= Tab
.Get_First
(Tab
.Instance
(T
));
258 return Key_Option
'(Present => False);
260 return Key_Option'(Present
=> True, K
=> Tmp
.all.K
);
268 function Get_Key
(E
: Elmt_Ptr
) return Key
is
277 function Get_Next
(T
: Instance
) return Element
is
278 Tmp
: constant Elmt_Ptr
:= Tab
.Get_Next
(Tab
.Instance
(T
));
291 function Get_Next_Key
(T
: Instance
) return Key_Option
is
292 Tmp
: constant Elmt_Ptr
:= Tab
.Get_Next
(Tab
.Instance
(T
));
295 return Key_Option
'(Present => False);
297 return Key_Option'(Present
=> True, K
=> Tmp
.all.K
);
305 function Next
(E
: Elmt_Ptr
) return Elmt_Ptr
is
314 procedure Remove
(T
: Instance
; K
: Key
) is
318 Tmp
:= Tab
.Get
(Tab
.Instance
(T
), K
);
321 Tab
.Remove
(Tab
.Instance
(T
), K
);
330 procedure Reset
(T
: in out Instance
) is
334 E1
:= Tab
.Get_First
(Tab
.Instance
(T
));
335 while E1
/= null loop
336 E2
:= Tab
.Get_Next
(Tab
.Instance
(T
));
341 Tab
.Reset
(Tab
.Instance
(T
));
348 procedure Set
(T
: in out Instance
; K
: Key
; E
: Element
) is
349 Tmp
: constant Elmt_Ptr
:= Tab
.Get
(Tab
.Instance
(T
), K
);
352 Tab
.Set
(Tab
.Instance
(T
), new Element_Wrapper
'(K, E, null));
362 procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr) is
369 end GNAT.Dynamic_HTables;