File : a-ngelfu-ada.adb


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUNTIME COMPONENTS                          --
   4 --                                                                          --
   5 --                ADA.NUMERICS.GENERIC_ELEMENTARY_FUNCTIONS                 --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 --                                                                          --
  19 --                                                                          --
  20 --                                                                          --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31 
  32 --  This is the Ada Cert Math specific version of a-ngelfu.adb
  33 
  34 --  This body does not implement Ada.Numerics.Generic_Elementary_Functions as
  35 --  defined by the standard. See the package specification for more details.
  36 
  37 with Ada.Numerics.Elementary_Functions;
  38 with Ada.Numerics.Long_Elementary_Functions;
  39 with Ada.Numerics.Long_Long_Elementary_Functions;
  40 
  41 use Ada.Numerics.Elementary_Functions;
  42 use Ada.Numerics.Long_Elementary_Functions;
  43 use Ada.Numerics.Long_Long_Elementary_Functions;
  44 
  45 package body Ada.Numerics.Generic_Elementary_Functions is
  46 
  47    subtype T is Float_Type'Base;
  48 
  49    subtype F is Float;
  50    subtype LF is Long_Float;
  51    subtype LLF is Long_Long_Float;
  52 
  53    Is_Float : constant Boolean :=
  54      T'Machine_Mantissa = Float'Machine_Mantissa
  55      and then Float (T'First) = Float'First
  56      and then Float (T'Last) = Float'Last;
  57 
  58    Is_Long_Float : constant Boolean :=
  59      T'Machine_Mantissa = Long_Float'Machine_Mantissa
  60      and then Long_Float (T'First) = Long_Float'First
  61      and then Long_Float (T'Last) = Long_Float'Last;
  62 
  63    Is_Long_Long_Float : constant Boolean :=
  64      not (T'Machine_Mantissa = Long_Float'Machine_Mantissa)
  65      and then T'Machine_Mantissa = Long_Long_Float'Machine_Mantissa
  66      and then Long_Long_Float (T'First) = Long_Long_Float'First
  67      and then Long_Long_Float (T'Last) = Long_Long_Float'Last;
  68 
  69    ----------
  70    -- "**" --
  71    ----------
  72 
  73    function "**" (Left, Right : Float_Type'Base) return Float_Type'Base is
  74      (if Is_Float then T (F (Left) ** F (Right))
  75       elsif Is_Long_Float then T (LF (Left) ** LF (Right))
  76       elsif Is_Long_Long_Float then T (LLF (Left) ** LLF (Right))
  77       else raise Program_Error);
  78 
  79    ------------
  80    -- Arccos --
  81    ------------
  82 
  83    --  Natural cycle
  84 
  85    function Arccos (X : Float_Type'Base) return Float_Type'Base is
  86      (if Is_Float then T (Arccos (F (X)))
  87       elsif Is_Long_Float then T (Arccos (LF (X)))
  88       elsif Is_Long_Long_Float then T (Arccos (LLF (X)))
  89       else raise Program_Error);
  90 
  91    --  Arbitrary cycle
  92 
  93    function Arccos (X, Cycle : Float_Type'Base) return Float_Type'Base is
  94      (if Is_Float then T (Arccos (F (X), F (Cycle)))
  95       elsif Is_Long_Float then T (Arccos (LF (X), LF (Cycle)))
  96       elsif Is_Long_Long_Float then T (Arccos (LLF (X), LLF (Cycle)))
  97       else raise Program_Error);
  98 
  99    -------------
 100    -- Arccosh --
 101    -------------
 102 
 103    function Arccosh (X : Float_Type'Base) return Float_Type'Base is
 104      (if Is_Float then T (Arccosh (F (X)))
 105       elsif Is_Long_Float then T (Arccosh (LF (X)))
 106       elsif Is_Long_Long_Float then T (Arccosh (LLF (X)))
 107       else raise Program_Error);
 108 
 109    ------------
 110    -- Arccot --
 111    ------------
 112 
 113    --  Natural cycle
 114 
 115    function Arccot
 116      (X    : Float_Type'Base;
 117       Y    : Float_Type'Base := 1.0)
 118       return Float_Type'Base
 119    is
 120      (if Is_Float then T (Arccot (F (X), F (Y)))
 121       elsif Is_Long_Float then T (Arccot (LF (X), LF (Y)))
 122       elsif Is_Long_Long_Float then T (Arccot (LLF (X), LLF (Y)))
 123       else raise Program_Error);
 124 
 125    --  Arbitrary cycle
 126 
 127    function Arccot
 128      (X     : Float_Type'Base;
 129       Y     : Float_Type'Base := 1.0;
 130       Cycle : Float_Type'Base)
 131       return  Float_Type'Base
 132    is
 133      (if Is_Float then T (Arccot (F (X), F (Y), F (Cycle)))
 134       elsif Is_Long_Float then T (Arccot (LF (X), LF (Y), LF (Cycle)))
 135       elsif Is_Long_Long_Float then T (Arccot (LLF (X), LLF (Y), LLF (Cycle)))
 136       else raise Program_Error);
 137 
 138    -------------
 139    -- Arccoth --
 140    -------------
 141 
 142    function Arccoth (X : Float_Type'Base) return Float_Type'Base
 143    is
 144      (if Is_Float then T (Arccoth (F (X)))
 145       elsif Is_Long_Float then T (Arccoth (LF (X)))
 146       elsif Is_Long_Long_Float then T (Arccoth (LLF (X)))
 147       else raise Program_Error);
 148 
 149    ------------
 150    -- Arcsin --
 151    ------------
 152 
 153    --  Natural cycle
 154 
 155    function Arcsin (X : Float_Type'Base) return Float_Type'Base is
 156      (if Is_Float then T (Arcsin (F (X)))
 157       elsif Is_Long_Float then T (Arcsin (LF (X)))
 158       elsif Is_Long_Long_Float then T (Arcsin (LLF (X)))
 159       else raise Program_Error);
 160 
 161    --  Arbitrary cycle
 162 
 163    function Arcsin (X, Cycle : Float_Type'Base) return Float_Type'Base is
 164      (if Is_Float then T (Arcsin (F (X), F (Cycle)))
 165       elsif Is_Long_Float then T (Arcsin (LF (X), LF (Cycle)))
 166       elsif Is_Long_Long_Float then T (Arcsin (LLF (X), LLF (Cycle)))
 167       else raise Program_Error);
 168 
 169    -------------
 170    -- Arcsinh --
 171    -------------
 172 
 173    function Arcsinh (X : Float_Type'Base) return Float_Type'Base is
 174      (if Is_Float then T (Arcsinh (F (X)))
 175       elsif Is_Long_Float then T (Arcsinh (LF (X)))
 176       elsif Is_Long_Long_Float then T (Arcsinh (LLF (X)))
 177       else raise Program_Error);
 178 
 179    ------------
 180    -- Arctan --
 181    ------------
 182 
 183    --  Natural cycle
 184 
 185    function Arctan
 186      (Y    : Float_Type'Base;
 187       X    : Float_Type'Base := 1.0)
 188       return Float_Type'Base
 189    is
 190      (if Is_Float then T (Arctan (F (Y), F (X)))
 191       elsif Is_Long_Float then T (Arctan (LF (Y), LF (X)))
 192       elsif Is_Long_Long_Float then T (Arctan (LLF (Y), LLF (X)))
 193       else raise Program_Error);
 194 
 195    --  Arbitrary cycle
 196 
 197    function Arctan
 198      (Y     : Float_Type'Base;
 199       X     : Float_Type'Base := 1.0;
 200       Cycle : Float_Type'Base)
 201       return  Float_Type'Base
 202    is
 203      (if Is_Float then T (Arctan (F (Y), F (X), F (Cycle)))
 204       elsif Is_Long_Float then T (Arctan (LF (Y), LF (X), LF (Cycle)))
 205       elsif Is_Long_Long_Float then T (Arctan (LLF (Y), LLF (X), LLF (Cycle)))
 206       else raise Program_Error);
 207 
 208    -------------
 209    -- Arctanh --
 210    -------------
 211 
 212    function Arctanh (X : Float_Type'Base) return Float_Type'Base is
 213      (if Is_Float then T (Arctanh (F (X)))
 214       elsif Is_Long_Float then T (Arctanh (LF (X)))
 215       elsif Is_Long_Long_Float then T (Arctanh (LLF (X)))
 216       else raise Program_Error);
 217 
 218    ---------
 219    -- Cos --
 220    ---------
 221 
 222    --  Natural cycle
 223 
 224    function Cos (X : Float_Type'Base) return Float_Type'Base is
 225      (if Is_Float then T (Cos (F (X)))
 226       elsif Is_Long_Float then T (Cos (LF (X)))
 227       elsif Is_Long_Long_Float then T (Cos (LLF (X)))
 228       else raise Program_Error);
 229 
 230    --  Arbitrary cycle
 231 
 232    function Cos (X, Cycle : Float_Type'Base) return Float_Type'Base is
 233      (if Is_Float then T (Cos (F (X), F (Cycle)))
 234       elsif Is_Long_Float then T (Cos (LF (X), LF (Cycle)))
 235       elsif Is_Long_Long_Float then T (Cos (LLF (X), LLF (Cycle)))
 236       else raise Program_Error);
 237 
 238    ----------
 239    -- Cosh --
 240    ----------
 241 
 242    function Cosh (X : Float_Type'Base) return Float_Type'Base is
 243      (if Is_Float then T (Cosh (F (X)))
 244       elsif Is_Long_Float then T (Cosh (LF (X)))
 245       elsif Is_Long_Long_Float then T (Cosh (LLF (X)))
 246       else raise Program_Error);
 247 
 248    ---------
 249    -- Cot --
 250    ---------
 251 
 252    --  Natural cycle
 253 
 254    function Cot (X : Float_Type'Base) return Float_Type'Base is
 255      (if Is_Float then T (Cot (F (X)))
 256       elsif Is_Long_Float then T (Cot (LF (X)))
 257       elsif Is_Long_Long_Float then T (Cot (LLF (X)))
 258       else raise Program_Error);
 259 
 260    --  Arbitrary cycle
 261 
 262    function Cot (X, Cycle : Float_Type'Base) return Float_Type'Base is
 263      (if Is_Float then T (Cot (F (X), F (Cycle)))
 264       elsif Is_Long_Float then T (Cot (LF (X), LF (Cycle)))
 265       elsif Is_Long_Long_Float then T (Cot (LLF (X), LLF (Cycle)))
 266       else raise Program_Error);
 267 
 268    ----------
 269    -- Coth --
 270    ----------
 271 
 272    function Coth (X : Float_Type'Base) return Float_Type'Base is
 273      (if Is_Float then T (Coth (F (X)))
 274       elsif Is_Long_Float then T (Coth (LF (X)))
 275       elsif Is_Long_Long_Float then T (Coth (LLF (X)))
 276       else raise Program_Error);
 277 
 278    ---------
 279    -- Exp --
 280    ---------
 281 
 282    function Exp (X : Float_Type'Base) return Float_Type'Base is
 283      (if Is_Float then T (Exp (F (X)))
 284       elsif Is_Long_Float then T (Exp (LF (X)))
 285       elsif Is_Long_Long_Float then T (Exp (LLF (X)))
 286       else raise Program_Error);
 287 
 288    ---------
 289    -- Log --
 290    ---------
 291 
 292    --  Natural base
 293 
 294    function Log (X : Float_Type'Base) return Float_Type'Base is
 295      (if Is_Float then T (Log (F (X)))
 296       elsif Is_Long_Float then T (Log (LF (X)))
 297       elsif Is_Long_Long_Float then T (Log (LLF (X)))
 298       else raise Program_Error);
 299 
 300    --  Arbitrary base
 301 
 302    function Log (X, Base : Float_Type'Base) return Float_Type'Base is
 303      (if Is_Float then T (Log (F (X), F (Base)))
 304       elsif Is_Long_Float then T (Log (LF (X), LF (Base)))
 305       elsif Is_Long_Long_Float then T (Log (LLF (X), LLF (Base)))
 306       else raise Program_Error);
 307 
 308    ---------
 309    -- Sin --
 310    ---------
 311 
 312    --  Natural cycle
 313 
 314    function Sin (X : Float_Type'Base) return Float_Type'Base is
 315      (if Is_Float then T (Sin (F (X)))
 316       elsif Is_Long_Float then T (Sin (LF (X)))
 317       elsif Is_Long_Long_Float then T (Sin (LLF (X)))
 318       else raise Program_Error);
 319 
 320    --  Arbitrary cycle
 321 
 322    function Sin (X, Cycle : Float_Type'Base) return Float_Type'Base is
 323      (if Is_Float then T (Sin (F (X), F (Cycle)))
 324       elsif Is_Long_Float then T (Sin (LF (X), LF (Cycle)))
 325       elsif Is_Long_Long_Float then T (Sin (LLF (X), LLF (Cycle)))
 326       else raise Program_Error);
 327 
 328    ----------
 329    -- Sinh --
 330    ----------
 331 
 332    function Sinh (X : Float_Type'Base) return Float_Type'Base is
 333      (if Is_Float then T (Sinh (F (X)))
 334       elsif Is_Long_Float then T (Sinh (LF (X)))
 335       elsif Is_Long_Long_Float then T (Sinh (LLF (X)))
 336       else raise Program_Error);
 337 
 338    ----------
 339    -- Sqrt --
 340    ----------
 341 
 342    function Sqrt (X : Float_Type'Base) return Float_Type'Base is
 343      (if Is_Float then T (Sqrt (F (X)))
 344       elsif Is_Long_Float then T (Sqrt (LF (X)))
 345       elsif Is_Long_Long_Float then T (Sqrt (LLF (X)))
 346       else raise Program_Error);
 347 
 348    ---------
 349    -- Tan --
 350    ---------
 351 
 352    --  Natural cycle
 353 
 354    function Tan (X : Float_Type'Base) return Float_Type'Base is
 355      (if Is_Float then T (Tan (F (X)))
 356       elsif Is_Long_Float then T (Tan (LF (X)))
 357       elsif Is_Long_Long_Float then T (Tan (LLF (X)))
 358       else raise Program_Error);
 359 
 360    --  Arbitrary cycle
 361 
 362    function Tan (X, Cycle : Float_Type'Base) return Float_Type'Base is
 363      (if Is_Float then T (Tan (F (X), F (Cycle)))
 364       elsif Is_Long_Float then T (Tan (LF (X), LF (Cycle)))
 365       elsif Is_Long_Long_Float then T (Tan (LLF (X), LLF (Cycle)))
 366       else raise Program_Error);
 367 
 368    ----------
 369    -- Tanh --
 370    ----------
 371 
 372    function Tanh (X : Float_Type'Base) return Float_Type'Base is
 373      (if Is_Float then T (Tanh (F (X)))
 374       elsif Is_Long_Float then T (Tanh (LF (X)))
 375       elsif Is_Long_Long_Float then T (Tanh (LLF (X)))
 376       else raise Program_Error);
 377 
 378 end Ada.Numerics.Generic_Elementary_Functions;