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 | -- Abstract:
--
-- Stack implementation.
--
-- Copyright (C) 1998-2000, 2002-2003, 2009, 2015, 2017 - 2021 Free Software Foundation, Inc.
--
-- SAL 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. SAL is distributed in the hope that it will be
-- useful, but WITHOUT ANY WARRANTY; without even the implied
-- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-- See the GNU General Public License for more details. You should
-- have received a copy of the GNU General Public License distributed
-- with SAL; see file COPYING. If not, write to the Free Software
-- Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
-- USA.
--
-- 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;
package SAL.Gen_Unbounded_Definite_Stacks is
package Sguds renames SAL.Gen_Unbounded_Definite_Stacks;
type Stack is new Ada.Finalization.Controlled with private
with
Constant_Indexing => Constant_Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type;
Empty_Stack : constant Stack;
overriding procedure Finalize (Stack : in out Sguds.Stack);
overriding procedure Adjust (Stack : in out Sguds.Stack);
overriding function "=" (Left, Right : in Sguds.Stack) return Boolean;
function Depth (Stack : in Sguds.Stack) return Base_Peek_Type;
-- Returns current count of items in the Stack
procedure Clear (Stack : in out Sguds.Stack)
with Post => Stack.Depth = 0;
-- Empty Stack of all items.
function Is_Empty (Stack : in Sguds.Stack) return Boolean;
-- Returns true iff no items are in Stack.
function Peek
(Stack : in Sguds.Stack;
Index : in Peek_Type := 1)
return Element_Type
with Inline,
Pre => Stack.Depth >= Index;
-- Return the Index'th item from the top of Stack; the Item is _not_ removed.
-- Top item has index 1.
--
-- Raises Constraint_Error if Index > Depth.
--
-- See also Constant_Ref, implicit indexing
procedure Pop (Stack : in out Sguds.Stack; Count : in Base_Peek_Type := 1)
with Pre => Stack.Depth >= Count;
-- Remove Count Items from the top of Stack, discard them.
--
-- Raises Container_Empty if there are fewer than Count items on
-- Stack.
function Pop (Stack : in out Sguds.Stack) return Element_Type
with Pre => Stack.Depth >= 1;
-- Remove Item from the top of Stack, and return it.
--
-- Raises Container_Empty if Is_Empty.
procedure Push (Stack : in out Sguds.Stack; Item : in Element_Type);
-- Add Item to the top of Stack.
--
-- May raise Container_Full.
function Top (Stack : in Sguds.Stack) return Element_Type
with Pre => Stack.Depth >= 1;
-- Return the item at the top of Stack; the Item is _not_ removed.
-- Same as Peek (Stack, 1).
--
-- Raises Container_Empty if Is_Empty.
procedure Bottom_Pop (Stack : in out Sguds.Stack)
with Pre => Stack.Depth >= 1;
-- Remove one item from the bottom of the stack (element
-- Stack.Depth), discard it.
procedure Set_Depth
(Stack : in out Sguds.Stack;
Depth : in Peek_Type);
-- Empty Stack, set its Depth to Depth. Must be followed by Set
-- for each element.
--
-- Useful when creating a stack from pre-existing data.
procedure Set
(Stack : in out Sguds.Stack;
Index : in Peek_Type;
Depth : in Peek_Type;
Element : in Element_Type);
-- Set a Stack element. Index is the same as Peek Index; Depth is
-- used to compute the index in the underlying array.
--
-- Stack must have been initialized by Set_Depth.
--
-- Useful when creating a stack from pre-existing data.
function Invert (Stack : in Sguds.Stack) return Sguds.Stack;
-- Return a new stack with the same elements as Stack, in inverted order.
procedure Copy_Slice
(Source : in Stack;
Target : in out Stack;
Source_Start_Depth : in Peek_Type;
Target_Start_Depth : in Peek_Type;
Count : in Peek_Type);
-- Copy elements Source.Peek (Source_Start_Depth) .. Source.Peek
-- (Source_Start_Depth - Count + 1) to Target (Target_Start_Depth) ..
-- Target (Target_Start_Depth - Count + 1), overwriting existing
-- Target elements.
type Constant_Reference_Type (Element : not null access constant Element_Type) is private with
Implicit_Dereference => Element;
function Constant_Reference
(Container : aliased in Stack'Class;
Position : in Peek_Type)
return Constant_Reference_Type
with Inline, Pre => Position in 1 .. Container.Depth;
type Cursor is private;
function Constant_Reference
(Container : aliased in Stack'Class;
Position : in Cursor)
return Constant_Reference_Type
with Inline, Pre => Has_Element (Position);
function Has_Element (Position : in Cursor) return Boolean;
package Iterator_Interfaces is new Ada.Iterator_Interfaces (Cursor, Has_Element);
function Iterate (Container : aliased in Stack) return Iterator_Interfaces.Forward_Iterator'Class;
private
type Element_Array is array (Peek_Type range <>) of aliased Element_Type;
type Element_Array_Access is access Element_Array;
procedure Free is new Ada.Unchecked_Deallocation (Element_Array, Element_Array_Access);
type Stack is new Ada.Finalization.Controlled with record
Top : Base_Peek_Type := Invalid_Peek_Index; -- empty
Data : Element_Array_Access;
-- Top of stack is at Data (Top); bottom at Data (1).
-- Data (1 .. Top) has been set at some point.
end record;
type Constant_Reference_Type (Element : not null access constant Element_Type) is
record
Dummy : Integer := raise Program_Error with "uninitialized reference";
end record;
Empty_Stack : constant Stack := (Ada.Finalization.Controlled with Invalid_Peek_Index, null);
type Cursor is record
Ptr : Base_Peek_Type := Invalid_Peek_Index;
end record;
end SAL.Gen_Unbounded_Definite_Stacks;
|