Ada 95 :: 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]