1--  Copyright 1994 Grady Booch
2--  Copyright 1994-1997 David Weller
3--  Copyright 1998-2014 Simon Wright <simon@pushface.org>
4
5--  This package is free software; you can redistribute it and/or
6--  modify it under terms of the GNU General Public License as
7--  published by the Free Software Foundation; either version 2, or
8--  (at your option) any later version. This package is distributed in
9--  the hope that it will be useful, but WITHOUT ANY WARRANTY; without
10--  even the implied warranty of MERCHANTABILITY or FITNESS FOR A
11--  PARTICULAR PURPOSE. See the GNU General Public License for more
12--  details. You should have received a copy of the GNU General Public
13--  License distributed with this package; see file COPYING.  If not,
14--  write to the Free Software Foundation, 59 Temple Place - Suite
15--  330, Boston, MA 02111-1307, USA.
16
17--  As a special exception, if other files instantiate generics from
18--  this unit, or you link this unit with other files to produce an
19--  executable, this unit does not by itself cause the resulting
20--  executable to be covered by the GNU General Public License.  This
21--  exception does not however invalidate any other reasons why the
22--  executable file might be covered by the GNU Public License.
23
24package body BC.Lists is
25
26   --  Iteration support
27
28   procedure Access_Current_Item (In_The_Iterator : Iterator'Class) is
29   begin
30      Apply (Current_Item_Ptr (In_The_Iterator).all);
31   end Access_Current_Item;
32
33   procedure Visit (Using : in out Iterator'Class) is
34      Success : Boolean;
35   begin
36      Reset (Using);
37      while not Is_Done (Using) loop
38         Apply (Current_Item_Ptr (Using).all, Success);
39         exit when not Success;
40         Next (Using);
41      end loop;
42   end Visit;
43
44   procedure Visit_With_In_Param (Using : in out Iterator'Class;
45                                  Param : Param_Type) is
46      Success : Boolean;
47   begin
48      Reset (Using);
49      while not Is_Done (Using) loop
50         Apply (Current_Item_Ptr (Using).all, Param, Success);
51         exit when not Success;
52         Next (Using);
53      end loop;
54   end Visit_With_In_Param;
55
56   procedure Visit_With_In_Out_Param (Using : in out Iterator'Class;
57                                      Param : in out Param_Type) is
58      Success : Boolean;
59   begin
60      Reset (Using);
61      while not Is_Done (Using) loop
62         Apply (Current_Item_Ptr (Using).all, Param, Success);
63         exit when not Success;
64         Next (Using);
65      end loop;
66   end Visit_With_In_Out_Param;
67
68   procedure Modify (Using : in out Iterator'Class) is
69      Success : Boolean;
70   begin
71      Reset (Using);
72      while not Is_Done (Using) loop
73         Apply (Current_Item_Ptr (Using).all, Success);
74         exit when not Success;
75         Next (Using);
76      end loop;
77   end Modify;
78
79   procedure Modify_With_In_Param (Using : in out Iterator'Class;
80                                   Param : in Param_Type) is
81      Success : Boolean;
82   begin
83      Reset (Using);
84      while not Is_Done (Using) loop
85         Apply (Current_Item_Ptr (Using).all, Param, Success);
86         exit when not Success;
87         Next (Using);
88      end loop;
89   end Modify_With_In_Param;
90
91   procedure Modify_With_In_Out_Param (Using : in out Iterator'Class;
92                                       Param : in out Param_Type) is
93      Success : Boolean;
94   begin
95      Reset (Using);
96      while not Is_Done (Using) loop
97         Apply (Current_Item_Ptr (Using).all, Param, Success);
98         exit when not Success;
99         Next (Using);
100      end loop;
101   end Modify_With_In_Out_Param;
102
103   --  Primitive implementations
104
105   function Item_At (C : List_Base; Index : Positive) return Item_Ptr is
106   begin
107      raise Should_Have_Been_Overridden;
108      return null;
109   end Item_At;
110
111   function Current_Item_Ptr (It : Iterator) return Item_Ptr is
112   begin
113      raise Should_Have_Been_Overridden;
114      return null;
115   end Current_Item_Ptr;
116
117end BC.Lists;
118