with Standard_Natural_Numbers;           use Standard_Natural_Numbers;
with Standard_Integer_Numbers;           use Standard_Integer_Numbers;
with Standard_Floating_Numbers;          use Standard_Floating_Numbers;

package Penta_Double_Numbers is

-- DESCRIPTION :
--   This package defines penta double numbers and the arithmetic
--   to obtain 5 times the precision of the (standard hardware) doubles.

-- ACKNOWLEDGEMENTS :
--   The code is based on QD-2.3.9 (Y. Hida, X.S. Li, and D.H. Bailey),
--   for the parallels with double double and quad double arithmetic.
--   Definitions are based on the code generated by the CAMPARY library.
--   CAMPARY is the CudA Multiple Precision ARithmetic librarY,
--   by Mioara Joldes, Olivier Marty, Jean-Michel Muller,
--   Valentina Popescu and Warwick Tucker. 

  type penta_double is private;

-- CONSTRUCTORS :

  function create ( i : integer ) return penta_double;

  -- DECRIPTION :
  --   Returns the penta double representation of the standard integer i.

  function create ( n : natural32 ) return penta_double;
  function create ( n : natural64 ) return penta_double;

  -- DESCRIPTION :
  --   Returns the penta double representation of the 32-bit or 64-bit
  --   machine natural number n.

  function create ( i : integer32 ) return penta_double;
  function create ( i : integer64 ) return penta_double;

  -- DESCRIPTION :
  --   Returns the penta double representation of the 32-bit or 64-bit
  --   machine integer number i.

  function create ( x : double_float ) return penta_double;

  -- DESCRIPTION :
  --   The highest word in the penta double on return equals x.

  function create ( thumb,index,middle,ring,pink : double_float )
                  return penta_double;

  -- DESCRIPTION :
  --   Constructs a penta double from the five given doubles,
  --   given in order of significance.

  function "abs" ( x : penta_double ) return penta_double;

  -- DESCRIPTION :
  --   Returns the absolute value of x.

  function AbsVal ( x : penta_double ) return penta_double; -- same as abs

  function floor ( x : penta_double ) return penta_double;

  -- DESCRIPTION :
  --   Returns nearest lower integer to x.

  function nint ( x : penta_double ) return penta_double;

  -- DESCRIPTION :
  --   Returns the nearest integer to x.

-- SELECTORS :

  function thumb_part ( x : penta_double ) return double_float;

  -- DESCRIPTION :
  --   Returns the most significant part of the penta double x.

  function index_part ( x : penta_double ) return double_float;

  -- DESCRIPTION :
  --   Returns the second most significant part of the penta double x.

  function middle_part ( x : penta_double ) return double_float;

  -- DESCRIPTION :
  --   Returns the third most significant part of the penta double x.

  function ring_part ( x : penta_double ) return double_float;

  -- DESCRIPTION :
  --   Returns the second least significant part of the penta double x.

  function pink_part ( x : penta_double ) return double_float;

  -- DESCRIPTION :
  --   Returns the least significant part of the penta double x.

-- TYPE CASTS :

  function to_int ( x : penta_double ) return integer32;

  -- DESCRIPTION :
  --   Converts the highest word into a 32-bit integer;

  function to_double ( x : penta_double ) return double_float;

  -- DESCRIPTION :
  --   Returns thumb_part(x).

