1--  Copyright 1994 Grady Booch
2--  Copyright 1998-2014 Simon Wright <simon@pushface.org>
3
4--  This package is free software; you can redistribute it and/or
5--  modify it under terms of the GNU General Public License as
6--  published by the Free Software Foundation; either version 2, or
7--  (at your option) any later version. This package is distributed in
8--  the hope that it will be useful, but WITHOUT ANY WARRANTY; without
9--  even the implied warranty of MERCHANTABILITY or FITNESS FOR A
10--  PARTICULAR PURPOSE. See the GNU General Public License for more
11--  details. You should have received a copy of the GNU General Public
12--  License distributed with this package; see file COPYING.  If not,
13--  write to the Free Software Foundation, 59 Temple Place - Suite
14--  330, Boston, MA 02111-1307, USA.
15
16--  As a special exception, if other files instantiate generics from
17--  this unit, or you link this unit with other files to produce an
18--  executable, this unit does not by itself cause the resulting
19--  executable to be covered by the GNU General Public License.  This
20--  exception does not however invalidate any other reasons why the
21--  executable file might be covered by the GNU Public License.
22
23with System.Address_To_Access_Conversions;
24
25package body BC.Containers.Sets.Unbounded is
26
27   procedure Clear (S : in out Unconstrained_Set) is
28   begin
29      Tables.Clear (S.Rep);
30   end Clear;
31
32   procedure Add (S : in out Unconstrained_Set;
33                  I : Item;
34                  Added : out Boolean) is
35   begin
36      if Tables.Is_Bound (S.Rep, I) then
37         Added := False;
38      else
39         Tables.Bind (S.Rep, I, (null record));
40         Added := True;
41      end if;
42   end Add;
43
44   procedure Add (S : in out Unconstrained_Set; I : Item) is
45   begin
46      if not Tables.Is_Bound (S.Rep, I) then
47         Tables.Bind (S.Rep, I, (null record));
48      end if;
49   end Add;
50
51   procedure Remove (S : in out Unconstrained_Set; I : Item) is
52   begin
53      Tables.Unbind (S.Rep, I);
54   end Remove;
55
56   function Extent (S : Unconstrained_Set) return Natural is
57   begin
58      return Tables.Extent (S.Rep);
59   end Extent;
60
61   function Is_Empty (S : Unconstrained_Set) return Boolean is
62   begin
63      return Tables.Extent (S.Rep) = 0;
64   end Is_Empty;
65
66   function Is_Member (S : Unconstrained_Set; I : Item) return Boolean is
67   begin
68      return Tables.Is_Bound (S.Rep, I);
69   end Is_Member;
70
71   package Address_Conversions
72   is new System.Address_To_Access_Conversions (Unconstrained_Set);
73
74   function New_Iterator
75     (For_The_Set : Unconstrained_Set) return Iterator'Class is
76      Result : Unbounded_Set_Iterator;
77   begin
78      Result.For_The_Container :=
79        Container_Ptr (Address_Conversions.To_Pointer (For_The_Set'Address));
80      Reset (Result);
81      return Result;
82   end New_Iterator;
83
84   --  Null containers
85
86   function Null_Container return Unconstrained_Set is
87      Empty_Container : Set;
88      pragma Warnings (Off, Empty_Container);
89   begin
90      return Empty_Container;
91   end Null_Container;
92
93   --  Iterators
94
95   procedure Reset (It : in out Unbounded_Set_Iterator) is
96      S : Unconstrained_Set'Class
97        renames Unconstrained_Set'Class (It.For_The_Container.all);
98   begin
99      Tables.Reset (S.Rep, It.Bucket_Index, It.Index);
100   end Reset;
101
102   procedure Next (It : in out Unbounded_Set_Iterator) is
103      S : Unconstrained_Set'Class
104        renames Unconstrained_Set'Class (It.For_The_Container.all);
105   begin
106      Tables.Next (S.Rep, It.Bucket_Index, It.Index);
107   end Next;
108
109   function Is_Done (It : Unbounded_Set_Iterator) return Boolean is
110      S : Unconstrained_Set'Class
111        renames Unconstrained_Set'Class (It.For_The_Container.all);
112   begin
113      return Tables.Is_Done (S.Rep, It.Bucket_Index, It.Index);
114   end Is_Done;
115
116   function Current_Item (It : Unbounded_Set_Iterator) return Item is
117      S : Unconstrained_Set'Class
118        renames Unconstrained_Set'Class (It.For_The_Container.all);
119   begin
120      return Tables.Current_Item_Ptr (S.Rep, It.Bucket_Index, It.Index).all;
121   end Current_Item;
122
123   function Current_Item_Ptr (It : Unbounded_Set_Iterator) return Item_Ptr is
124      S : Unconstrained_Set'Class
125        renames Unconstrained_Set'Class (It.For_The_Container.all);
126   begin
127      return Tables.Current_Item_Ptr (S.Rep, It.Bucket_Index, It.Index);
128   end Current_Item_Ptr;
129
130   procedure Delete_Item_At (It : in out Unbounded_Set_Iterator) is
131      S : Unconstrained_Set'Class
132        renames Unconstrained_Set'Class (It.For_The_Container.all);
133   begin
134      Tables.Delete_Item_At (S.Rep, It.Bucket_Index, It.Index);
135   end Delete_Item_At;
136
137end BC.Containers.Sets.Unbounded;
138