::
x22_st_g.ada
with Text_io; use Text_io;
generic
type Stack_element is private; -- Can specify any type
MAX_STACK:in Positive := 3; -- Has to be typed / not const
package Class_stack is
type Stack is private;
Stack_error: exception;
procedure reset( the:in out Stack);
procedure push( the:in out Stack; item:in Stack_element );
procedure pop( the:in out Stack; item:out Stack_element );
private
type Stack_index is new Integer range 0 .. MAX_STACK;
subtype Stack_range is Stack_index
range 1 .. Stack_index(MAX_STACK);
type Stack_array is array ( Stack_range ) of Stack_element;
type Stack is record
elements: Stack_array; -- Array of elements
tos : Stack_index := 0; -- Index
end record;
end Class_stack;
package body Class_stack is
procedure push( the:in out Stack; item:in Stack_element ) is
begin
if the.tos /= Stack_index(MAX_STACK) then
the.tos := the.tos + 1; -- Next element
the.elements( the.tos ) := item; -- Move in
else
raise Stack_error; -- Failed
end if;
end push;
procedure pop( the:in out Stack; item :out Stack_element ) is
begin
if the.tos > 0 then
item := the.elements( the.tos ); -- Top element
the.tos := the.tos - 1; -- Move down
else
raise Stack_error; -- Failed
end if;
end pop;
procedure reset( the:in out Stack ) is
begin
the.tos := 0; -- Set TOS to 0 (Non existing element)
end reset;
end Class_stack;
with Class_stack;
pragma ELABorATE_all( Class_stack );
package Class_stack_char is new Class_stack(Character,3);
with Class_stack;
pragma ELABorATE_all( Class_stack );
package Class_stack_int is new Class_stack(Integer);
with Class_stack, Class_stack_int;
package Class_stack_stack_int is
new Class_stack(Class_stack_int.Stack);
with Simple_io, Class_stack_int;
use Simple_io, Class_stack_int;
procedure main1 is
number_stack : Stack; -- Stack of numbers
action : Character; -- Action
number : Integer; -- Number processed
begin
while not end_of_file loop
while not end_of_line loop
begin
get( action );
case action is -- Process action
when '+' =>
get( number ); push(number_stack,number);
put("push number = "); put(number); new_line;
when '-' =>
pop(number_stack,number);
put("Pop number = "); put(number); new_line;
when others =>
put("Invalid action"); new_line;
end case;
exception
when Stack_error =>
put("Stack_error"); new_line;
when Data_error =>
put("Not a number"); new_line;
when End_error =>
put("Unexpected end of file"); new_line; exit;
end;
end loop;
skip_Line;
end loop;
reset( number_stack );
end main1;
with Simple_io, Class_stack_int,Class_stack_stack_int;
use Simple_io, Class_stack_int,Class_stack_stack_int;
procedure main2 is
number_stack1 : Class_stack_int.Stack;
number_stack2 : Class_stack_int.Stack;
stack_number_stack : Class_stack_stack_int.Stack;
number : Integer;
begin
push( number_stack1, 1 );
push( number_stack1, 2 );
push( stack_number_stack, number_stack1 );
pop( stack_number_stack, number_stack2 );
pop( number_stack2, number );
if number = 2 then put("ok "); else put("Fail "); end if;
pop( number_stack2, number );
if number = 1 then put("ok "); else put("Fail "); end if;
new_line;
end main2;
with Simple_io, main1, main2;
use Simple_io;
procedure main is
begin
put("Example 1"); new_line; main1;
put("Example 2"); new_line; main2;
end main;
© M.A.Smith University of Brighton.
Created September 1995 last modified May 1997.
Comments, suggestions, etc.
M.A.Smith@brighton.ac.uk
*
[Home page]