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