-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. The SPARK toolset is distributed in the hope that it will be
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
-- Public License for more details. You should have received a copy of the GNU
-- General Public License distributed with the SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================

with SparkMakeErrors;

package body Units is

   ----------------------------------------------------------
   -- This package body is NOT SPARK, and should never be  --
   -- presented to the Examiner                            --
   ----------------------------------------------------------

   ----------------------------------------------------------
   -- Sorting
   ----------------------------------------------------------

   procedure Sort (TheUnits : in out Stack) is
      Result : Stack;
      Id     : Unit.Id;

      function Insert (TheItem : Unit.Id;
                       InStack : Stack) return Stack
      -- Inserts TheItem into InStack according to the Unit.LessThan
      -- function.
      is
      begin
         if InStack = NullStack then
            -- The stack is empty so return a one entry stack
            return new Node'(TheItem => TheItem,
                             Next    => null);

         elsif Unit.Less_Than (L => TheItem,
                               R => InStack.all.TheItem) then
            -- TheItem belongs before the head.
            return new Node'(TheItem => TheItem,
                             Next    => InStack);

         else
            -- TheItem comes somewhere after the head
            return new Node'(TheItem => InStack.all.TheItem,
                             Next    => Insert (TheItem, InStack.all.Next));
         end if;
      end Insert;

   begin
      Result := NullStack;
      while TheUnits /= NullStack loop
         Pop (TheStack => TheUnits,
              TheUnit  => Id);
         Result := Insert (TheItem => Id,
                           InStack => Result);
      end loop;
      TheUnits := Result;
   exception
      when others =>
         SparkMakeErrors.Fatal ("Exception raised in Units.Sort");
   end Sort;

   ----------------------------------------------------------
   -- Stack operations
   ----------------------------------------------------------

   function InStack (TheUnit  : in Unit.Id;
                     TheStack : in Stack) return Boolean is
   begin
      if TheStack = NullStack then
         return False;
      elsif Unit.Are_Equal (L => TheUnit,
                            R => TheStack.all.TheItem) then
         return True;
      else
         return InStack (TheUnit  => TheUnit,
                         TheStack => TheStack.all.Next);
      end if;
   exception
      when others =>
         SparkMakeErrors.Fatal ("Exception raised in Units.InStack");
         return False;
   end InStack;

   procedure Push (TheStack : in out Stack;
                   TheUnit  : in     Unit.Id) is
   begin
      TheStack := new Node'(TheItem => TheUnit,
                            Next    => TheStack);
   exception
      when others =>
         SparkMakeErrors.Fatal ("Exception raised in Units.Push");
   end Push;

   procedure Pop (TheStack : in out Stack;
                  TheUnit  :    out Unit.Id) is
   begin
      TheUnit  := TheStack.all.TheItem;
      TheStack := TheStack.all.Next;
   exception
      when others =>
         SparkMakeErrors.Fatal ("Exception raised in Units.Pop");
   end Pop;

   function IsEmpty (TheStack : Stack) return Boolean is
   begin
      return TheStack = NullStack;
   exception
      when others =>
         SparkMakeErrors.Fatal ("Exception raised in Units.IsEmpty");
         return False;
   end IsEmpty;

   ----------------------------------------------------------
   -- Iteration
   ----------------------------------------------------------
   procedure Init_Iterator (TheStack    : in     Stack;
                            TheIterator :    out Iterator) is
   begin
      TheIterator := Iterator (TheStack);
   end Init_Iterator;

   function Iterated (TheIterator : in Iterator) return Boolean is
   begin
      return TheIterator = Iterator (NullStack);
   end Iterated;

   procedure Iterate (TheIterator : in out Iterator;
                      TheUnit     :    out Unit.Id) is
   begin
      TheUnit     := TheIterator.all.TheItem;
      TheIterator := Iterator (TheIterator.all.Next);
   exception
      when others =>
         SparkMakeErrors.Fatal ("Exception raised in Units.Iterate");
   end Iterate;

end Units;
