1--  Copyright 1994 Grady Booch
2--  Copyright 2003 Martin Krischik
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
24with System.Address_To_Access_Conversions;
25
26package body BC.Indefinite_Containers.Collections.Ordered.Unbounded is
27
28   function "=" (Left, Right : in Collection) return Boolean is
29      use Collection_Nodes;
30   begin
31      return Left.Rep = Right.Rep;
32   end "=";
33
34   procedure Clear (C : in out Collection) is
35   begin
36      Collection_Nodes.Clear (C.Rep);
37   end Clear;
38
39   procedure Insert (C : in out Collection; Elem : Item) is
40   begin
41      for Index in 1 .. Collection_Nodes.Length (C.Rep)
42      loop
43         if not (Collection_Nodes.Item_At (C.Rep, Index) < Elem) then
44            Collection_Nodes.Insert (C.Rep, Elem, Index);
45            return;
46         end if;
47      end loop;
48      Collection_Nodes.Append (C.Rep, Elem);
49   end Insert;
50
51   procedure Insert (C : in out Collection;
52                     Elem : Item;
53                     Before : Positive) is
54      Current : constant Item := Item_At (C, Before);
55      --  May raise Range_Error.
56   begin
57      if Elem < Current or else Current < Elem then
58         --  Values not equal; Insert sortedly.
59         Insert (C, Elem);
60      else
61         --  Values are equal (presumably), so Insert in the specified
62         --  place.
63         Collection_Nodes.Insert (C.Rep, Before => Before, Elem => Elem);
64      end if;
65   end Insert;
66
67   procedure Append (C : in out Collection; Elem : Item) is
68   begin
69      for Index in 1 .. Collection_Nodes.Length (C.Rep)
70      loop
71         if Elem < Collection_Nodes.Item_At (C.Rep, Index) then
72            Collection_Nodes.Insert (C.Rep, Elem, Index);
73            return;
74         end if;
75      end loop;
76      Collection_Nodes.Append (C.Rep, Elem);
77   end Append;
78
79   procedure Append (C : in out Collection;
80                     Elem : Item;
81                     After : Positive) is
82      Current : constant Item := Item_At (C, After);
83      --  May raise Range_Error.
84   begin
85      if Elem < Current or else Current < Elem then
86         --  Values not equal; Append sortedly.
87         Append (C, Elem);
88      else
89         --  Values are equal (presumably), so Append in the specified
90         --  place.
91         Collection_Nodes.Append (C.Rep, After => After, Elem => Elem);
92      end if;
93   end Append;
94
95   procedure Remove (C : in out Collection; At_Index : Positive) is
96   begin
97      Collection_Nodes.Remove (C.Rep, At_Index);
98   end Remove;
99
100   procedure Replace (C : in out Collection;
101                      At_Index : Positive;
102                      Elem : Item) is
103      Current : constant Item := Item_At (C, At_Index);
104   begin
105      if Elem < Current then
106         --  Elem goes after any 'equal' Item; the same as an Append.
107         Remove (C, At_Index);
108         Append (C, Elem);
109      elsif Current < Elem then
110         --  Elem goes before any 'equal' Item; the same as an Insert.
111         Remove (C, At_Index);
112         Insert (C, Elem);
113      else
114         --  Values are equal (presumably), so replace in situ.
115         Collection_Nodes.Replace (C.Rep, Index => At_Index, Elem => Elem);
116      end if;
117   end Replace;
118
119   function Length (C : Collection) return Natural is
120   begin
121      return Collection_Nodes.Length (C.Rep);
122   end Length;
123
124   function Is_Empty (C : Collection) return Boolean is
125   begin
126      return Collection_Nodes.Length (C.Rep) = 0;
127   end Is_Empty;
128
129   function First (C : Collection) return Item is
130   begin
131      return Collection_Nodes.First (C.Rep);
132   end First;
133
134   function Last (C : Collection) return Item is
135   begin
136      return Collection_Nodes.Last (C.Rep);
137   end Last;
138
139   function Item_At (C : Collection; At_Index : Positive) return Item is
140   begin
141      return Item_At (C, At_Index).all;
142   end Item_At;
143
144   function Location (C : Collection; Elem : Item) return Natural is
145   begin
146      return Collection_Nodes.Location (C.Rep, Elem);
147   end Location;
148
149   package Address_Conversions
150   is new System.Address_To_Access_Conversions (Collection);
151
152   function New_Iterator
153     (For_The_Collection : Collection) return Iterator'Class is
154      Result : Collection_Iterator;
155   begin
156      Result.For_The_Container :=
157        Container_Ptr (Address_Conversions.To_Pointer
158                         (For_The_Collection'Address));
159      Reset (Result);
160      return Result;
161   end New_Iterator;
162
163   function Item_At (C : Collection; Index : Positive) return Item_Ptr is
164   begin
165      return Collection_Nodes.Item_At (C.Rep, Index);
166   end Item_At;
167
168   function Null_Container return Collection is
169      Empty_Container : Collection;
170      pragma Warnings (Off, Empty_Container);
171   begin
172      return Empty_Container;
173   end Null_Container;
174
175end BC.Indefinite_Containers.Collections.Ordered.Unbounded;
176