secret
anonymous / Vectors.adb
Created

  • Download Gist
Vectors.adb
Ada
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
with Unchecked_Deallocation;
 
package body Vectors is
 
procedure Free is new Unchecked_Deallocation
(Object => Elements_Type, Name => Elements_Access);
 
procedure Inflate (V: in out Vector; Incr : in Integer := 100) is
Quantity_As_Int : constant Integer := Integer (V.Quantity) + Incr;
Quantity : constant Index_Type := Index_Type (Quantity_As_Int);
New_Elements : constant Elements_Access :=
new Elements_Type (Index_Type'First .. Quantity);
begin
if V.Last /= Last_Subtype'First then
New_Elements(Index_Type'First .. V.Last) :=
V.Elements(Index_Type'First .. V.Last);
Free(V.Elements);
end if;
V.Elements := New_Elements;
V.Quantity := Quantity;
end Inflate;
 
procedure Push(V : in out Vector; In_Item : in Element_Type) is
begin
if Is_Full(V) then
Inflate(V);
end if;
V.Last := V.Last + 1;
V.Elements(V.Last) := In_Item;
end Push;
 
 
procedure Pop(V : in out Vector; Out_Item : out Element_Type) is
begin
if Is_Empty(V) then
raise Constraint_Error;
end if;
Out_Item := V.Elements(V.Last);
V.Last := V.Last - 1;
end Pop;
 
 
function Peek(V : in Vector; Index : Index_Type) return Element_Type is
begin
if Is_Empty(V) and Index > V.Last then
raise Constraint_Error;
end if;
return V.Elements(Index);
end Peek;
 
 
function Is_Empty(V : in Vector) return Boolean is
begin
return V.Last = Index_Type'Pred (Index_Type'First);
end Is_Empty;
 
 
function Is_Full(V : in Vector) return Boolean is
begin
return V.Last = V.Quantity;
end Is_Full;
 
 
function Last(V : in Vector) return Index_Type is
begin
return V.Last;
end Last;
 
 
function Capacity(V : in Vector) return Integer is
Down : constant Integer := Integer (Index_Type'Pred(Index_Type'First));
Last : constant Integer := Integer (V.Last);
begin
return Last - Down;
end Capacity;
 
 
procedure Clear(V : in out Vector) is
begin
V.Last := Index_Type'Pred (Index_Type'First);
end Clear;
 
procedure Finalize(V: in out Vector) is
begin
null; -- TODO
end Finalize;
 
procedure Adjust(V: in out Vector) is
begin
null; -- TODO
end Adjust;
 
end Vectors;
Vectors.ads
Ada
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45
with Ada.Finalization;
 
generic
 
type Index_Type is range <>;
 
type Element_Type is private;
 
package Vectors is
 
type Vector is tagged private;
 
procedure Push(V : in out Vector; In_Item : in Element_Type);
procedure Pop (V : in out Vector; Out_Item : out Element_Type);
 
function Peek (V : in Vector; Index : Index_Type) return Element_Type;
 
function Is_Empty (V : in Vector) return Boolean;
function Last (V : in Vector) return Index_Type;
function Capacity (V : in Vector) return Integer;
procedure Clear (V : in out Vector);
 
private
type Elements_Type is array (Index_Type range <>) of Element_Type;
type Elements_Access is access Elements_Type;
 
subtype Last_Subtype is Index_Type'Base range
Index_Type'Pred (Index_Type'First) .. Index_Type'Last;
 
use Ada.Finalization;
 
type Vector is new Controlled with record
Elements : Elements_Access;
Last : Last_Subtype := Last_Subtype'First;
Quantity : Last_Subtype := Last_Subtype'First;
end record;
 
procedure Finalize (V : in out Vector);
procedure Adjust (V : in out Vector);
 
function Is_Full (V : in Vector) return Boolean;
procedure Inflate (V: in out Vector; Incr : in Integer := 100);
 
end Vectors;

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.