-------------------------------------------------------------------------------
-- (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 E_Strings;
with LexTokenManager;

use type LexTokenManager.Str_Comp_Result;

--# inherit E_Strings,
--#         LexTokenManager,
--#         SPARK_IO;

package Maths is
   type Value is private;

   NoValue     : constant Value;
   ZeroReal    : constant Value;
   ZeroInteger : constant Value;
   OneInteger  : constant Value;
   ExactHalf   : constant Value;
   TrueValue   : constant Value;
   FalseValue  : constant Value;

   type ErrorCode is (
                      NoError,
                      IllegalValue, --ie. not a valid SPARK literal
                      IllegalOperation, --ie. wrong for Value types passed
                      OverFlow, --ie. too many digits for array
                      DivideByZero,
                      TypeMismatch,
                      ConstraintError); --eg. pred(t'base'first)

   ----------------------------------------------------------------------------

   --Conversion of numeric literals
   procedure LiteralToValue (Str : in     LexTokenManager.Lex_String;
                             Num :    out Value;
                             OK  :    out ErrorCode);
   --# global in LexTokenManager.State;
   --# derives Num,
   --#         OK  from LexTokenManager.State,
   --#                  Str;
   --  post (Ok = NoError) or (Ok = illegalValue) or (Ok = overflow);
   ----------------------------------------------------------------------------

   function IntegerToValue (I : Integer) return Value;

   ---------------------------------------------------------------------------

   procedure StorageRep (Num : in     Value;
                         Rep :    out LexTokenManager.Lex_String);
   --# global in out LexTokenManager.State;
   --# derives LexTokenManager.State,
   --#         Rep                   from LexTokenManager.State,
   --#                                    Num;

   ----------------------------------------------------------------------------

   function ValueRep (StoreRep : LexTokenManager.Lex_String) return Value;
   --# global in LexTokenManager.State;
   --caution, although this function turns a LexString into a value it is
   --not the same as procedure LiteralToValue.  This one converts only
   --things which were first converted by StorageRep.  LiteralToValue can parse
   --any numeric literal to a value.

   ----------------------------------------------------------------------------

   function HasNoValue (Num : Value) return Boolean;
   pragma Inline (HasNoValue);

   ----------------------------------------------------------------------------

   function ValueToString (Num : Value) return E_Strings.T;

   ----------------------------------------------------------------------------

   procedure ValueToInteger (Num : in     Value;
                             Int :    out Integer;
                             Ok  :    out ErrorCode);
   --# derives Int,
   --#         Ok  from Num;
   --  post (Ok = NoError) or (Ok = TypeMismatch) or (Ok = overflow);

   ----------------------------------------------------------------------------

   procedure Negate (Num : in out Value);
   --# derives Num from *;
   --  pre Num.Sort = IntegerValue or Num.Sort = RealValue;

   ----------------------------------------------------------------------------

   procedure Absolute (Num : in out Value);
   --# derives Num from *;
   --  pre Num.Sort = IntegerValue or Num.Sort = RealValue;

   ----------------------------------------------------------------------------

   procedure ConvertToInteger (Num : in out Value);
   --# derives Num from *;
   --  pre Num.Sort = IntegerValue or Num.Sort = RealValue;

   ----------------------------------------------------------------------------

   procedure ConvertToReal (Num : in out Value);
   --# derives Num from *;
   --  pre Num.Sort = IntegerValue or Num.Sort = RealValue;

   ----------------------------------------------------------------------------

   procedure Floor (Val    : in     Value;
                    Result :    out Value;
                    OK     :    out ErrorCode);
   --# derives OK,
   --#         Result from Val;
   --  pre Val.Sort = IntegerValue or Val.Sort = RealValue;
   --  post (Ok = NoError) or (Ok = Overflow)

   ----------------------------------------------------------------------------

   procedure Ceiling (Val    : in     Value;
                      Result :    out Value;
                      OK     :    out ErrorCode);
   --# derives OK,
   --#         Result from Val;
   --  pre Val.Sort = IntegerValue or Val.Sort = RealValue;
   --  post (Ok = NoError) or (Ok = Overflow)

   ----------------------------------------------------------------------------

   procedure Add (FirstNum, SecondNum : in     Value;
                  Result              :    out Value;
                  Ok                  :    out ErrorCode);
   --# derives Ok,
   --#         Result from FirstNum,
   --#                     SecondNum;
   --  post (Ok = NoError) or (Ok = TypeMismatch) or (Ok = Overflow);

   ----------------------------------------------------------------------------

   procedure Subtract (FirstNum, SecondNum : in     Value;
                       Result              :    out Value;
                       Ok                  :    out ErrorCode);
   --# derives Ok,
   --#         Result from FirstNum,
   --#                     SecondNum;
   --  post (Ok = NoError) or (Ok = TypeMismatch) or (Ok = Overflow);

   ----------------------------------------------------------------------------

   procedure Multiply (FirstNum, SecondNum : in     Value;
                       Result              :    out Value;
                       Ok                  :    out ErrorCode);
   --# derives Ok,
   --#         Result from FirstNum,
   --#                     SecondNum;
   --  post (Ok = NoError) or (Ok = TypeMismatch) or (Ok = Overflow);

   ----------------------------------------------------------------------------

   procedure Divide (FirstNum, SecondNum : in     Value;
                     Result              :    out Value;
                     Ok                  :    out ErrorCode);
   --# derives Ok,
   --#         Result from FirstNum,
   --#                     SecondNum;
   --  post (Ok = NoError) or (Ok = TypeMismatch) or (Ok = Overflow) or
   --       (Ok = DivideByZero);

   ----------------------------------------------------------------------------

   procedure Modulus (FirstNum, SecondNum : in     Value;
                      Result              :    out Value;
                      Ok                  :    out ErrorCode);
   --# derives Ok,
   --#         Result from FirstNum,
   --#                     SecondNum;
   --  post (Ok = NoError) or (Ok = TypeMismatch) or (Ok = IllegalOperation) or
   --       (Ok = DivideByZero);

   ----------------------------------------------------------------------------

   procedure Remainder (FirstNum, SecondNum : in     Value;
                        Result              :    out Value;
                        Ok                  :    out ErrorCode);
   --# derives Ok,
   --#         Result from FirstNum,
   --#                     SecondNum;
   --  post (Ok = NoError) or (Ok = TypeMismatch) or (Ok = IllegalOperation) or
   --       (Ok = DivideByZero);

   ----------------------------------------------------------------------------

   procedure Greater (FirstNum, SecondNum : in     Value;
                      Result              :    out Value;
                      Ok                  :    out ErrorCode);
   --# derives Ok,
   --#         Result from FirstNum,
   --#                     SecondNum;
   --  post (Ok = NoError) or (Ok = TypeMismatch);

   ----------------------------------------------------------------------------

   procedure Lesser (FirstNum, SecondNum : in     Value;
                     Result              :    out Value;
                     Ok                  :    out ErrorCode);
   --# derives Ok,
   --#         Result from FirstNum,
   --#                     SecondNum;
   --  post (Ok = NoError) or (Ok = TypeMismatch);

   ----------------------------------------------------------------------------

   procedure LesserOrEqual (FirstNum, SecondNum : in     Value;
                            Result              :    out Value;
                            Ok                  :    out ErrorCode);
   --# derives Ok,
   --#         Result from FirstNum,
   --#                     SecondNum;
   --  post (Ok = NoError) or (Ok = TypeMismatch);

   ----------------------------------------------------------------------------

   procedure GreaterOrEqual (FirstNum, SecondNum : in     Value;
                             Result              :    out Value;
                             Ok                  :    out ErrorCode);
   --# derives Ok,
   --#         Result from FirstNum,
   --#                     SecondNum;
   --  post (Ok = NoError) or (Ok = TypeMismatch);

   ----------------------------------------------------------------------------

   procedure InsideRange (Val, LowerBound, UpperBound : in     Value;
                          Result                      :    out Value;
                          Ok                          :    out ErrorCode);
   --# derives Ok,
   --#         Result from LowerBound,
   --#                     UpperBound,
   --#                     Val;
   --  post (Ok = NoError) or (Ok = TypeMismatch);

   ----------------------------------------------------------------------------

   procedure OutsideRange (Val, LowerBound, UpperBound : in     Value;
                           Result                      :    out Value;
                           Ok                          :    out ErrorCode);
   --# derives Ok,
   --#         Result from LowerBound,
   --#                     UpperBound,
   --#                     Val;
   --  post (Ok = NoError) or (Ok = TypeMismatch);

   ----------------------------------------------------------------------------

   procedure RaiseByPower (FirstNum, SecondNum : in     Value;
                           Result              :    out Value;
                           Ok                  :    out ErrorCode);
   --# derives Ok,
   --#         Result from FirstNum,
   --#                     SecondNum;
   --  post (Ok = NoError) or (Ok = IllegalOperation) or (Ok = OverFlow);

   ----------------------------------------------------------------------------
   -- Support for non-numeric types
   ----------------------------------------------------------------------------
   function AndOp (LeftVal, RightVal : Value) return Value;
   ----------------------------------------------------------------------------
   function OrOp (LeftVal, RightVal : Value) return Value;
   ----------------------------------------------------------------------------
   function XorOp (LeftVal, RightVal : Value) return Value;
   ----------------------------------------------------------------------------
   procedure NotOp (TheVal : in out Value);
   --# derives TheVal from *;
   --  pre TheVal.Sort = TruthValue

   ----------------------------------------------------------------------------
   procedure ModularNotOp (TheVal     : in out Value;
                           TheModulus : in     Value);
   --# derives TheVal from *,
   --#                     TheModulus;
   --  pre TheVal.Sort = IntegerValue and IsAPositivePowerOf2 (TheModulus);

   ----------------------------------------------------------------------------

   procedure ValueToBool (TheVal : in     Value;
                          Result :    out Boolean;
                          Ok     :    out ErrorCode);
   --# derives Ok,
   --#         Result from TheVal;
   --  post (Ok = NoError) or (Ok = TypeMismatch)

   ----------------------------------------------------------------------------

   function BoolToValue (B : Boolean) return Value;

   ----------------------------------------------------------------------------

   procedure PredOp (TheVal : in out Value;
                     Ok     :    out ErrorCode);
   --# derives Ok,
   --#         TheVal from TheVal;
   --  post (Ok = NoError) or (Ok = TypeMismatch)

   ----------------------------------------------------------------------------

   procedure SuccOp (TheVal : in out Value;
                     Ok     :    out ErrorCode);
   --# derives Ok,
   --#         TheVal from TheVal;
   --  post (Ok = NoError) or (Ok = TypeMismatch)

   ----------------------------------------------------------------------------

   function MakeEnum (Pos : Natural) return Value;

   ----------------------------------------------------------------------------

   function IsIntegerValue (Val : Value) return Boolean;

   function IsRealValue (Val : Value) return Boolean;

   ----------------------------------------------------------------------------
   --converts real value to integer value rounding away from 0 as required by
   --Ada 95 LRM 4.9(33) and LRM 4.9(40).

   function Ada95RealToInteger (TheReal : Value) return Value;

   ----------------------------------------------------------------------------

   -- returns True for 1, 2, 4, 8, 16 ... useful for wellformedness
   -- of modular type declarations
   function IsAPositivePowerOf2 (Num : in Value) return Boolean;

private

   --------------- IMPORTANT -----------------------------------------------
   -- MaxLength defines the size of the numbers that can be supported
   -- to full precision.
   --
   -- If we want to support a floating point defined by
   --     1 sign bit
   --     e exponent bits
   --     s significand bits
   -- The largest number that can be represented is   2 ** (2**(e-1))
   -- The smallest number that can be represented is  2 ** -((2**(e-1))+s-1)
   --
   -- In order to represent any number in this range to the precision
   -- implied by the smallest number then in the numerator/denominator format
   -- the numerator must be able to represent 2 ** ((2**e) + s -1)

   -- So we require MaxLength > ((2**e) + s-1) log 2
   --
   --                                e    s     MaxLength >
   -- IEEE Single Precision Float    8    23     84
   -- IEEE Double Precision Float    11   52    632
   -------------------------------------------------------------------------

   MaxLength : constant Integer := 640;

   subtype LengthRange is Integer range 0 .. MaxLength;
   subtype PosRange is Integer range 1 .. MaxLength;

   type Digit is range 0 .. 15;
   for Digit'Size use 4;

   type ValueType is (RealValue, IntegerValue, TruthValue, UnknownValue);

   type ValueArray is array (PosRange) of Digit;
   pragma Pack (ValueArray);

   --NB.  Values are stored with LSD in Numerals(1) and MSD in
   --                                    Numerals(Length)
   type Part is record
      Numerals   : ValueArray;
      Length     : LengthRange;
      Overflowed : Boolean;
   end record;

   type Value is record
      Numerator   : Part;
      Denominator : Part;
      IsPositive  : Boolean;
      Sort        : ValueType;
   end record;

   ------------------------IMPORTANT--------------------------------------
   -- Modular Type support
   --
   -- The largest modular type supported is 2**BinaryMaxLength.
   --
   -- The value of BinaryMaxLength has an upper bound of
   --    |_ MaxLength / Log 2 _|
   -- which is the largest power of 2 that can be evaluated in a ValueArray.
   --
   -- These values are stored with LSB in element 0,
   -- and MSB in element BinaryMaxLength
   -----------------------------------------------------------------------
   BinaryMaxLength : constant Integer := 211;
   subtype BinaryLengthRange is Integer range 0 .. BinaryMaxLength;
   type Bits is array (BinaryLengthRange) of Boolean;

   ZeroBits : constant Bits := Bits'(others => False);

   ZeroPart : constant Part := Part'(Length     => 1,
                                     Numerals   => ValueArray'(PosRange => 0),
                                     Overflowed => False);

   OnePart : constant Part := Part'(Length     => 1,
                                    Numerals   => ValueArray'(1      => 1,
                                                              others => 0),
                                    Overflowed => False);

   TwoPart : constant Part := Part'(Length     => 1,
                                    Numerals   => ValueArray'(1      => 2,
                                                              others => 0),
                                    Overflowed => False);

   ZeroReal : constant Value := Value'(Numerator   => ZeroPart,
                                       Denominator => OnePart,
                                       IsPositive  => True,
                                       Sort        => RealValue);

   ExactHalf : constant Value := Value'(Numerator   => OnePart,
                                        Denominator => TwoPart,
                                        IsPositive  => True,
                                        Sort        => RealValue);

   ZeroInteger : constant Value :=
     Value'(Numerator   => ZeroPart,
            Denominator => OnePart,
            IsPositive  => True,
            Sort        => IntegerValue);

   OneInteger : constant Value := Value'(Numerator   => OnePart,
                                         Denominator => OnePart,
                                         IsPositive  => True,
                                         Sort        => IntegerValue);

   NoValue : constant Value := Value'(Numerator   => ZeroPart,
                                      Denominator => OnePart,
                                      IsPositive  => True,
                                      Sort        => UnknownValue);

   FalseValue : constant Value := Value'(Numerator   => ZeroPart,
                                         Denominator => ZeroPart,
                                         IsPositive  => False,
                                         Sort        => TruthValue);

   TrueValue : constant Value := Value'(Numerator   => ZeroPart,
                                        Denominator => ZeroPart,
                                        IsPositive  => True,
                                        Sort        => TruthValue);
end Maths;
