generic
package Stacks.Bounded_G is
   pragma Pure;

   type Stack (Capacity : Natural) is new Stacks.Stack with private;

   procedure Push
     (Container : in out Stack;
      Item      : in     Element_Type);

   function Top
     (Container : Stack) return Element_Type;

   procedure Pop
     (Container : in out Stack);

   function Length
     (Container : Stack) return Natural;

   procedure Clear (Container : in out Stack);

   procedure Assign
     (Target : in out Stack;
      Source : Stacks.Stack'Class);

   function Top_Cursor
     (Container : not null access constant Stack)
     return Stacks.Cursor'Class;

   function Bottom_Cursor
     (Container : not null access constant Stack)
     return Stacks.Cursor'Class;

private

   type Element_Array is array (Positive range <>) of Element_Type;

   function "=" (L, R : Element_Array) return Boolean is abstract;

   type Stack (Capacity : Natural) is new Stacks.Stack with record
      Elements  : Element_Array (1 .. Capacity);
      Top_Index : Natural := 0;
   end record;

   type Cursor is new Stacks.Cursor with record
      Container : access constant Stack;
      Index     : Natural := 0;
   end record;

   function Has_Element (Position : Cursor) return Boolean;

   function Element
     (Position : Cursor) return Element_Type;

   procedure Next (Position : in out Cursor);
   procedure Previous (Position : in out Cursor);

end Stacks.Bounded_G;
private with Ada.Finalization;

generic
package Stacks.Unbounded_G is
   pragma Preelaborate;

   type Stack is new Stacks.Stack with private;

   procedure Push
     (Container : in out Stack;
      Item      : in     Element_Type);

   function Top
     (Container : Stack) return Element_Type;

   procedure Pop
     (Container : in out Stack);

   function Length
     (Container : Stack) return Natural;

   procedure Clear (Container : in out Stack);

   procedure Assign
     (Target : in out Stack;
      Source : Stacks.Stack'Class);

   function Top_Cursor
     (Container : not null access constant Stack)
     return Stacks.Cursor'Class;

   function Bottom_Cursor
     (Container : not null access constant Stack)
     return Stacks.Cursor'Class;

private

   type Element_Array is array (Positive range <>) of Element_Type;

   function "=" (L, R : Element_Array) return Boolean is abstract;

   type Element_Array_Access is access Element_Array;

   type Rep_Type is new Ada.Finalization.Controlled with record
      Elements  : Element_Array_Access;
      Top_Index : Natural := 0;
   end record;

   overriding
   procedure Adjust (Rep : in out Rep_Type);

   overriding
   procedure Finalize (Rep : in out Rep_Type);

   type Stack is new Stacks.Stack with record
      Rep : Rep_Type;
   end record;

   type Cursor is new Stacks.Cursor with record
      Container : access constant Stack;
      Index     : Natural := 0;
   end record;

   function Has_Element (Position : Cursor) return Boolean;

   function Element
     (Position : Cursor) return Element_Type;

   procedure Next (Position : in out Cursor);
   procedure Previous (Position : in out Cursor);

end Stacks.Unbounded_G;
generic
   type Element_Type is private;
   with function "=" (L, R : Element_Type) return Boolean is <>;
package Stacks is
   pragma Pure;

   type Stack is abstract tagged null record;

   procedure Push
     (Container : in out Stack;
      Item      : in     Element_Type) is abstract;

   function Top
     (Container : Stack) return Element_Type is abstract;

   procedure Pop (Container : in out Stack) is abstract;

   function Length
     (Container : Stack) return Natural is abstract;

   procedure Clear (Container : in out Stack) is abstract;

   procedure Assign
     (Target : in out Stack;
      Source : Stack'Class) is abstract;

   type Cursor is abstract tagged null record;

   function Top_Cursor
     (Container : not null access constant Stack)
     return Cursor'Class is abstract;

   function Bottom_Cursor
     (Container : not null access constant Stack)
     return Cursor'Class is abstract;

   function Has_Element (Position : Cursor) return Boolean is abstract;

   function Element
     (Position : Cursor) return Element_Type is abstract;

   procedure Next (Position : in out Cursor) is abstract;
   procedure Previous (Position : in out Cursor) is abstract;

end Stacks;
with System;  use type System.Address;

package body Stacks.Bounded_G is

   procedure Push
     (Container : in out Stack;
      Item      : in     Element_Type)
   is
      E : Element_Array renames Container.Elements;
      I : Natural renames Container.Top_Index;

   begin
      E (I + 1) := Item;
      I := I + 1;
   end Push;


   function Top
     (Container : Stack) return Element_Type
   is
   begin
      return Container.Elements (Container.Top_Index);
   end;


   procedure Pop
     (Container : in out Stack)
   is
      I : Natural renames Container.Top_Index;

   begin
      I := I - 1;
   end;


   function Length
     (Container : Stack) return Natural
   is
   begin
      return Container.Top_Index;
   end;


   procedure Clear (Container : in out Stack) is
   begin
      Container.Top_Index := 0;
   end;


   procedure Assign
     (Target : in out Stack;
      Source : Stacks.Stack'Class)
   is
      C : Stacks.Cursor'Class := Source.Top_Cursor;

   begin
      if Target'Address = Source'Address then
         return;
      end if;

      if Source.Length > Target.Capacity then
         raise Constraint_Error;
      end if;

      Target.Clear;

      for I in reverse 1 .. Source.Length loop
         Target.Elements (I) := C.Element;
         C.Next;
      end loop;

      Target.Top_Index := Source.Length;
   end Assign;


   function Top_Cursor
     (Container : not null access constant Stack)
     return Stacks.Cursor'Class
   is
   begin
      if Container.Top_Index = 0 then
         return Cursor'(null, 0);
      else
         return Cursor'(Container, Container.Top_Index);
      end if;
   end Top_Cursor;


   function Bottom_Cursor
     (Container : not null access constant Stack)
     return Stacks.Cursor'Class
   is
   begin
      if Container.Top_Index = 0 then
         return Cursor'(null, 0);
      else
         return Cursor'(Container, 1);
      end if;
   end Bottom_Cursor;


   function Has_Element (Position : Cursor) return Boolean is
   begin
      return Position.Index > 0;
   end;


   function Element
     (Position : Cursor) return Element_Type
   is
      S : Stack renames Position.Container.all;
      I : constant Positive range 1 .. S.Top_Index := Position.Index;

   begin
      return S.Elements (I);
   end;


   procedure Next (Position : in out Cursor) is
      I : Natural renames Position.Index;

   begin
      if I = 0 then
         return;
      end if;

      declare
         S : Stack renames Position.Container.all;
      begin
         if I > S.Top_Index then
            I := S.Top_Index;
         else
            I := I - 1;
         end if;
      end;

      if I = 0 then
         Position.Container := null;
      end if;
   end Next;


   procedure Previous (Position : in out Cursor) is
      I : Natural renames Position.Index;

   begin
      if I = 0 then
         return;
      end if;

      declare
         S : Stack renames Position.Container.all;
      begin
         if I >= S.Top_Index then
            I := 0;
            Position.Container := null;

         else
            I := I + 1;
         end if;
      end;
   end Previous;


end Stacks.Bounded_G;
with Ada.Unchecked_Deallocation;
with System;  use type System.Address;

package body Stacks.Unbounded_G is

   procedure Free is
      new Ada.Unchecked_Deallocation 
     (Element_Array,
      Element_Array_Access);


   procedure Push
     (Container : in out Stack;
      Item      : in     Element_Type)
   is
      R : Rep_Type renames Container.Rep;
      I : Natural renames R.Top_Index;

   begin
      if R.Elements = null then
         R.Elements := new Element_Array'(1 .. 1 => Item);
         I := 1;
         return;
      end if;
         
      if I = R.Elements'Last then
         declare
            X : Element_Array_Access := R.Elements;
            J : constant Positive := 2 * I;
            E : Element_Array_Access := new Element_Array (1 .. J);
            
         begin
            Copy : begin
               E (1 .. I) := X.all;
            exception
               when others =>
                  Free (E);
                  raise;
            end Copy;
            
            R.Elements := E;
            Free (X);
         end;
      end if;
      
      R.Elements (I + 1) := Item;
      I := I + 1;
   end Push;

            
   function Top
     (Container : Stack) return Element_Type
   is
      R : Rep_Type renames Container.Rep;

   begin
      return R.Elements (R.Top_Index);
   end;


   procedure Pop
     (Container : in out Stack)
   is
      R : Rep_Type renames Container.Rep;
      I : Natural renames R.Top_Index;

   begin
      I := I - 1;
   end;

      
   function Length
     (Container : Stack) return Natural
   is
   begin
      return Container.Rep.Top_Index;
   end;


   procedure Clear (Container : in out Stack) is
   begin
      Container.Rep.Top_Index := 0;
   end;


   procedure Assign
     (Target : in out Stack;
      Source : Stacks.Stack'Class)
   is
      C : Stacks.Cursor'Class := Source.Top_Cursor;
      T : Rep_Type renames Target.Rep;
      L : constant Natural := Source.Length;
      
   begin
      if Target'Address = Source'Address then
         return;
      end if;
      
      Target.Clear;
      
      if L = 0 then
         return;
      end if;
      
      if T.Elements = null 
        or else T.Elements'Length < L
      then
         declare
            X : Element_Array_Access := T.Elements;
            
         begin
            T.Elements := null;
            Free (X);
         end;
         
         T.Elements := new Element_Array (1 .. L);
      end if;

      for I in reverse 1 .. L loop
         T.Elements (I) := C.Element;
         C.Next;
      end loop;
      
      T.Top_Index := L;
   end Assign;


   procedure Adjust (Rep : in out Rep_Type) is
      X : constant Element_Array_Access := Rep.Elements;
      I : constant Natural := Rep.Top_Index;
      
   begin
      Rep.Elements := null;
      Rep.Top_Index := 0;
      
      if I > 0 then
         Rep.Elements := new Element_Array'(X (1 .. I));
         Rep.Top_Index := I;
      end if;
   end Adjust;
      

   procedure Finalize (Rep : in out Rep_Type) is
      X : Element_Array_Access := Rep.Elements;
      
   begin
      Rep.Elements := null;
      Rep.Top_Index := 0;
      
      Free (X);
   end;


   function Top_Cursor
     (Container : not null access constant Stack) 
     return Stacks.Cursor'Class
   is
      R : Rep_Type renames Container.Rep;
      
   begin
      if R.Top_Index = 0 then
         return Cursor'(null, 0);
      else
         return Cursor'(Container, R.Top_Index);
      end if;
   end;


   function Bottom_Cursor
     (Container : not null access constant Stack) 
     return Stacks.Cursor'Class
   is
      R : Rep_Type renames Container.Rep;
      
   begin
      if R.Top_Index = 0 then
         return Cursor'(null, 0);
      else
         return Cursor'(Container, 1);
      end if;
   end;


   function Has_Element (Position : Cursor) return Boolean is
   begin
      return Position.Index > 0;
   end;
      

   function Element
     (Position : Cursor) return Element_Type
   is
      R : Rep_Type renames Position.Container.Rep;
      I : constant Positive range 1 .. R.Top_Index := Position.Index;

   begin
      return R.Elements (I);
   end;


   procedure Next (Position : in out Cursor) is
      I : Natural renames Position.Index;
      
   begin
      if I = 0 then
         return;
      end if;

      declare
         R : Rep_Type renames Position.Container.Rep;
      begin
         if I > R.Top_Index then
            I := R.Top_Index;
         else
            I := I - 1;
         end if;
      end;

      if I = 0 then
         Position.Container := null;
      end if;
   end Next;


   procedure Previous (Position : in out Cursor) is
      I : Natural renames Position.Index;
      
   begin
      if I = 0 then
         return;
      end if;

      declare
         R : Rep_Type renames Position.Container.Rep;
      begin
         if I >= R.Top_Index then
            I := 0;
            Position.Container := null;
            
         else
            I := I + 1;
         end if;
      end;
   end Previous;

end Stacks.Unbounded_G;