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;