-- ----------------------------------------------------------------------- -- Title: generic_elementary_functions -- Last Mod: Wed May 16 13:29:40 1990 -- Author: Vincent Broman -- 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, longest_float_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; package lgf_fun renames longest_float_elementary_functions; is_single: constant boolean := float_type'digits <= single'base'digits; is_double: constant boolean := float_type'digits > single'base'digits and float_type'digits <= double'base'digits; -- only other possibility is longest_float function sqrt (x : float_type) return float_type is begin if is_single then return float_type( sgl_fun.sqrt( single( x))); elsif is_double then return float_type( dbl_fun.sqrt( double( x))); else return float_type( lgf_fun.sqrt( longest_float( 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))); elsif is_double then return float_type( dbl_fun.log( double( x))); else return float_type( lgf_fun.log( longest_float( 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))); elsif is_double then return float_type( dbl_fun.log( double( x), double( base))); else return float_type( lgf_fun.log( longest_float( x), longest_float( 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))); elsif is_double then return float_type( dbl_fun.exp( double( x))); else return float_type( lgf_fun.exp( longest_float( 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))); elsif is_double then return float_type( dbl_fun."**"( double( x), double( y))); else return float_type( lgf_fun."**"( longest_float( x), longest_float( 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))); elsif is_double then return float_type( dbl_fun.sin( double( x))); else return float_type( lgf_fun.sin( longest_float( 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))); elsif is_double then return float_type( dbl_fun.sin( double( x), double( cycle))); else return float_type( lgf_fun.sin( longest_float( x), longest_float( 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))); elsif is_double then return float_type( dbl_fun.cos( double( x))); else return float_type( lgf_fun.cos( longest_float( 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))); elsif is_double then return float_type( dbl_fun.cos( double( x), double( cycle))); else return float_type( lgf_fun.cos( longest_float( x), longest_float( 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))); elsif is_double then return float_type( dbl_fun.tan( double( x))); else return float_type( lgf_fun.tan( longest_float( 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))); elsif is_double then return float_type( dbl_fun.tan( double( x), double( cycle))); else return float_type( lgf_fun.tan( longest_float( x), longest_float( 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))); elsif is_double then return float_type( dbl_fun.cot( double( x))); else return float_type( lgf_fun.cot( longest_float( 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))); elsif is_double then return float_type( dbl_fun.cot( double( x), double( cycle))); else return float_type( lgf_fun.cot( longest_float( x), longest_float( 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))); elsif is_double then return float_type( dbl_fun.arcsin( double( x))); else return float_type( lgf_fun.arcsin( longest_float( 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))); elsif is_double then return float_type( dbl_fun.arcsin( double( x), double( cycle))); else return float_type( lgf_fun.arcsin( longest_float( x), longest_float( 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))); elsif is_double then return float_type( dbl_fun.arccos( double( x))); else return float_type( lgf_fun.arccos( longest_float( 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))); elsif is_double then return float_type( dbl_fun.arccos( double( x), double( cycle))); else return float_type( lgf_fun.arccos( longest_float( x), longest_float( 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))); elsif is_double then return float_type( dbl_fun.arctan( double( y), double( x))); else return float_type( lgf_fun.arctan( longest_float( y), longest_float( 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))); elsif is_double then return float_type( dbl_fun.arctan( double( y), double( x), double( cycle))); else return float_type( lgf_fun.arctan( longest_float( y), longest_float( x), longest_float( 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))); elsif is_double then return float_type( dbl_fun.arccot( double( x), double( y))); else return float_type( lgf_fun.arccot( longest_float( x), longest_float( 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))); elsif is_double then return float_type( dbl_fun.arccot( double( x), double( y), double( cycle))); else return float_type( lgf_fun.arccot( longest_float( x), longest_float( y), longest_float( 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))); elsif is_double then return float_type( dbl_fun.sinh( double( x))); else return float_type( lgf_fun.sinh( longest_float( 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))); elsif is_double then return float_type( dbl_fun.cosh( double( x))); else return float_type( lgf_fun.cosh( longest_float( 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))); elsif is_double then return float_type( dbl_fun.tanh( double( x))); else return float_type( lgf_fun.tanh( longest_float( 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))); elsif is_double then return float_type( dbl_fun.coth( double( x))); else return float_type( lgf_fun.coth( longest_float( 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))); elsif is_double then return float_type( dbl_fun.arcsinh( double( x))); else return float_type( lgf_fun.arcsinh( longest_float( 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))); elsif is_double then return float_type( dbl_fun.arccosh( double( x))); else return float_type( lgf_fun.arccosh( longest_float( 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))); elsif is_double then return float_type( dbl_fun.arctanh( double( x))); else return float_type( lgf_fun.arctanh( longest_float( 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))); elsif is_double then return float_type( dbl_fun.arccoth( double( x))); else return float_type( lgf_fun.arccoth( longest_float( x))); end if; end arccoth; end generic_elementary_functions; -- $Header: g3_elementary_functions_b.a,v 3.15 90/05/16 14:55:48 broman Exp $