unit StackADT;

interface

   type
      StackElementType = ValueType;

      StackPtr = ^StackNode;

      StackNode = record
                       Data: StackElementType;
                       Next : StackPtr;
                    end;

      StackType = StackPtr;


   procedure CreateStack (var S : StackType);
  (*
   * post: S is initialized and empty
   *)

   procedure DestroyStack (var S : StackType);
  (*
   * post: Memory allocated for S is released
   *)

   function EmptyStack (S : StackType) : boolean;
  (*
   * post: Returns TRUE if S is empty, FALSE otherwise
   *)

   procedure Push (var S    : StackType;
                       Item : StackElementType);
  (*
   * post: Item is added to the top of S
   *)

   procedure Pop (var S    : StackType;
                  var Item : StackElementType);
  (*
   * pre:  not EmptyStack (S)
   * post: S has its top element removed;
   *       Item holds that element
   *)


implementation

   uses  
      WinCRT;


   procedure CreateStack (var S : StackType);
   begin
       S := nil;    
   end; (* CreateStack *)

   function EmptyStack (S : StackType) : boolean;
   begin
       EmptyStack := (S = nil); 
   end; (* EmptyStack *)

   procedure Push (var S    : StackType;
                       Item : StackElementType);

   var   tmp : StackPtr;

   begin
       new (S);
       tmp^.Data := Item;
       tmp^.Next := S;
       S := tmp;
   end; (* Push *)

   procedure Pop (var S    : StackType;
                  var Item : StackElementType);

   var   tmp : StackPtr;

   begin
       if EmptyStack (S) then
           writeln('Error: Attempt to pop from an empty stack!')
       else
       begin
           tmp := S;
           Item := S^.Data;
           S := S^.Next;
           dispose (tmp);
           tmp := nil;
       end;
   end; (* Pop *)

   procedure DestroyStack (var S : StackType);

   var   tmp : StackType;

   begin
       while not EmptyStack (S) do
       begin
           tmp := S;
           S := S^.Next;
           dispose (tmp);
       end;
   end; (* DestroyStack *)

end. (* unit Stack *)