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