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 | with AAA.Containers.Indefinite_Holders;
with Ada.Containers.Indefinite_Doubly_Linked_Lists;
with Ada.Iterator_Interfaces;
generic
type Any_Element (<>) is private;
package Iterators.Root with Preelaborate is
subtype Elements is Any_Element;
-- Work around visibility bug.
----------------
-- References --
----------------
type Reference (Element : access Any_Element) is limited null record with
Implicit_Dereference => Element;
type Const_Ref (Element : access constant Any_Element) is limited null record with
Implicit_Dereference => Element;
------------
-- Cursor --
------------
type Cursor is tagged private;
function Has_Element (This : Cursor) return Boolean;
function Is_Empty (This : Cursor) return Boolean is (not This.Has_Element);
function Element (This : Cursor) return Any_Element;
function Get (This : Cursor) return Const_Ref;
function Ref (This : Cursor) return Reference;
function Val (This : Cursor) return Any_Element;
function New_Cursor (Element : aliased in out Any_Element) return Cursor;
function New_Const_Cursor (Element : aliased Any_Element) return Cursor;
function New_Empty_Cursor return Cursor;
package Ada_Iterator_Interfaces is new
Ada.Iterator_Interfaces (Cursor, Has_Element);
--------------
-- Iterator --
--------------
type Iterator is interface with
Constant_Indexing => Get_Const_Ref,
Variable_Indexing => Get_Var_Ref,
Default_Iterator => Iterate,
Iterator_Element => Any_Element;
function Next (This : in out Iterator) return Cursor'Class is abstract;
-- Get next element, if any
type Iterator_Reference (Ptr : access Iterator'Class) is limited null record
with Implicit_Dereference => Ptr;
----------
-- List --
----------
package Lists is new Ada.Containers.Indefinite_Doubly_Linked_Lists (Any_Element);
type List is new Lists.List with null record;
function Const_Iter (This : List) return Iterator'Class;
function Iter (This : List) return Iterator'Class;
------------------------
-- Standard Iteration --
------------------------
-- Support for "of" notation:
function Iterate (This : aliased Iterator'Class)
return Ada_Iterator_Interfaces.Forward_Iterator'Class;
function Get_Const_Ref (This : aliased Iterator'Class;
Pos : Cursor'Class) return Const_Ref;
function Get_Var_Ref (This : aliased in out Iterator'Class;
Pos : Cursor'Class) return Reference;
pragma Warnings (Off);
function Iter (This : aliased Iterator'Class)
return access Iterator'Class is
(new Iterator'Class'(This));
pragma Warnings (On);
-- Workaround to allow somewhat simple "of" iteration on sequences: you
-- can qualify the chain expression and take the Iter to have a RW copy.
-- "of", however, is buggy and using not the proper returned value.
-- This in turn forces to create a copy here and return it, causing a leak.
-- TODO: REMOVE LEAK, REPORT BUG, FIND ANOTHER WORKAROUND.
-----------
-- Debug --
-----------
procedure Print_Tag (This : Iterator) is null;
-- Declared abstract here so operators can redispatch across types
function Print_Tag (This : Iterator'Class) return Iterator'Class;
-------------
-- Holders --
-------------
package Holders is new AAA.Containers.Indefinite_Holders (Iterator'Class);
type Holder is new Holders.Holder with null record;
function As_Iterator (This : in out Holder) return Iterator_Reference;
package Elem_Holders is new AAA.Containers.Indefinite_Holders (Any_Element);
-- Used by some child packages.
private
type Element_Ptr is access all Any_Element;
type Element_Const_Ptr is access constant Any_Element;
type Cursor_Data (Read_Only : Boolean := False) is record
case Read_Only is
when True => Const_Ptr : Element_Const_Ptr;
when False => Ptr : Element_Ptr;
end case;
end record;
-- It seems having having constraints in the cursor makes things
-- innecessarily complicated for "of" notation, since we cannot
-- ensure that a cursor in the LHS has always the same constraints.
-- As tagged types cannot have discriminant defaults, this is a workaround.
type Cursor is tagged record
Data : Cursor_Data;
end record;
end Iterators.Root;
|