~ubuntu-branches/debian/stretch/adabrowse/stretch

« back to all changes in this revision

Viewing changes to gal-containers-simple.ads

  • Committer: Bazaar Package Importer
  • Author(s): Ludovic Brenta
  • Date: 2004-02-14 13:22:40 UTC
  • Revision ID: james.westby@ubuntu.com-20040214132240-cqumhiq1677pkvzo
Tags: upstream-4.0.2
ImportĀ upstreamĀ versionĀ 4.0.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
-------------------------------------------------------------------------------
 
2
--
 
3
-- <STRONG>Copyright (c) 2001-2003 by Thomas Wolf.</STRONG>
 
4
-- <BLOCKQUOTE>
 
5
--    This piece of software is free software; you can redistribute it and/or
 
6
--    modify it under the terms of the  GNU General Public License as published
 
7
--    by the Free Software  Foundation; either version 2, or (at your option)
 
8
--    any later version. This unit is distributed in the hope that it will be
 
9
--    useful, but <EM>without any warranty</EM>; without even the implied
 
10
--    warranty of <EM>merchantability or fitness for a particular purpose.</EM>
 
11
--    See the GNU General Public License for  more details. You should have
 
12
--    received a copy of the GNU General Public License with this distribution,
 
13
--    see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
 
14
--    Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
 
15
--    USA.
 
16
-- </BLOCKQUOTE>
 
17
-- <BLOCKQUOTE>
 
18
--   As a special exception from the GPL, if other files instantiate generics
 
19
--   from this unit, or you link this unit with other files to produce an
 
20
--   executable, this unit does not by itself cause the resulting executable
 
21
--   to be covered by the GPL. This exception does not however invalidate any
 
22
--   other reasons why the executable file might be covered by the GPL.
 
23
-- </BLOCKQUOTE>
 
24
--
 
25
-- <DL><DT><STRONG>
 
26
-- Author:</STRONG><DD>
 
27
--   Thomas Wolf  (TW)
 
28
--   <ADDRESS><A HREF="mailto:twolf@acm.org">twolf@acm.org</A></ADDRESS></DL>
 
29
--
 
30
-- <DL><DT><STRONG>
 
31
-- Purpose:</STRONG><DD>
 
32
--   Simple dynamic container, implemented as a very simple singly linked list.
 
33
--   Only operations are adding items, sorting, and finally traversing. It's
 
34
--   truly simple, but captures a very common case.
 
35
--   </DL>
 
36
--
 
37
-- <DL><DT><STRONG>
 
38
-- Tasking semantics:</STRONG><DD>
 
39
--   N/A. Not abortion-safe.</DL>
 
40
--
 
41
-- <DL><DT><STRONG>
 
42
-- Storage semantics:</STRONG><DD>
 
43
--   Dynamic storage allocation in a user-supplied storage pool.</DL>
 
44
--
 
45
-- <!--
 
46
-- Revision History
 
47
--
 
48
--   16-JUN-2003   TW  Initial version.
 
49
-- -->
 
50
-------------------------------------------------------------------------------
 
51
 
 
52
pragma License (Modified_GPL);
 
53
 
 
54
with Ada.Finalization;
 
55
with Ada.Streams;
 
56
 
 
57
with GAL.Storage.Memory;
 
58
 
 
59
generic
 
60
   type Item is private;
 
61
 
 
62
   with package Memory is new GAL.Storage.Memory (<>);
 
63
 
 
64
package GAL.Containers.Simple is
 
65
 
 
66
   pragma Elaborate_Body;
 
67
 
 
68
   type Simple_Container is private;
 
69
 
 
70
   Null_Container : constant Simple_Container;
 
71
 
 
72
   procedure Swap
 
73
     (Left, Right : in out Simple_Container);
 
74
 
 
75
   function Nof_Elements
 
76
     (Container : in Simple_Container)
 
77
     return Natural;
 
78
 
 
79
   function Is_Empty
 
80
     (Container : in Simple_Container)
 
81
     return Boolean;
 
82
 
 
83
   procedure Add
 
84
     (What : in     Item;
 
85
      To   : in out Simple_Container);
 
86
 
 
87
   procedure Reset
 
