-------------------------------------------------------------------------------
-- (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 Maths;

use type Maths.Value; use type Maths.ErrorCode;

package body CompleteCheck is

   type TypTriStateRangeStatus is (NoneSet, SomeSet, AllSet);

   ------------------------------------------------------------------------------
   -- set all the elements in the specified range to true
   procedure SetRange (Data      : in out T;
                       RangeFrom : in     Integer;
                       RangeTo   : in     Integer)
   --# derives Data from *,
   --#                   RangeFrom,
   --#                   RangeTo;
   --# pre (RangeFrom - Data.LowerBound >= 0)
   --#   and (RangeTo - Data.LowerBound < ExaminerConstants.CompleteCheckSize);
   is
   begin
      for I in Integer range (RangeFrom - Data.LowerBound) .. (RangeTo - Data.LowerBound) loop

         --# assert (I in (RangeFrom - Data.LowerBound) ..
         --#           (RangeTo - Data.LowerBound))
         --#   and (Data.LowerBound = Data~.LowerBound);
         Data.Elements (I) := True;
      end loop;
   end SetRange;

   ------------------------------------------------------------------------------
   -- check whether none, some or all the elements in the specified range are true
   function CheckRange
     (Data      : T;
      RangeFrom : Integer;
      RangeTo   : Integer)
     return      TypTriStateRangeStatus
   --# pre (RangeFrom - Data.LowerBound >= 0) and
   --#   (RangeTo - Data.LowerBound < ExaminerConstants.CompleteCheckSize);
   is
      FalseSeen : Boolean := False;
      TrueSeen  : Boolean := False;
      Result    : TypTriStateRangeStatus;
   begin
      for I in Integer range (RangeFrom - Data.LowerBound) .. (RangeTo - Data.LowerBound) loop

         --# assert I in (RangeFrom - Data.LowerBound) ..
         --#   (RangeTo - Data.LowerBound);
         if Data.Elements (I) then
            TrueSeen := True;
         else
            FalseSeen := True;
         end if;
      end loop;

      if FalseSeen and not TrueSeen then
         Result := NoneSet;
      elsif TrueSeen and not FalseSeen then
         Result := AllSet;
      else
         Result := SomeSet;
      end if;

      return Result;
   end CheckRange;

   ------------------------------------------------------------------------------
   procedure Init
     (Data       :    out T;
      RangeFrom  : in     Integer;
      RangeTo    : in     Integer;
      RangeState :    out TypRangeState)
   is
      ActualUpperBound : Integer;
      -- vars that follow are so we can use Maths package to determine size of range
      MathsTo, MathsFrom, MathsLimit, MathsCalc1, MathsCalc2, MathsCalc3 : Maths.Value;
      CalcErr1, CalcErr2, CalcErr3                                       : Maths.ErrorCode;
      MathsError                                                         : Boolean := False;
   begin
      -- Check whether the entire type fits within the internal data type
      -- do calculation using Maths package to prevent overflows
      MathsTo    := Maths.IntegerToValue (RangeTo);
      MathsFrom  := Maths.IntegerToValue (RangeFrom);
      MathsLimit := Maths.IntegerToValue (ExaminerConstants.CompleteCheckSize);
      Maths.Subtract (MathsTo, MathsFrom,
                      -- to get
                      MathsCalc1, CalcErr1);
      Maths.Add (MathsCalc1, Maths.OneInteger,
                 -- to get
                 MathsCalc2, CalcErr2);
      Maths.LesserOrEqual (MathsCalc2, MathsLimit,
                           --to get
                           MathsCalc3, CalcErr3);
      if (CalcErr1 = Maths.NoError) and then (CalcErr2 = Maths.NoError) and then (CalcErr3 = Maths.NoError) then
         if MathsCalc3 = Maths.TrueValue then
            -- RangeTo - RangeFrom + 1 <= ExaminerConstants.CompleteCheckSize
            ActualUpperBound := RangeTo;
            RangeState       := RangeDoesFit;
         else --range to big or some error in calculating range
            ActualUpperBound := (RangeFrom + ExaminerConstants.CompleteCheckSize) - 1;
            RangeState       := RangeTooBig;
         end if;
      else
         ActualUpperBound := (RangeFrom + ExaminerConstants.CompleteCheckSize) - 1;
         RangeState       := RangeTooBig;
         MathsError       := True;
      end if;

      Data :=
        T'
        (LowerBound       => RangeFrom,
         ActualUpperBound => ActualUpperBound,
         OthersClause     => NotSeen,
         Elements         => ElementArray'(others => False),
         Undeterminable   => MathsError);

   end Init;

   ------------------------------------------------------------------------------
   procedure SeenElement
     (Data           : in out T;
      ElementNum     : in     Integer;
      OutOfRangeSeen :    out Boolean;
      OverlapState   :    out TypOverlapState)
   is
   begin
      -- check whether the number specified is within the range of the type
      if Data.LowerBound <= ElementNum and ElementNum <= Data.ActualUpperBound then
         -- if in range then check in array for whether the element has been
         -- seen before
         if Data.Elements (ElementNum - Data.LowerBound) then
            OverlapState := Overlap;
         else
            OverlapState := NoOverlap;
         end if;
         Data.Elements (ElementNum - Data.LowerBound) := True;
         OutOfRangeSeen                               := False;
      else
         -- if out of range then element has not been seen before
         OverlapState   := NoOverlap;
         OutOfRangeSeen := True;
      end if;
   end SeenElement;

   ------------------------------------------------------------------------------
   procedure SeenRange
     (Data           : in out T;
      RangeFrom      : in     Integer;
      RangeTo        : in     Integer;
      OutOfRangeSeen :    out Boolean;
      OverlapState   :    out TypOverlapState)
   is
      UpperLimitOfCheck : Integer;
      LowerLimitOfCheck : Integer;
      RangeStatus       : TypTriStateRangeStatus;
   begin
      -- if range specified is entirely outside range of type then
      -- return NoOverlap
      if RangeFrom > Data.ActualUpperBound or RangeTo < Data.LowerBound then
         OverlapState   := NoOverlap;
         OutOfRangeSeen := True;
      else
         -- otherwise process the range: which may be partially outside the
         -- range of the type
         -- initially assume in range
         OutOfRangeSeen := False;

         if RangeTo > Data.ActualUpperBound then
            UpperLimitOfCheck := Data.ActualUpperBound;
            OutOfRangeSeen    := True;
         else
            UpperLimitOfCheck := RangeTo;
         end if;

         if RangeFrom < Data.LowerBound then
            LowerLimitOfCheck := Data.LowerBound;
            OutOfRangeSeen    := True;
         else
            LowerLimitOfCheck := RangeFrom;
         end if;

         RangeStatus := CheckRange (Data, LowerLimitOfCheck, UpperLimitOfCheck);

         if RangeStatus = NoneSet then
            OverlapState := NoOverlap;
         else
            OverlapState := Overlap;
         end if;

         SetRange (Data, LowerLimitOfCheck, UpperLimitOfCheck);
      end if;
   end SeenRange;

   ------------------------------------------------------------------------------
   procedure SeenOthers (Data : in out T) is
   begin
      Data.OthersClause := Seen;
   end SeenOthers;

   ------------------------------------------------------------------------------
   function IsComplete (Data : T) return TypCompleteState is
      Result : TypCompleteState;
   begin
      if Data.OthersClause = Seen then
         Result := Complete;
      else
         if CheckRange (Data, Data.LowerBound, Data.ActualUpperBound) = AllSet then
            Result := Complete;
         else
            Result := Incomplete;
         end if;
      end if;

      return Result;
   end IsComplete;

end CompleteCheck;
