Re: Package instantiation and automatic de-allocation.

[Stapler <spam.magnet@yahoo.com>]

Alright, I've made some progress.

All I want to do is declare a single instance of a generic stack within a
declarative block(whether a procedure or inlined declare block).

As a newbie, I probably overlooked some things.(As readers of my previous
posts have probably already guessed.) ;->

I'm basically posting this up in hopes of getting feedback. To the Gurus
among us, I'm posting under my own thread so as to allow your newsreader
to scan past my hopeless, banal, novice ramblings.

To those who find the stomach to look at it, thanks for not tossing your
cookies.

Heres what it looks like right now.

generic
	Size : Positive;
	type Item is private;
	
package gen_stack is
	
	Stack_Overflow : exception;
	Stack_Underflow : exception;
	
	procedure Push(X : in Item);
	procedure Pop(Y : out Item);
	function Is_Full return Boolean;
	function Is_Empty return Boolean;
	
private

	subtype Stack_range is natural range 1..Size;
	type Item_array is array(positive range 1..Size) of Item;
	
	-- Make this a limited record?
	type Stack is record
		Elements : Item_Array;
		Top : Stack_range;
		Full, Empty : Boolean;
	end record;
	
end gen_stack;
	
package body gen_stack is
	
	Local : Stack; -- Using this variable to access the
			   -- Stack in the Private part of the package.
			   -- Assuming it should be visible to all procedures
			   -- and functions in this package.	
			   -- Needs to be In/Out in procedure parameters?
	procedure Push(X : in Item) is separate;
	procedure Pop(Y : out Item) is separate;
	
	function Is_Full return Boolean is
	-- All this function does is exports the value
	-- in the full field of the record	
	
	begin
	
		return Local.Full; -- A Boolean value
		
	end Is_Full;
	
	function Is_Empty return Boolean is
	-- Same as Is_Full, except exports Empty instead
	
	begin
	
		return Local.Empty; -- A Boolean value.
		
	end Is_Empty;
	
end gen_stack;

separate (gen_stack)
procedure Pop(Y : out Item) is

begin
	-- If the user attempts to Pop an Item off an
	-- empty stack, then raise Stack_Underflow
	-- Check using the public Is_Empty function;
	if Local.Empty = True then
	
		raise Stack_Underflow;
		
	end if;
	
	-- It seems like it shouldn't be necessary to
	-- set the Empty/Full flags explicitly.
	Local.Empty := False;
	
	Y := Local.Elements(Local.Top);
	
	if (Local.Top - 1) = 0 then
	
		Local.Empty := True;
		
	else
		-- Assuming my logic is correct
		-- If the stack is already on it's last
		-- element, the code should not reach here.
		Local.Top := Local.Top - 1;
		
	end if;

end Pop;

separate (gen_stack)
procedure Push(X : in Item) is

	procedure Insert(X : in Item) is

	begin

		Local.Elements(Local.Top) := X;

	end Insert;

begin
	-- If the user failed to check and see if the Stack is
	-- full via the Is_Full function, and the Stack is full
	-- then raise Stack_Overflow
	if Local.Full = True then
		raise Stack_Overflow;

	end if;
	
	-- If the Code reaches here, then the Full flag wasnt
	-- set to True, but set it explicitly anyways for safety.
	-- Is this needed?
	Local.Full := False;

	-- If there is one remaining element then
	-- Set the Full flag to true and Insert 
	-- the Item into the remaining Element
	-- i.e. Top and Size should both be indexing
	-- the same element at the start of this
	-- "If" function.
	if Local.Top = Size then
		Local.Full := True;
		Insert(X);
	else if Local.Top < Size then
		Insert(X);
		Local.Top := Local.Top + 1;
	end if;
	end if;

end Push;