-- This package provides any reasonable number of digits precision in
-- base 10 floating point arithmetic.
--
-- Usage: to get 100 digits precision and use standard FLOAT for conversions
--
--   type DIGITS_100 is range 0 .. 100 ;
--   package ARITHMETIC_100 is new GENERIC_DIGITS_ARITHMETIC(DIGITS_100,FLOAT);
--   use ARITHMETIC_100 ; -- convenient for + - * / ** rem
--
--   YOUR_VALUE : D_NUMBER ; -- your objects of 100 digits precision
--   YOUR_VALUE : D_NUMBER := INTEGER_TO_D_NUMBER ( 7 ) ; -- integer init
--   YOUR_VALUE : D_NUMBER := REAL_TO_D_NUMBER ( X ) ; -- real initialization
--   GET ( "1234567898765432.12345E-1259" , YOUR_VALUE , LAST ) ; 
--                                                         string to D_NUMBER
--
--
-- written 28 May 1987 by Jon S. Squire
-- revised 22 Nov 1987 "
-- Copyright 1987 Westinghouse Electric Corporation
--

with TEXT_IO ; use TEXT_IO ; -- needed to define GET and PUT
generic
  type SIZE is range <> ;  -- range is 0..NUMBER_OF_DIGITS
  type REAL is digits <> ;  -- some real type for conversions

package GENERIC_DIGITS_ARITHMETIC is

  type D_NUMBER is private ;

