1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280 | -- Abstract :
--
-- Generic unbounded red-black tree with definite elements, definite
-- or indefinite key.
--
-- Design:
--
-- We don't enforce any control of references active on a tree; that
-- proved buggy, slow, and not helpful in finding higher-level bugs.
-- The only real problem is references to a deleted node, which is
-- easy to keep track of.
--
-- References :
--
-- [1] Introduction to Algorithms, Thomas H. Cormen, Charles E.
-- Leiserson, Ronald L. Rivest, Clifford Stein.
--
-- Copyright (C) 2017 - 2021 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN-
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-- As a special exception under Section 7 of GPL version 3, you are granted
-- additional permissions described in the GCC Runtime Library Exception,
-- version 3.1, as published by the Free Software Foundation.
pragma License (Modified_GPL);
with Ada.Finalization;
with Ada.Iterator_Interfaces;
with Ada.Unchecked_Deallocation;
generic
type Element_Type is private;
-- Element_Type must have valid default initialization; one
-- non-initialized object of this type is declared, in Tree.Nil.
type Key_Type (<>) is private;
with function Key (Element : in Element_Type) return Key_Type is <>;
with function Key_Compare (Left, Right : in Key_Type) return Compare_Result is <>;
package SAL.Gen_Unbounded_Definite_Red_Black_Trees is
package Pkg renames Gen_Unbounded_Definite_Red_Black_Trees;
type Tree is new Ada.Finalization.Controlled with private
with
Constant_Indexing => Constant_Ref,
Variable_Indexing => Variable_Ref,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
overriding procedure Finalize (Object : in out Tree);
overriding procedure Initialize (Object : in out Tree);
overriding procedure Adjust (Object : in out Tree);
Empty_Tree : constant Tree;
procedure Clear (Tree : in out Pkg.Tree);
-- Set Tree to empty.
type Direction_Type is (Ascending, Descending, Unknown);
subtype Known_Direction_Type is Direction_Type range Ascending .. Descending;
-- Direction of Iterators.
-- If Ascending, Next may be called.
-- If Descending, Previous may be called.
-- If Unknown, neither.
type Cursor is private;
No_Element : constant Cursor;
function Has_Element (Cursor : in Pkg.Cursor) return Boolean;
function Direction (Cursor : in Pkg.Cursor) return Direction_Type;
function Key (Cursor : in Pkg.Cursor) return Key_Type;
function Element (Cursor : in Pkg.Cursor) return Element_Type;
type Constant_Reference_Type (Element : not null access constant Element_Type) is private with
Implicit_Dereference => Element;
function Constant_Ref
(Container : in Tree;
Position : in Cursor)
return Constant_Reference_Type
with Inline, Pre => Has_Element (Position);
function Constant_Ref
(Container : in Tree;
Key : in Key_Type)
return Constant_Reference_Type
with Inline;
-- Raises Not_Found if Key not found in Container.
type Variable_Reference_Type (Element : not null access Element_Type) is private with
Implicit_Dereference => Element;
-- User must not change value of Key thru this reference; if Key is
-- changed, use Delete, Insert.
function Variable_Ref
(Container : aliased in Tree;
Position : in Cursor)
return Variable_Reference_Type
with Inline, Pre => Has_Element (Position);
function Variable_Ref
(Container : aliased in Tree;
Key : in Key_Type)
return Variable_Reference_Type
with Inline;
-- Raises Not_Found if Key not found in Container.
function Unchecked_Const_Ref (Container : in Tree; Position : in Cursor) return access constant Element_Type;
function Unchecked_Var_Ref (Container : in Tree; Position : in Cursor) return access Element_Type;
-- For higher level containers.
package Iterators is new Ada.Iterator_Interfaces (Cursor, Has_Element);
type Iterator (Container : not null access constant Tree) is new Iterators.Reversible_Iterator with private;
function Iterate (Tree : aliased in Pkg.Tree'Class) return Iterator;
overriding function First (Iterator : in Pkg.Iterator) return Cursor;
overriding function Next (Iterator : in Pkg.Iterator; Position : in Cursor) return Cursor
with Pre => Has_Element (Position) and Direction (Position) /= Unknown;
overriding function Last (Iterator : in Pkg.Iterator) return Cursor;
overriding function Previous (Iterator : in Pkg.Iterator; Position : in Cursor) return Cursor
with Pre => Has_Element (Position) and Direction (Position) /= Unknown;
function Previous (Iterator : in Pkg.Iterator; Key : in Key_Type) return Cursor;
-- Initialise Iterator to descending, starting at element with
-- largest key < Key. Has_Element (result) is False if there is no
-- such element.
function Find
(Iterator : in Pkg.Iterator;
Key : in Key_Type;
Direction : in Direction_Type := Ascending)
return Cursor;
-- Has_Element is False if Key is not in Container.
function Find
(Container : in Tree;
Key : in Key_Type;
Direction : in Direction_Type := Ascending)
return Cursor;
-- Creates an Iterator internally.
function Find_In_Range
(Iterator : in Pkg.Iterator;
Direction : in Known_Direction_Type;
First, Last : in Key_Type)
return Cursor;
-- Find first element with key in range First .. Last. If Direction
-- is Ascending, start at First, otherwise start at Last.
--
-- Has_Element (result) is False if there is no such element.
--
-- The Iterator does not remember First, Last; the user must check
-- those for any element that Next or Previous returns.
function Count (Tree : in Pkg.Tree) return Ada.Containers.Count_Type;
function Length (Tree : in Pkg.Tree) return Ada.Containers.Count_Type
renames Count;
procedure Count_Depth
(Tree : in Pkg.Tree;
Count : out Ada.Containers.Count_Type;
Depth : out Ada.Containers.Count_Type);
-- Count and Count_Depth traverse the entire tree.
function Present (Container : in Tree; Key : in Key_Type) return Boolean;
procedure Insert
(Tree : in out Pkg.Tree;
Element : in Element_Type;
Duplicate : in Duplicate_Action_Type := Error);
function Insert
(Tree : in out Pkg.Tree;
Element : in Element_Type;
Duplicate : in Duplicate_Action_Type := Error)
return Cursor;
-- Result points to newly inserted element, with Direction Unknown.
--
-- If Key (Element) is found, and Duplicate is:
--
-- - Allow, Element is inserted; it can only by retrieved using
-- Iterate.
--
-- - Ignore, Element is not inserted.
--
-- - Error, raises Duplicate_Key.
function Find_Or_Insert
(Tree : in out Pkg.Tree;
Element : in Element_Type;
Found : out Boolean)
return Cursor;
-- Search for Element; if found, Found is True. If not found, insert
-- it. Return a Cursor to the found or inserted element. , and return
-- a cursor for it.
procedure Delete (Tree : in out Pkg.Tree; Key : in Key_Type);
-- Delete element with Key.
--
-- Raises SAL.Not_Found if Key is not found.
--
-- Invalidates any active iterators; not enforced.
private
type Node;
type Node_Access is access Node;
type Color is (Red, Black);
type Node is record
Element : aliased Element_Type;
Parent : Node_Access;
Left : Node_Access;
Right : Node_Access;
Color : Pkg.Color;
end record;
procedure Free is new Ada.Unchecked_Deallocation (Node, Node_Access);
type Tree is new Ada.Finalization.Controlled with record
Root : Node_Access;
Nil : Node_Access;
-- Nil is the node pointed to by all links that would otherwise be
-- 'null'. This simplifies several algorithms (for example,
-- Node.Left.Color is always valid). Its parent, left, right links
-- are used as temp storage for some algorithms (especially Delete).
-- Nil.Color is Black. Nil.Element is never accessed.
end record;
type Cursor is record
Node : Node_Access := null;
Direction : Direction_Type := Unknown;
-- Set in First or Last, enforced in next/prev (cannot change direction).
Left_Done : Boolean := True;
Right_Done : Boolean := True;
end record;
function Has_Element (Cursor : in Pkg.Cursor) return Boolean
is (Cursor.Node /= null);
function Direction (Cursor : in Pkg.Cursor) return Direction_Type
is (Cursor.Direction);
function Key (Cursor : in Pkg.Cursor) return Key_Type
is (Key (Cursor.Node.Element));
function Element (Cursor : in Pkg.Cursor) return Element_Type
is (Cursor.Node.Element);
type Constant_Reference_Type (Element : not null access constant Element_Type)
is record
Dummy : Integer := raise Program_Error with "uninitialized reference";
end record;
type Variable_Reference_Type (Element : not null access Element_Type)
is record
Dummy : Integer := raise Program_Error with "uninitialized reference";
end record;
Empty_Tree : constant Tree := (Ada.Finalization.Controlled with null, null);
No_Element : constant Cursor :=
(Node => null,
Direction => Unknown,
Left_Done => True,
Right_Done => True);
type Iterator (Container : not null access constant Tree) is new Iterators.Reversible_Iterator
with null record;
end SAL.Gen_Unbounded_Definite_Red_Black_Trees;
|