1-- Copyright 1994 Grady Booch 2-- Copyright 2005 Martin Krischik 3-- Copyright 2003-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_Unmanaged_Containers.Collections 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 Collection_Nodes.Insert (C.Rep, Elem); 42 end Insert; 43 44 procedure Insert (C : in out Collection; 45 Elem : Item; 46 Before : Positive) is 47 begin 48 Collection_Nodes.Insert (C.Rep, Elem, Before); 49 end Insert; 50 51 procedure Append (C : in out Collection; Elem : Item) is 52 begin 53 Collection_Nodes.Append (C.Rep, Elem); 54 end Append; 55 56 procedure Append (C : in out Collection; 57 Elem : Item; 58 After : Positive) is 59 begin 60 Collection_Nodes.Append (C.Rep, Elem, After); 61 end Append; 62 63 procedure Remove (C : in out Collection; At_Index : Positive) is 64 begin 65 Collection_Nodes.Remove (C.Rep, At_Index); 66 end Remove; 67 68 procedure Replace (C : in out Collection; 69 At_Index : Positive; 70 Elem : Item) is 71 begin 72 Collection_Nodes.Replace (C.Rep, At_Index, Elem); 73 end Replace; 74 75 function Length (C : Collection) return Natural is 76 begin 77 return Collection_Nodes.Length (C.Rep); 78 end Length; 79 80 function Is_Empty (C : Collection) return Boolean is 81 begin 82 return Collection_Nodes.Length (C.Rep) = 0; 83 end Is_Empty; 84 85 function First (C : Collection) return Item is 86 begin 87 return Collection_Nodes.First (C.Rep); 88 end First; 89 90 function Last (C : Collection) return Item is 91 begin 92 return Collection_Nodes.Last (C.Rep); 93 end Last; 94 95 function Item_At 96 (C : Collection; At_Index : Positive) return Item is 97 begin 98 return Item_At (C, At_Index).all; 99 end Item_At; 100 101 function Location (C : Collection; Elem : Item) return Natural is 102 begin 103 return Collection_Nodes.Location (C.Rep, Elem); 104 end Location; 105 106 package Address_Conversions 107 is new System.Address_To_Access_Conversions (Collection); 108 109 function New_Iterator 110 (For_The_Collection : Collection) return Iterator'Class is 111 Result : Collection_Iterator; 112 begin 113 Result.For_The_Container := 114 Container_Ptr (Address_Conversions.To_Pointer 115 (For_The_Collection'Address)); 116 Reset (Result); 117 return Result; 118 end New_Iterator; 119 120 function Item_At 121 (C : Collection; Index : Positive) return Item_Ptr is 122 begin 123 return Collection_Nodes.Item_At (C.Rep, Index); 124 end Item_At; 125 126 function Null_Container return Collection is 127 Empty_Container : Collection; 128 pragma Warnings (Off, Empty_Container); 129 begin 130 return Empty_Container; 131 end Null_Container; 132 133 procedure Reset (It : in out Collection_Iterator) is 134 C : Collection'Class 135 renames Collection'Class (It.For_The_Container.all); 136 begin 137 if Length (C) = 0 then 138 It.Index := 0; 139 else 140 It.Index := 1; 141 end if; 142 end Reset; 143 144 function Is_Done (It : Collection_Iterator) return Boolean is 145 C : Collection'Class 146 renames Collection'Class (It.For_The_Container.all); 147 begin 148 return It.Index = 0 or else It.Index > Length (C); 149 end Is_Done; 150 151 procedure Next (It : in out Collection_Iterator) is 152 begin 153 It.Index := It.Index + 1; 154 end Next; 155 156 function Current_Item (It : Collection_Iterator) return Item is 157 C : Collection'Class 158 renames Collection'Class (It.For_The_Container.all); 159 begin 160 if Is_Done (It) then 161 raise BC.Not_Found; 162 end if; 163 return Item_At (C, It.Index).all; 164 end Current_Item; 165 166 function Current_Item_Ptr (It : Collection_Iterator) return Item_Ptr is 167 C : Collection'Class 168 renames Collection'Class (It.For_The_Container.all); 169 begin 170 if Is_Done (It) then 171 raise BC.Not_Found; 172 end if; 173 return Item_At (C, It.Index); 174 end Current_Item_Ptr; 175 176 procedure Delete_Item_At (It : in out Collection_Iterator) is 177 C : Collection'Class 178 renames Collection'Class (It.For_The_Container.all); 179 begin 180 if Is_Done (It) then 181 raise BC.Not_Found; 182 end if; 183 Remove (C, It.Index); 184 end Delete_Item_At; 185 186end BC.Indefinite_Unmanaged_Containers.Collections; 187