-- COMPARISON and COPYING :

  function is_zero ( x : penta_double ) return boolean;

  -- DESCRIPTION :
  --   Returns true if x is zero, returns false otherwise.

  function is_one ( x : penta_double ) return boolean;

  -- DESCRIPTION :
  --   Returns true if x is one, returns false otherwise.

  function is_positive ( x : penta_double ) return boolean;

  -- DESCRIPTION : 
  --   Returns true if x is positive, returns false otherwise.

  function is_negative ( x : penta_double ) return boolean;

  -- DESCRIPTION : 
  --   Returns true if x is negative, returns false otherwise.

  function equal ( x,y : penta_double ) return boolean;
  function equal ( x : penta_double; y : double_float ) return boolean;

  function "<" ( x,y : penta_double ) return boolean;
  function "<" ( x : penta_double; y : double_float ) return boolean;
  function "<" ( x : double_float; y : penta_double ) return boolean;
  function "<=" ( x,y : penta_double ) return boolean;
  function "<=" ( x : penta_double; y : double_float ) return boolean;
  function "<=" ( x : double_float; y : penta_double ) return boolean;

  function ">" ( x,y : penta_double ) return boolean;
  function ">" ( x : penta_double; y : double_float ) return boolean;
  function ">" ( x : double_float; y : penta_double ) return boolean;
  function ">=" ( x,y : penta_double ) return boolean;
  function ">=" ( x : penta_double; y : double_float ) return boolean;
  function ">=" ( x : double_float; y : penta_double ) return boolean;

  procedure copy ( x : in penta_double; y : in out penta_double );

-- ARITHMETICAL FUNCTIONS :

  function "+" ( x,y : penta_double ) return penta_double; -- returns x+y
  function "+" ( x : penta_double; y : double_float ) return penta_double;
  function "+" ( x : double_float; y : penta_double ) return penta_double;
  function "+" ( x : penta_double ) return penta_double;   -- returns copy

  function "-" ( x : penta_double ) return penta_double;   -- returns -x
  function "-" ( x,y : penta_double ) return penta_double; -- returns x-y
  function "-" ( x : penta_double; y : double_float ) return penta_double;
  function "-" ( x : double_float; y : penta_double ) return penta_double;

  function "*" ( x,y : penta_double ) return penta_double; -- returns x*y
  function "*" ( x : penta_double; y : double_float ) return penta_double;
  function "*" ( x : double_float; y : penta_double ) return penta_double;

  function Mul_pwr2 ( x : penta_double; y : double_float ) -- y = 2^k
                    return penta_double;
  procedure Mul_pwr2 ( x : in out penta_double; y : in double_float );
  -- multiplies x with y, where y is a power of 2

  function "/" ( x,y : penta_double ) return penta_double; -- returns x/y
  function "/" ( x : penta_double; y : double_float ) return penta_double;
  function "/" ( x : double_float; y : penta_double ) return penta_double;

  function sqr ( x : penta_double ) return penta_double;   -- return x*x
  function "**" ( x : penta_double; n : integer ) return penta_double; -- x^n

  function ldexp ( x : penta_double; n : integer ) return penta_double;
  -- returns (2^n)*x
  function "**" ( x,y : penta_double ) return penta_double; -- x^y
  function "**" ( x : penta_double; y : double_float ) return penta_double;

  function exp ( x : penta_double ) return penta_double;   -- returns exp(x)
  function log ( x : penta_double ) return penta_double;   -- natural log
  function log10 ( x : penta_double ) return penta_double; -- decimal log

-- ARITHMETICAL OPERATIONS AS PROCEDURES :

  procedure Add ( x : in out penta_double; y : in penta_double ); -- x := x+y
  procedure Sub ( x : in out penta_double; y : in penta_double ); -- x := x-y
  procedure Min ( x : in out penta_double );                      -- x:= -x
  procedure Mul ( x : in out penta_double; y : in penta_double ); -- x := x*y
  procedure Div ( x : in out penta_double; y : in penta_double ); -- x := x/y

-- DESTRUCTOR :

  procedure clear ( x : in out penta_double ); -- sets x to zero

private

-- DATA STRUCTURE :
--   Five doubles define a penta double number.
--   The parts of a penta double are stored as five doubles in a record.
--   The names of the parts are the names of the fingers,
--   starting with the thumb for the most significant part
--   and ending with pink for the least significant part.

  type penta_double is record
    thumb : double_float;  -- highest double, most significant part
    index : double_float;  -- second most significant double
    middle : double_float; -- middle double, third most significant part
    ring : double_float;   -- second least significant double
    pink : double_float;   -- lowest double, least significant part
  end record;

end Penta_Double_Numbers;
