1--  Copyright 1994 Grady Booch
2--  Copyright 1994-1997 David Weller
3--  Copyright 1998-2014 Simon Wright <simon@pushface.org>
4--  Copyright 2005 Martin Krischik
5
6--  This package is free software; you can redistribute it and/or
7--  modify it under terms of the GNU General Public License as
8--  published by the Free Software Foundation; either version 2, or
9--  (at your option) any later version. This package is distributed in
10--  the hope that it will be useful, but WITHOUT ANY WARRANTY; without
11--  even the implied warranty of MERCHANTABILITY or FITNESS FOR A
12--  PARTICULAR PURPOSE. See the GNU General Public License for more
13--  details. You should have received a copy of the GNU General Public
14--  License distributed with this package; see file COPYING.  If not,
15--  write to the Free Software Foundation, 59 Temple Place - Suite
16--  330, Boston, MA 02111-1307, USA.
17
18--  As a special exception, if other files instantiate generics from
19--  this unit, or you link this unit with other files to produce an
20--  executable, this unit does not by itself cause the resulting
21--  executable to be covered by the GNU General Public License.  This
22--  exception does not however invalidate any other reasons why the
23--  executable file might be covered by the GNU Public License.
24
25generic
26   type Item is private;
27   with function "=" (L, R : Item) return Boolean is <>;
28package BC.Containers is
29
30   pragma Preelaborate;
31
32   --  This package specifies the common protocol of all Container
33   --  classes. This common protocol consists of Iterators.
34
35   type Container is abstract tagged private;
36
37   function Null_Container return Container is abstract;
38
39   --  Active iteration
40
41   type Iterator (<>) is abstract tagged private;
42
43   function New_Iterator (For_The_Container : Container) return Iterator'Class
44      is abstract;
45   --  Return a reset Iterator bound to the specific Container.
46
47   procedure Reset (It : in out Iterator) is abstract;
48   --  Reset the Iterator to the beginning.
49
50   procedure Next (It : in out Iterator) is abstract;
51   --  Advance the Iterator to the next Item in the Container.
52
53   function Is_Done (It : Iterator) return Boolean is abstract;
54   --  Return True if there are no more Items in the Container.
55
56   function Current_Item (It : Iterator) return Item is abstract;
57   --  Return a copy of the current Item.
58
59   generic
60      with procedure Apply (Elem : in out Item);
61   procedure Access_Current_Item (In_The_Iterator : Iterator'Class);
62   --  Call Apply for the Iterator's current Item.
63
64   procedure Delete_Item_At (It : in out Iterator) is abstract;
65   --  Remove the current item.
66
67   --  Passive iteration
68
69   generic
70      with procedure Apply (Elem : in Item; OK : out Boolean);
71   procedure Visit (Using : in out Iterator'Class);
72   --  Call Apply with a copy of each Item in the Container to which
73   --  the iterator Using is bound. The iteration will terminate early
74   --  if Apply sets OK to False.
75
76   generic
77      type Param_Type (<>) is limited private;
78      with procedure Apply (Elem : in Item;
79                            Param : in Param_Type;
80                            OK : out Boolean);
81   procedure Visit_With_In_Param (Using : in out Iterator'Class;
82                                  Param : in Param_Type);
83   --  Call Apply with a Parameter for each Item in the Container to
84   --  which the iterator Using is bound. The iteration will terminate
85   --  early if Apply sets OK to False.
86
87   generic
88      type Param_Type (<>) is limited private;
89      with procedure Apply (Elem : in Item;
90                            Param : in out Param_Type;
91                            OK : out Boolean);
92   procedure Visit_With_In_Out_Param (Using : in out Iterator'Class;
93                                      Param : in out Param_Type);
94   --  Call Apply with a Parameter for each Item in the Container to
95   --  which the iterator Using is bound. The iteration will terminate
96   --  early if Apply sets OK to False.
97
98   generic
99      with procedure Apply (Elem : in out Item; OK : out Boolean);
100   procedure Modify (Using : in out Iterator'Class);
101   --  Call Apply with a copy of each Item in the Container to which
102   --  the iterator Using is bound. The iteration will terminate early
103   --  if Apply sets OK to False.
104
105   generic
106      type Param_Type (<>) is limited private;
107      with procedure Apply (Elem : in out Item;
108                            Param : in Param_Type;
109                            OK : out Boolean);
110   procedure Modify_With_In_Param (Using : in out Iterator'Class;
111                                   Param : in Param_Type);
112   --  Call Apply with a Parameter each Item in the Container to which
113   --  the iterator Using is bound. The iteration will terminate early
114   --  if Apply sets OK to False.
115
116   generic
117      type Param_Type (<>) is limited private;
118      with procedure Apply (Elem : in out Item;
119                            Param : in out Param_Type;
120                            OK : out Boolean);
121   procedure Modify_With_In_Out_Param (Using : in out Iterator'Class;
122                                       Param : in out Param_Type);
123   --  Call Apply with a copy of each Item in the Container to which
124   --  the iterator Using is bound. The iteration will terminate early
125   --  if Apply sets OK to False.
126
127private
128
129   --  Suppress "unreferenced" warnings here (GNAT 5.02). Can't use
130   --  pragma Unreferenced, because then we get warnings in child
131   --  packages.
132   pragma Warnings (Off, "=");
133
134   --  We need access to Items; but we must make sure that no actual
135   --  allocations occur using this type.
136
137   type Item_Ptr is access all Item;
138   for Item_Ptr'Storage_Size use 0;
139
140   type Container is abstract tagged null record;
141
142   --  Private primitive operations of Container.  These should
143   --  ideally be abstract; instead, we provide implementations, but
144   --  they raise Should_Have_Been_Overridden.
145
146   function Item_At (C : Container; Index : Positive) return Item_Ptr;
147
148   --  Iteration
149
150   type Container_Ptr is access all Container'Class;
151   for Container_Ptr'Storage_Size use 0;
152
153   type Iterator is abstract tagged record
154      For_The_Container : Container_Ptr;
155   end record;
156
157   --  Private primitive operations of Iterator.  These should ideally
158   --  be abstract; instead, we provide implementations, but they
159   --  raise Should_Have_Been_Overridden.
160   function Current_Item_Ptr (It : Iterator) return Item_Ptr;
161
162end BC.Containers;
163