1		% (c) 2020-2024 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2		% Heinrich Heine Universitaet Duesseldorf
3		% This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5		:- module(external_functions_reals,['STRING_TO_REAL'/3,
6		'RADD'/4,'RSUB'/4,'RMUL'/4,'RDIV'/5, 'RINV'/4,
7		'RPI'/1, 'RZERO'/1, 'RONE'/1, 'REULER'/1,
8		'REPSILON'/1, 'RMAXFLOAT'/1,
9		'RSIN'/3, 'RCOS'/3, 'RTAN'/3, 'RCOT'/3,
10		'RSINH'/3, 'RCOSH'/3, 'RTANH'/3, 'RCOTH'/3,
11		'RASIN'/3, 'RACOS'/3, 'RATAN'/3, 'RACOT'/3,
12		'RASINH'/3, 'RACOSH'/3, 'RATANH'/3, 'RACOTH'/3,
13		'RADIANS'/4, 'DEGREE'/4,
14		'RUMINUS'/3,
15		'REXP'/3, 'RLOGe'/4, 'RSQRT'/4,
16		'RABS'/3, 'ROUND'/3, 'RSIGN'/3,
17		'RINTEGER'/3, 'RFRACTION'/3,
18		'RMAX'/5, 'RMIN'/5,
19		'RPOW'/5, 'RLOG'/5,
20		'RDECIMAL'/5, % scientific notation using integers
21		'RLT'/4, 'REQ'/4, 'RNEQ'/4, 'RLEQ'/4, 'RGT'/4, 'RGEQ'/4,
22		'RMAXIMUM'/4, 'RMINIMUM'/4,
23
24		'RNEXT'/2,
25
26		'SFADD16'/3,
27		'SFSUB16'/3,
28		'SFMUL16'/3,
29		'SFDIV16'/3,
30		'SFSQRT16'/2,
31		'SFMULADD16'/4,
32
33		'SFADD32'/3,
34		'SFSUB32'/3,
35		'SFMUL32'/3,
36		'SFDIV32'/3,
37		'SFSQRT32'/2,
38		'SFMULADD32'/4,
39
40		'SFADD64'/3,
41		'SFSUB64'/3,
42		'SFMUL64'/3,
43		'SFDIV64'/3,
44		'SFSQRT64'/2,
45		'SFMULADD64'/4,
46
47		'SFADD80'/3,
48		'SFSUB80'/3,
49		'SFMUL80'/3,
50		'SFDIV80'/3,
51		'SFSQRT80'/2,
52
53		'SFADD128'/3,
54		'SFSUB128'/3,
55		'SFMUL128'/3,
56		'SFDIV128'/3,
57		'SFSQRT128'/2,
58		'SFMULADD128'/4
59		]).
60
61
62		% -------------------------------
63		:- use_module(probsrc(kernel_reals),[construct_real/2,
64		is_largest_positive_float/1, is_smallest_positive_float/1, is_next_larger_float/2]).
65
66		%external_fun_type('STRING_TO_REAL',[],[string,real]).
67		% allows to call construct_real/2; also works for numbers without decimal point
68
69		:- block 'STRING_TO_REAL'(-,?,?).
70		'STRING_TO_REAL'(string(A),Result,_) :-
71		construct_real(A,Result).
72
73		% -------------------------------
74
75		:- use_module(probsrc(kernel_reals),[real_addition_wf/4, real_subtraction_wf/4,
76		real_multiplication_wf/4, real_division_wf/5, real_power_of_wf/5,
77		real_unary_minus_wf/3,
78		convert_int_to_real/2,
79		real_round_wf/3,
80		real_unop_wf/4, real_unop_wf/5, real_binop_wf/6,
81		real_comp_wf/5,
82		real_maximum_of_set/4, real_minimum_of_set/4]).
83
84		'RADD'(RX,RY,RR,WF) :-
85		real_addition_wf(RX,RY,RR,WF).
86
87		'RSUB'(RX,RY,RR,WF) :-
88		real_subtraction_wf(RX,RY,RR,WF).
89
90		'RMUL'(RX,RY,RR,WF) :-
91		real_multiplication_wf(RX,RY,RR,WF).
92
93		'RDIV'(RX,RY,RR,Span,WF) :-
94		real_division_wf(RX,RY,RR,Span,WF).
95
96		'RINV'(RY,RR,Span,WF) :-
97		'RONE'(RX),
98		real_division_wf(RX,RY,RR,Span,WF).
99
100		% ---- constants
101
102		'RPI'(term(floating(R))) :- R is pi.
103
104		'RZERO'(term(floating(R))) :- R = 0.0.
105
106		'RONE'(term(floating(R))) :- R = 1.0.
107
108		'REULER'(term(floating(R))) :- R is exp(1.0).
109
110		'REPSILON'(R) :- is_smallest_positive_float(R). % 5.0E-324
111
112		'RMAXFLOAT'(R) :- is_largest_positive_float(R). % 1.7976931348623157E+308
113
114		% ---- unary operators
115
116		% --- Trigonometric
117
118		:- block 'RSIN'(-,?,?).
119		'RSIN'(X,R,WF) :-
120		real_unop_wf('sin',X,R,WF).
121
122		:- block 'RCOS'(-,?,?).
123		'RCOS'(X,R,WF) :-
124		real_unop_wf('cos',X,R,WF).
125
126		:- block 'RTAN'(-,?,?).
127		'RTAN'(X,R,WF) :-
128		real_unop_wf('tan',X,R,WF).
129
130		:- block 'RCOT'(-,?,?).
131		'RCOT'(X,R,WF) :-
132		real_unop_wf('cot',X,R,WF).
133
134		:- block 'RSINH'(-,?,?).
135		'RSINH'(X,R,WF) :-
136		real_unop_wf('sinh',X,R,WF).
137
138		:- block 'RCOSH'(-,?,?).
139		'RCOSH'(X,R,WF) :-
140		real_unop_wf('cosh',X,R,WF).
141
142		:- block 'RTANH'(-,?,?).
143		'RTANH'(X,R,WF) :-
144		real_unop_wf('tanh',X,R,WF).
145
146		:- block 'RCOTH'(-,?,?).
147		'RCOTH'(X,R,WF) :-
148		real_unop_wf('coth',X,R,WF).
149
150		:- block 'RASIN'(-,?,?).
151		'RASIN'(X,R,WF) :-
152		real_unop_wf('asin',X,R,WF).
153
154		:- block 'RACOS'(-,?,?).
155		'RACOS'(X,R,WF) :-
156		real_unop_wf('acos',X,R,WF).
157
158		:- block 'RATAN'(-,?,?).
159		'RATAN'(X,R,WF) :-
160		real_unop_wf('atan',X,R,WF).
161
162		:- block 'RACOT'(-,?,?).
163		'RACOT'(X,R,WF) :-
164		real_unop_wf('acot',X,R,WF).
165
166		:- block 'RASINH'(-,?,?).
167		'RASINH'(X,R,WF) :-
168		real_unop_wf('asinh',X,R,WF).
169
170		:- block 'RACOSH'(-,?,?).
171		'RACOSH'(X,R,WF) :-
172		real_unop_wf('acosh',X,R,WF).
173
174		:- block 'RATANH'(-,?,?).
175		'RATANH'(X,R,WF) :-
176		real_unop_wf('atanh',X,R,WF).
177
178		:- block 'RACOTH'(-,?,?).
179		'RACOTH'(X,R,WF) :-
180		real_unop_wf('acoth',X,R,WF).
181
182		:- block 'RADIANS'(-,?,?,?).
183		'RADIANS'(Degree,Res,Span,WF) :-
184		D180 = term(floating(180.0)),
185		'RDIV'(Degree,D180,Deg2,Span,WF),
186		'RPI'(PI),
187		'RMUL'(PI,Deg2,Res,WF).
188
189		:- block 'DEGREE'(-,?,?,?).
190		'DEGREE'(Radians,Res,Span,WF) :-
191		D180 = term(floating(180.0)),
192		'RPI'(PI),
193		'RDIV'(Radians,PI,Deg2,Span,WF),
194		'RMUL'(D180,Deg2,Res,WF).
195
196		% -----------------------
197
198
199		:- block 'RUMINUS'(-,?,?).
200		'RUMINUS'(RX,RR,WF) :- % unary minus
201		real_unary_minus_wf(RX,RR,WF).
202
203		:- block 'REXP'(-,?,?).
204		'REXP'(X,R,WF) :-
205		real_unop_wf('exp',X,R,WF).
206
207		:- block 'RLOGe'(-,?,?,?).
208		'RLOGe'(X,R,Span,WF) :-
209		real_unop_wf('log',X,R,Span,WF).
210
211		:- block 'RSQRT'(-,?,?,?).
212		'RSQRT'(X,R,Span,WF) :-
213		real_unop_wf('sqrt',X,R,Span,WF).
214
215		:- block 'RABS'(-,?,?).
216		'RABS'(X,R,WF) :-
217		real_unop_wf('abs',X,R,WF).
218
219		:- block 'ROUND'(-,?,?).
220		'ROUND'(X,R,WF) :-
221		real_round_wf(X,R,WF).
222
223		:- block 'RSIGN'(-,?,?).
224		'RSIGN'(X,R,WF) :-
225		real_unop_wf('sign',X,R,WF).
226
227		:- block 'RINTEGER'(-,?,?).
228		'RINTEGER'(X,R,WF) :-
229		real_unop_wf('float_integer_part',X,R,WF).
230
231		:- block 'RFRACTION'(-,?,?).
232		'RFRACTION'(X,R,WF) :-
233		real_unop_wf('float_fractional_part',X,R,WF).
234
235		% ---- other binary operators
236		'RMAX'(RX,RY,RR,Span,WF) :-
237		real_binop_wf(max,RX,RY,RR,Span,WF).
238
239		'RMIN'(RX,RY,RR,Span,WF) :-
240		real_binop_wf(min,RX,RY,RR,Span,WF).
241
242		'RPOW'(RX,RY,RR,Span,WF) :-
243		real_power_of_wf(RX,RY,RR,Span,WF).
244
245		% convert integers x,y to reak x*10^y
246		'RDECIMAL'(IntX,IntY,RR,Span,WF) :-
247		convert_int_to_real(int(10),R10),
248		convert_int_to_real(IntY,RY),
249		real_power_of_wf(R10,RY,RR10,Span,WF),
250		convert_int_to_real(IntX,RX),
251		'RMUL'(RX,RR10,RR,WF).
252
253		'RLOG'(RX,RY,RR,Span,WF) :-
254		real_binop_wf(log,RX,RY,RR,Span,WF).
255
256		% ---- other binary predicates
257
258		'RLT'(RX,RY,RR,WF) :-
259		real_comp_wf('<',RX,RY,RR,WF).
260
261		'REQ'(RX,RY,RR,WF) :-
262		real_comp_wf('=:=',RX,RY,RR,WF).
263
264		'RNEQ'(RX,RY,RR,WF) :-
265		real_comp_wf('=\\=',RX,RY,RR,WF). % =\=
266
267		'RLEQ'(RX,RY,RR,WF) :-
268		real_comp_wf('=<',RX,RY,RR,WF).
269
270		'RGT'(RY,RX,RR,WF) :-'RLT'(RX,RY,RR,WF).
271
272		'RGEQ'(RY,RX,RR,WF) :-'RLEQ'(RX,RY,RR,WF).
273
274		% set operators
275
276		'RMAXIMUM'(Set,Res,Span,WF) :-
277		real_maximum_of_set(Set,Res,Span,WF).
278		'RMINIMUM'(Set,Res,Span,WF) :-
279		real_minimum_of_set(Set,Res,Span,WF).
280
281		% ---- Float operators
282
283		'RNEXT'(Nr,NextNr) :-
284		is_next_larger_float(Nr,NextNr).
285
286		% softfloat functions.
287
288		:- use_module(extension('softfloat/softfloat')).
289
290		'SFADD16'(term(floating(X)),term(floating(Y)),term(floating(R))) :-
291		init_softfloat,
292		add16(X,Y,R).
293
294		'SFSUB16'(term(floating(X)),term(floating(Y)),term(floating(R))) :-
295		init_softfloat,
296		sub16(X,Y,R).
297
298		'SFMUL16'(term(floating(X)),term(floating(Y)),term(floating(R))) :-
299		init_softfloat,
300		mul16(X,Y,R).
301
302		'SFDIV16'(term(floating(X)),term(floating(Y)),term(floating(R))) :-
303		init_softfloat,
304		div16(X,Y,R).
305
306		'SFSQRT16'(term(floating(X)),term(floating(R))) :-
307		init_softfloat,
308		sqrt16(X,R).
309
310		'SFMULADD16'(term(floating(X)),term(floating(Y)),term(floating(Z)),term(floating(R))) :-
311		init_softfloat,
312		muladd16(X,Y,Z,R).
313		%32bit
314
315		'SFADD32'(term(floating(X)),term(floating(Y)),term(floating(R))) :-
316		init_softfloat,
317		add32(X,Y,R).
318
319		'SFSUB32'(term(floating(X)),term(floating(Y)),term(floating(R))) :-
320		init_softfloat,
321		sub32(X,Y,R).
322
323		'SFMUL32'(term(floating(X)),term(floating(Y)),term(floating(R))) :-
324		init_softfloat,
325		mul32(X,Y,R).
326
327		'SFDIV32'(term(floating(X)),term(floating(Y)),term(floating(R))) :-
328		init_softfloat,
329		div32(X,Y,R).
330
331		'SFSQRT32'(term(floating(X)),term(floating(R))) :-
332		init_softfloat,
333		sqrt32(X,R).
334
335		'SFMULADD32'(term(floating(X)),term(floating(Y)),term(floating(Z)),term(floating(R))) :-
336		init_softfloat,
337		muladd32(X,Y,Z,R).
338
339		%32bit
340		%64bit
341
342		'SFADD64'(term(floating(X)),term(floating(Y)),term(floating(R))) :-
343		init_softfloat,
344		add64(X,Y,R).
345
346		'SFSUB64'(term(floating(X)),term(floating(Y)),term(floating(R))) :-
347		init_softfloat,
348		sub64(X,Y,R).
349
350		'SFMUL64'(term(floating(X)),term(floating(Y)),term(floating(R))) :-
351		init_softfloat,
352		mul64(X,Y,R).
353
354		'SFDIV64'(term(floating(X)),term(floating(Y)),term(floating(R))) :-
355		init_softfloat,
356		div64(X,Y,R).
357
358		'SFSQRT64'(term(floating(X)),term(floating(R))) :-
359		init_softfloat,
360		sqrt64(X,R).
361
362		'SFMULADD64'(term(floating(X)),term(floating(Y)),term(floating(Z)),term(floating(R))) :-
363		init_softfloat,
364		muladd64(X,Y,Z,R).
365		%64bit
366		%80bit
367		'SFADD80'((int(X1),int(X2)),(int(Y1),int(Y2)),(int(R1),int(R2))) :-
368		init_softfloat,
369		add80(X1,X2,Y1,Y2,R1,R2).
370
371		'SFSUB80'((int(X1),int(X2)),(int(Y1),int(Y2)),(int(R1),int(R2))) :-
372		init_softfloat,
373		sub80(X1,X2,Y1,Y2,R1,R2).
374
375		'SFMUL80'((int(X1),int(X2)),(int(Y1),int(Y2)),(int(R1),int(R2))) :-
376		init_softfloat,
377		mul80(X1,X2,Y1,Y2,R1,R2).
378
379		'SFDIV80'((int(X1),int(X2)),(int(Y1),int(Y2)),(int(R1),int(R2))) :-
380		init_softfloat,
381		div80(X1,X2,Y1,Y2,R1,R2).
382
383		'SFSQRT80'( (int(X1),int(X2)),(int(R1),int(R2)) ) :-
384		init_softfloat,
385		sqrt80(X1,X2,R1,R2).
386		%80bit
387		%128bit
388		'SFADD128'((int(X1),int(X2)),(int(Y1),int(Y2)),(int(R1),int(R2))) :-
389		init_softfloat,
390		add128(X1,X2,Y1,Y2,R1,R2).
391
392		'SFSUB128'((int(X1),int(X2)),(int(Y1),int(Y2)),(int(R1),int(R2))) :-
393		init_softfloat,
394		sub128(X1,X2,Y1,Y2,R1,R2).
395
396		'SFMUL128'((int(X1),int(X2)),(int(Y1),int(Y2)),(int(R1),int(R2))) :-
397		init_softfloat,
398		mul128(X1,X2,Y1,Y2,R1,R2).
399
400		'SFDIV128'((int(X1),int(X2)),(int(Y1),int(Y2)),(int(R1),int(R2))) :-
401		init_softfloat,
402		div128(X1,X2,Y1,Y2,R1,R2).
403
404		'SFSQRT128'((int(X1),int(X2)),(int(R1),int(R2))) :-
405		init_softfloat,
406		sqrt128(X1,X2,R1,R2).
407
408		'SFMULADD128'((int(X1),int(X2)),(int(Y1),int(Y2)),(int(Z1),int(Z2)),(int(R1),int(R2))) :-
409		init_softfloat,
410		muladd128(X1,X2,Y1,Y2,Z1,Z2,R1,R2).
411		%128bit