88
     (Container : in out Simple_Container);
 
89
 
 
90
   type Visitor is abstract tagged private;
 
91
 
 
92
   procedure Execute
 
93
     (V     : in out Visitor;
 
94
      Value : in out Item;
 
95
      Quit  : in out Boolean)
 
96
     is abstract;
 
97
   --  'Quit' is False upon entry; traversal continues until either all items
 
98
   --  in the hash table have been processed or 'Quit' is set to True.
 
99
 
 
100
   procedure Traverse
 
101
     (Container : in     Simple_Container;
 
102
      V         : in out Visitor'Class);
 
103
   --  Calls 'Execute (V)' for all items currently in the container, until
 
104
   --  either all items have been processed or 'Execute' sets 'Quit' to True.
 
105
 
 
106
   generic
 
107
      with procedure Execute
 
108
             (Value : in out Item;
 
109
              Quit  : in out Boolean);
 
110
   procedure Traverse_G
 
111
     (Container : in Simple_Container);
 
112
 
 
113
   generic
 
114
      type Auxiliary (<>) is limited private;
 
115
      with procedure Execute
 
116
             (Value : in out Item;
 
117
              Data  : in out Auxiliary;
 
118
              Quit  : in out Boolean);
 
119
   procedure Traverse_Aux_G
 
120
     (Container : in     Simple_Container;
 
121
      Data      : in out Auxiliary);
 
122
 
 
123
   function "="
 
124
     (Left, Right : in Simple_Container)
 
125
     return Boolean
 
126
      is abstract;
 
127
   --  Equality on @Simple_Container@s is not supported. Because a
 
128
   --  @Simple_Container@ has explicit or implicit ordering of items, a
 
129
   --  meaningful equality meaning "the two containers contain the same
 
130
   --  items" would be rather expensive (O(n**2)) to implement. And an
 
131
   --  equality meaning "the two containers are the same" would be quite
 
132
   --  different from equality on other containers.
 
133
 
 
134
   generic
 
135
      with function "<" (Left,  Right : in Item) return Boolean is <>;
 
136
   procedure Sort
 
137
     (Container : in out Simple_Container);
 
138
 
 
139
private
 
140
 
 
141
   type Node;
 
142
   type Link is access all Node;
 
143
   for Link'Storage_Pool use Memory.Pool;
 
144
   type Node is
 
145
      record
 
146
         Data : Item;
 
147
         Next : Link;
 
148
      end record;
 
149
 
 
150
   type True_Container is
 
151
     new Ada.Finalization.Controlled with
 
152
      record
 
153
         Anchor, Last : Link;
 
154
         Count        : Natural := 0;
 
155
      end record;
 
156
 
 
157
   procedure Adjust   (Container : in out True_Container);
 
158
   procedure Finalize (Container : in out True_Container);
 
159
 
 
160
   procedure Add
 
161
     (What : in     Item;
 
162
      To   : in out True_Container);
 
163
 
 
164
   procedure Reset
 
165
     (Container : in out True_Container);
 
166
 
 
167
   type Simple_Container is
 
168
      record
 
169
         C : True_Container;
 
170
      end record;
 
171
   --  @Simple_Container@ itself must not be a tagged type, or we cannot
 
172
   --  declare @"="@ as abstract! Note that a @Simple_Container@ is still
 
173
   --  a pass-by-reference type (see RM 6.2(8)).
 
174
 
 
175
   procedure Write
 
176
     (Stream    : access Ada.Streams.Root_Stream_Type'Class;
 
177
      Container : in     Simple_Container);
 
178
 
 
179
   procedure Read
 
180
     (Stream    : access Ada.Streams.Root_Stream_Type'Class;
 
181
      Container :    out Simple_Container);
 
182
 
 
183
   for Simple_Container'Write use Write;
 
184
   for Simple_Container'Read  use Read;
 
185
 
 
186
   Null_Container : constant Simple_Container :=
 
187
     (C => (Ada.Finalization.Controlled with
 
188
              Anchor => null,
 
189
              Last   => null,
 
190
              Count  => 0));
 
191
 
 
192
   type Visitor is abstract tagged null record;
 
193
 
 
194
end GAL.Containers.Simple;