OO Generalized Stack Body
MC logo

OO Generalized Stack Body

Ada Code Examples

<<OO Generalized Stack Package Download OO Integer Stack Package>>
-- Body for generalized stack.

with Ada.Unchecked_Deallocation;

package body GenStack is
   -- Deallocators needed here.
   procedure Free is new Ada.Unchecked_Deallocation(Node, Node_Ptr);
   procedure Free is new Ada.Unchecked_Deallocation(StackData'Class, Data_Ptr);

   -- Make and return a copy of the stack nodes.  Recursion saves a lot of
   -- of picky detail work.
   function CopyOf(P: Node_Ptr) return Node_Ptr is
      Data: Data_Ptr;           -- Pointer to the dymically-allocated data.
      RestCopied: Node_Ptr;     -- Copy of the rest of the list.
      if P = null then
         return null;
         -- Copy the rest of the list.  Get a pointer to it.
         RestCopied := CopyOf(P.Next);

         -- Allocate space for the data.  This form of new (eccch) will
         -- allocate an object of the same dynamic type as P.Data.all.
         Data := new StackData'class'(P.Data.all);

         -- Make a node to hold those two wonderful fields we just created.
         return new Node'(Data, RestCopied);
      end if;
   end CopyOf;

   -- Destroy the list.
   procedure Destroy(P: in out Node_Ptr) is
      if P /= null then
         -- Destroy the rest of the list.

         -- Obliterate the data space, then the node, and clear the pointer.
         P := null;
      end if;

   -- Create the stack empty.  Not too hard.
   procedure Initialize(S: in out Stack) is
      S.Head := null;
   end Initialize;

   -- Destroy a stack on its way out.
   procedure Finalize(S: in out Stack) is

   -- Adjust the copy after assignment.  This involves making an
   -- independent copy of nodes.
   procedure Adjust(S: in out Stack) is
      S.Head := CopyOf(S.Head);

   -- Stack operations.
   procedure Push(S: in out Stack; D: StackData'class) is
      Data: Data_Ptr;           -- Pointer to the dymically-allocated data.
      -- Allocate a dynamic copy of the data.  The object allocated takes
      -- the value of D, and also its type, which can be StackData or any of
      -- its descendants.
      Data := new StackData'class'(D);

      -- Add a node with this data to the front of the list.
      S.Head := new Node'(Data, S.Head);
   end Push;

   procedure Pop(S: in out Stack; D: in out StackData'class) is
      Zombie: Node_Ptr;         -- Node to be deleted.
      if S.head /= null then
         -- Retain the existing head pointer, then advance it.
         Zombie := S.Head;
         S.Head := S.Head.Next;

         -- Report the data from the former head node to the caller.
         D := Zombie.Data.all;

         -- Free the data part, and also the node itself.
      end if;
   end Pop;

   -- Fill in Data with the top of the stack, if any.
   procedure Top(S: Stack; Data: in out StackData'class) is
      if S.Head /= null then
         Data := S.Head.Data.all;
      end if;
   end Top;

   -- Tell if the generalized stack is empty.
   function Empty(S: Stack) return Boolean is
      return S.Head = null;
   end Empty;

end GenStack;
<<OO Generalized Stack Package OO Integer Stack Package>>