--
-- 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.
   begin
      if P = null then
         return null;
      else
         -- 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
   begin
      if P /= null then
         -- Destroy the rest of the list.
         Destroy(P.Next);

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

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

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

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

   -- Stack operations.
   procedure Push(S: in out Stack; D: StackData'class) is
      Data: Data_Ptr;           -- Pointer to the dymically-allocated data.
   begin
      -- 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.
   begin
      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.
         Free(Zombie.Data);
         Free(Zombie);
      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
   begin
      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
   begin
      return S.Head = null;
   end Empty;

end GenStack;