--
-- @filename stack_asm.adb
-- @author Julien Burdy & Vincent Decorges
-- @date 10.4.02
-- @brief An Abstract State Machine of stack
-- History  :
-- Date     Modification               Author
--
with Unchecked_Deallocation;
package body Stack_ASM is

   Stack : T_Stack := Empty_Stack;

   --Add an element at the beginning of the stack
   --Stack_Full_Error is raise if the stack is full
   procedure Push (Element : in T_Information) is

   begin

      Stack := new T_Element'(Element,Stack);

   exception

      when Storage_Error =>

         raise Stack_Full_Error;

   end Push;

   procedure Pop is
      procedure Delete is new Unchecked_Deallocation(T_Element, T_Stack);
      --Current element to delete
      Tmp : T_Stack := Stack;
   begin
      Stack := Stack.Next_Element;
      Delete(Tmp);
   end Pop;


   --Empty a stack
   procedure Empty is

      procedure Delete is new Unchecked_Deallocation(T_Element, T_Stack);

      --Current element to delete
      Tmp : T_Stack := Stack;

   begin

      --Delete all elements of the stack
      while Stack /= null loop

         Stack := Stack.Next_Element;
         Delete(Tmp);
         Tmp := Stack;

      end loop;

   end Empty;

   --Run through the stack and call treat for each Information
   procedure Run_Through is

      Tmp : T_Stack := Stack;

   begin

      while Tmp /= null loop

         Treat(Tmp.Information);
         Tmp := Tmp.Next_Element;

      end loop;

   end Run_Through;


   --Return true if the stack is empty
   function Empty return Boolean is

   begin

      return Stack = null;

   end Empty;

   --Return the length of the stack
   function Length return Natural is

      I : Natural := 0;
      Tmp : T_Stack := Stack;

   begin

      while Tmp /= null loop

         I := I + 1;
         Tmp := Tmp.Next_Element;

      end loop;

      return I;

   end Length;

   --Return the element at the head of the stack
   function Head return T_Information is
   begin
      if Stack = null then
         raise Stack_Empty_Error;
      else
         return Stack.Information;
      end if;
   end Head;

   function Sub_Head return T_Information is
   begin
      if Stack = null then
         raise Stack_Empty_Error;
      else
         return Stack.Next_Element.Information;
      end if;
   end Sub_Head;


end Stack_ASM;