--  DIGITS_ZERO : D_NUMBER ; -- must be expressed as a function due to private

  function DIGITS_ZERO return D_NUMBER ; -- 0.0

  function DIGITS_ONE return D_NUMBER ; -- 1.0

  function DIGITS_EPSILON return D_NUMBER ; -- 10.0 ** (-SIZE'LAST)

  function DIGITS_LAST return D_NUMBER ; -- 0.999... * 10.0 ** INTEGER'LAST-1

  function DIGITS_FIRST return D_NUMBER ; -- - DIGITS'LAST

  function DIGITS_SMALL return D_NUMBER ; -- about 10.0 ** (-INTEGER'LAST+1)

-- arithmetic operators 

  function "+" ( LEFT , RIGHT : D_NUMBER ) return D_NUMBER ;

  function "-" ( LEFT , RIGHT : D_NUMBER ) return D_NUMBER ;

  function "*" ( LEFT , RIGHT : D_NUMBER ) return D_NUMBER ;

  function "/" ( LEFT , RIGHT : D_NUMBER ) return D_NUMBER ;

  function "**" ( LEFT : D_NUMBER ;
                  RIGHT : INTEGER ) return D_NUMBER ;

  function "+" ( RIGHT : D_NUMBER ) return D_NUMBER ;

  function "-" ( RIGHT : D_NUMBER ) return D_NUMBER ;

  function "abs" ( RIGHT : D_NUMBER ) return D_NUMBER ;

--function "=" and "/=" are defined for the type D_NUMBER

  function ">" ( LEFT , RIGHT : D_NUMBER ) return BOOLEAN ;

  function ">=" ( LEFT , RIGHT : D_NUMBER ) return BOOLEAN ;

  function "<" ( LEFT , RIGHT : D_NUMBER ) return BOOLEAN ;

  function "<=" ( LEFT , RIGHT : D_NUMBER ) return BOOLEAN ;

-- Conversion routines with type INTEGER are exact for integer values.
-- Beware of overflow, it will raise CONSTRAINT_ERROR

  function D_NUMBER_TO_INTEGER ( ITEM : D_NUMBER ) return INTEGER ;

  function INTEGER_TO_D_NUMBER ( ITEM : INTEGER ) return D_NUMBER ;

-- Conversion routines with type REAL are approximate.
-- Beware of overflow, it will raise CONSTRAINT_ERROR

  function D_NUMBER_TO_REAL ( ITEM : D_NUMBER ) return REAL ;

  function REAL_TO_D_NUMBER ( ITEM : REAL ) return D_NUMBER ;

-- PUT and GET similar to thoes of FLOAT in TEXT_IO

  DEFAULT_FORE : FIELD := 2 ;
  DEFAULT_AFT  : FIELD := FIELD ( SIZE'LAST ) ;
  DEFAULT_EXP  : FIELD := 11 ;

  procedure PUT ( FILE : in FILE_TYPE ;
                  ITEM : in D_NUMBER ;
                  FORE : in FIELD := DEFAULT_FORE ;
                  AFT  : in FIELD := DEFAULT_AFT ;
                  EXP  : in FIELD := DEFAULT_EXP ) ;

  procedure PUT ( ITEM : in D_NUMBER ;
                  FORE : in FIELD := DEFAULT_FORE ;
                  AFT  : in FIELD := DEFAULT_AFT ;
                  EXP  : in FIELD := DEFAULT_EXP ) ;

  procedure PUT ( TO   : out STRING ;
                  ITEM : in D_NUMBER ;
                  AFT  : in FIELD := DEFAULT_AFT ;
                  EXP  : in FIELD := DEFAULT_EXP ) ;

  procedure GET ( FILE : in FILE_TYPE ;
                  ITEM : out D_NUMBER ;
                  WIDTH : in FIELD := 0 ) ;

  procedure GET ( ITEM : out D_NUMBER ;
                  WIDTH : in FIELD := 0 ) ;

  procedure GET ( FROM : in STRING ;
                  ITEM : out D_NUMBER ;
                  LAST : out POSITIVE ) ;

-- Decompose a floating point D_NUMBER into a sign * mantissa * 10 ** exponent
-- where  0.1 <= MANTISSA < 1.0  or  0.0 if X = 0.0
--        SIGN = +1 for X positive or zero, SIGN = -1 for X negative
--        EXPONENT is the power of ten

  procedure DE_FLOAT ( X : D_NUMBER ;
                       SIGN : out INTEGER ;
                       MANTISSA : out D_NUMBER ;
                       EXPONENT : out INTEGER ) ;

-- Reform a floating point D_NUMBER from  sign * mantissa * 10 ** exponent
-- where  0.1 <= MANTISSA < 1.0  or  0.0 if X = 0.0
--        SIGN = +1 for X positive or zero, SIGN = -1 for X negative
--        EXPONENT is the power of ten

  procedure RE_FLOAT ( X : out D_NUMBER ;
                       SIGN : INTEGER ;
                       MANTISSA : D_NUMBER ;
                       EXPONENT : INTEGER ) ;

-- This is an exact remainder operation

  function "rem" ( LEFT , RIGHT : D_NUMBER ) return D_NUMBER ;

-- five elementary functions from which other functions can be computed

  function SQRT ( X : D_NUMBER ) return D_NUMBER ;

  function LOG ( X : D_NUMBER ) return D_NUMBER ;

  function EXP ( X : D_NUMBER ) return D_NUMBER ;

  function ATAN2 ( Y , X : D_NUMBER ) return D_NUMBER ;

  function SIN ( X : D_NUMBER ) return D_NUMBER ;

--  useful constants to digits precision

  function NATURAL_E return D_NUMBER ;

  function PI return D_NUMBER ;

  function LN_10 return D_NUMBER ;

  function LN_2 return D_NUMBER ;

  function NORMALIZE ( ITEM : D_NUMBER ) return D_NUMBER ;

private
  type D_ARRAY is array ( SIZE ) of INTEGER ;
  type D_SIGN is ( PLUS , MINUS ) ;
  type D_NUMBER is
    record
      SIGN : D_SIGN := PLUS ;
      EXP : INTEGER := 0 ;
      D_DIGITS : D_ARRAY := ( SIZE => 0 ) ;
    end record ;
end GENERIC_DIGITS_ARITHMETIC ;