--  -----------------------------------------------------------------------
--  Title:       generic_elementary_functions
--  Last Mod:    Tue Jul 24 16:51:33 1990
--  Author:      Vincent Broman <broman@nosc.mil>
--   Copyright 1990 Vincent Broman
--     Permission granted to copy, modify, or compile this software for
--   one's own use, provided that this copyright notice is preserved intact.
--     Permission granted to distribute compiled binary copies of this
--   software which are linked in with some other application.
--     Permission granted to distribute other copies of this software,
--   provided that (1) any copy which is not source code, i.e. not in the
--   form in which the software is usually maintained, must be accompanied
--   by a copy of the source code from which it was compiled, and (2) the
--   one distributing it must refrain from imposing on the recipient
--   further restrictions on the distribution of this software.
--   
--  Visibility:  instantiatiated once globally in real_elementary_functions
--  Description: 
--               implementation of the proposed standard 
--               generic package of elementary math functions,
--               from the ISO-IEC/JTC1/SC22/WG9 (Ada)
--               Numerics Rapporteur Group proposal, Draft 1.1.
--               
--               This pkg body just dispatches to precision-specific
--               packages which implement the functions for the
--               user-defined types, single, double, and longest_float.
--               This approach avoids the problems with float types
--               that have range constraints.
-- 
--  Exceptions:  
--               constraint_error is raised only if the final result
--               of the function evaluation exceeds the range constraints
--               of the floating point type.
--  -----------------------------------------------------------------------
with float_types,
     single_elementary_functions,
     double_elementary_functions;

use float_types;

package body generic_elementary_functions is

   package sgl_fun renames single_elementary_functions;
   package dbl_fun renames double_elementary_functions;

   is_single: constant boolean := float_type'digits <= single'base'digits;
   -- only other possibility is double


   function sqrt (x : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.sqrt( single( x)));
      else
	 return float_type( dbl_fun.sqrt( double( x)));
      end if;
   end sqrt;
   
   
   function log (x : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.log( single( x)));
      else
	 return float_type( dbl_fun.log( double( x)));
      end if;
   end log;
   
   
   function log (x, base : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.log( single( x),
					 single( base)));
      else
	 return float_type( dbl_fun.log( double( x),
					 double( base)));
      end if;
   end log;
   
   
   function exp (x : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.exp( single( x)));
      else
	 return float_type( dbl_fun.exp( double( x)));
      end if;
   end exp;
   
   
   function "**" (x, y : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun."**"( single( x),
					  single( y)));
      else
	 return float_type( dbl_fun."**"( double( x),
					  double( y)));
      end if;
   end "**";
   
   
   function sin (x : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.sin( single( x)));
      else
	 return float_type( dbl_fun.sin( double( x)));
      end if;
   end sin;
   
   
   function sin (x, cycle : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.sin( single( x),
					 single( cycle)));
      else
	 return float_type( dbl_fun.sin( double( x),
					 double( cycle)));
      end if;
   end sin;
   
   
   function cos (x : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.cos( single( x)));
      else
	 return float_type( dbl_fun.cos( double( x)));
      end if;
   end cos;
   
   
   function cos (x, cycle : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.cos( single( x),
					 single( cycle)));
      else
	 return float_type( dbl_fun.cos( double( x),
					 double( cycle)));
      end if;
   end cos;
   
   
   function tan (x : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.tan( single( x)));
      else
	 return float_type( dbl_fun.tan( double( x)));
      end if;
   end tan;
   
   
   function tan (x, cycle : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.tan( single( x),
					 single( cycle)));
      else
	 return float_type( dbl_fun.tan( double( x),
					 double( cycle)));
      end if;
   end tan;
   
   
   function cot (x : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.cot( single( x)));
      else
	 return float_type( dbl_fun.cot( double( x)));
      end if;
   end cot;
   
   
   function cot (x, cycle : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.cot( single( x),
					 single( cycle)));
      else
	 return float_type( dbl_fun.cot( double( x),
					 double( cycle)));
      end if;
   end cot;
   
   
   function arcsin (x : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.arcsin( single( x)));
      else
	 return float_type( dbl_fun.arcsin( double( x)));
      end if;
   end arcsin;
   
   
   function arcsin (x, cycle : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.arcsin( single( x),
					    single( cycle)));
      else
	 return float_type( dbl_fun.arcsin( double( x),
					    double( cycle)));
      end if;
   end arcsin;
   
   
   function arccos (x : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.arccos( single( x)));
      else
	 return float_type( dbl_fun.arccos( double( x)));
      end if;
   end arccos;
   
   
   function arccos (x, cycle : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.arccos( single( x),
					    single( cycle)));
      else
	 return float_type( dbl_fun.arccos( double( x),
					    double( cycle)));
      end if;
   end arccos;
   
   
   function arctan (y : float_type;
		    x : float_type := 1.0) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.arctan( single( y),
					    single( x)));
      else
	 return float_type( dbl_fun.arctan( double( y),
					    double( x)));
      end if;
   end arctan;
   
   
   function arctan (y     : float_type;
		    x     : float_type := 1.0;
		    cycle : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.arctan( single( y),
					    single( x),
					    single( cycle)));
      else
	 return float_type( dbl_fun.arctan( double( y),
					    double( x),
					    double( cycle)));
      end if;
   end arctan;
   
   
   function arccot (x : float_type;
		    y : float_type := 1.0) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.arccot( single( x),
					    single( y)));
      else
	 return float_type( dbl_fun.arccot( double( x),
					    double( y)));
      end if;
   end arccot;
   
   
   function arccot (x     : float_type;
		    y     : float_type := 1.0;
		    cycle : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.arccot( single( x),
					    single( y),
					    single( cycle)));
      else
	 return float_type( dbl_fun.arccot( double( x),
					    double( y),
					    double( cycle)));
      end if;
   end arccot;
   
   
   function sinh (x : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.sinh( single( x)));
      else
	 return float_type( dbl_fun.sinh( double( x)));
      end if;
   end sinh;
   
   
   function cosh (x : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.cosh( single( x)));
      else
	 return float_type( dbl_fun.cosh( double( x)));
      end if;
   end cosh;
   
   
   function tanh (x : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.tanh( single( x)));
      else
	 return float_type( dbl_fun.tanh( double( x)));
      end if;
   end tanh;
   
   
   function coth (x : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.coth( single( x)));
      else
	 return float_type( dbl_fun.coth( double( x)));
      end if;
   end coth;
   
   
   function arcsinh (x : float_type) return float_type is
      
   begin
      if is_single then
	 return float_type( sgl_fun.arcsinh( single( x)));
      else
	 return float_type( dbl_fun.arcsinh( double( x)));
      end if;
   end arcsinh;
   
   
   function arccosh (x : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.arccosh( single( x)));
      else
	 return float_type( dbl_fun.arccosh( double( x)));
      end if;
   end arccosh;
   
   
   function arctanh (x : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.arctanh( single( x)));
      else
	 return float_type( dbl_fun.arctanh( double( x)));
      end if;
   end arctanh;
   
   
   function arccoth (x : float_type) return float_type is

   begin
      if is_single then
	 return float_type( sgl_fun.arccoth( single( x)));
      else
	 return float_type( dbl_fun.arccoth( double( x)));
      end if;
   end arccoth;
   

end generic_elementary_functions;

-- $Header: g2_elementary_functions_b.a,v 3.17 90/07/24 17:45:50 broman Stab $