1 /*************************************************************************
2 * *
3 * YAP Prolog @(#)eval.h 1.2
4 * *
5 * Yap Prolog was developed at NCCUP - Universidade do Porto *
6 * *
7 * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8 * *
9 **************************************************************************
10 * *
11 * File: eval.h *
12 * Last rev: *
13 * mods: *
14 * comments: arithmetical functions info *
15 * *
16 *************************************************************************/
17
18 #include <stdlib.h>
19
20 /* C library used to implement floating point functions */
21 #if HAVE_MATH_H
22 #include <math.h>
23 #endif
24 #ifdef HAVE_FLOAT_H
25 #include <float.h>
26 #endif
27 #ifdef HAVE_IEEEFP_H
28 #include <ieeefp.h>
29 #endif
30 #ifdef HAVE_LIMITS_H
31 #include <limits.h>
32 #endif
33
34 #ifdef LONG_MAX
35 #define Int_MAX LONG_MAX
36 #else
37 #define Int_MAX ((Int)((~((CELL)0))>>1))
38 #endif
39 #ifdef LONG_MIN
40 #define Int_MIN LONG_MIN
41 #else
42 #define Int_MIN (-Int_MAX-(CELL)1)
43 #endif
44
45 typedef enum {
46 op_pi,
47 op_e,
48 op_epsilon,
49 op_inf,
50 op_nan,
51 op_random,
52 op_cputime,
53 op_heapused,
54 op_localsp,
55 op_globalsp,
56 op_b,
57 op_env,
58 op_tr,
59 op_stackfree
60 } arith0_op;
61
62 typedef enum {
63 op_uplus,
64 op_uminus,
65 op_unot,
66 op_exp,
67 op_log,
68 op_log10,
69 op_sqrt,
70 op_sin,
71 op_cos,
72 op_tan,
73 op_sinh,
74 op_cosh,
75 op_tanh,
76 op_asin,
77 op_acos,
78 op_atan,
79 op_asinh,
80 op_acosh,
81 op_atanh,
82 op_floor,
83 op_ceiling,
84 op_round,
85 op_truncate,
86 op_integer,
87 op_float,
88 op_abs,
89 op_lsb,
90 op_msb,
91 op_popcount,
92 op_ffracp,
93 op_fintp,
94 op_sign,
95 op_lgamma,
96 op_erf,
97 op_erfc,
98 op_rational,
99 op_rationalize,
100 op_random1
101 } arith1_op;
102
103 typedef enum {
104 op_plus,
105 op_minus,
106 op_times,
107 op_fdiv,
108 op_mod,
109 op_rem,
110 op_div,
111 op_idiv,
112 op_sll,
113 op_slr,
114 op_and,
115 op_or,
116 op_xor,
117 op_atan2,
118 /* C-Prolog exponentiation */
119 op_power,
120 /* ISO-Prolog exponentiation */
121 /* op_power, */
122 op_power2,
123 /* Quintus exponentiation */
124 /* op_power, */
125 op_gcd,
126 op_min,
127 op_max,
128 op_rdiv
129 } arith2_op;
130
131 Functor STD_PROTO(EvalArg,(Term));
132
133 /* Needed to handle numbers:
134 these two macros are fundamental in the integer/float conversions */
135
136 #ifdef C_PROLOG
137 #define FlIsInt(X) ( (X) == (Int)(X) && IntInBnd((X)) )
138 #else
139 #define FlIsInt(X) ( FALSE )
140 #endif
141
142
143
144 #ifdef M_WILLIAMS
145 #define MkEvalFl(X) MkFloatTerm(X)
146 #else
147 #define MkEvalFl(X) ( FlIsInt(X) ? MkIntTerm((Int)(X)) : MkFloatTerm(X) )
148 #endif
149
150
151 /* Macros used by some of the eval functions */
152 #define REvalInt(I) { eval_int = (I); return(FInt); }
153 #define REvalFl(F) { eval_flt = (F); return(FFloat); }
154 #define REvalError() { return(FError); }
155
156 /* this macro, dependent on the particular implementation
157 is used to interface the arguments into the C libraries */
158 #ifdef MPW
159 #define FL(X) ((extended)(X))
160 #else
161 #define FL(X) ((double)(X))
162 #endif
163
164 extern yap_error_number Yap_matherror;
165
166 void STD_PROTO(Yap_InitConstExps,(void));
167 void STD_PROTO(Yap_InitUnaryExps,(void));
168 void STD_PROTO(Yap_InitBinaryExps,(void));
169
170 int STD_PROTO(Yap_ReInitConstExps,(void));
171 int STD_PROTO(Yap_ReInitUnaryExps,(void));
172 int STD_PROTO(Yap_ReInitBinaryExps,(void));
173
174 Term STD_PROTO(Yap_eval_atom,(Int));
175 Term STD_PROTO(Yap_eval_unary,(Int,Term));
176 Term STD_PROTO(Yap_eval_binary,(Int,Term,Term));
177
178 Term STD_PROTO(Yap_InnerEval,(Term));
179 Int STD_PROTO(Yap_ArithError,(yap_error_number,Term,char *msg, ...));
180
181 inline EXTERN Term
Yap_Eval(Term t)182 Yap_Eval(Term t)
183 {
184 if (t == 0L || ( !IsVarTerm(t) && IsNumTerm(t) ))
185 return t;
186 return Yap_InnerEval(t);
187 }
188
189 inline static Term
Yap_FoundArithError(Term t,Term inp)190 Yap_FoundArithError(Term t, Term inp)
191 {
192 if (Yap_Error_TYPE) {
193 Yap_Error(Yap_Error_TYPE, (inp ? inp : Yap_Error_Term), Yap_ErrorMessage);
194 P = FAILCODE;
195 return 0L;
196 }
197 return t;
198 }
199
200
201 #define RINT(v) return(MkIntegerTerm(v))
202 #define RFLOAT(v) return(MkFloatTerm(v))
203 #define RBIG(v) return(Yap_MkBigIntTerm(v))
204 #define RERROR() return(0L)
205
206 static inline blob_type
ETypeOfTerm(Term t)207 ETypeOfTerm(Term t)
208 {
209 if (IsIntTerm(t))
210 return long_int_e;
211 if (IsApplTerm(t)) {
212 Functor f = FunctorOfTerm(t);
213 if (f == FunctorDouble)
214 return double_e;
215 if (f == FunctorLongInt)
216 return long_int_e;
217 if (f == FunctorBigInt) {
218 return big_int_e;
219 }
220 }
221 return db_ref_e;
222 }
223
224 #if USE_GMP
225 Term STD_PROTO(Yap_gmq_rdiv_int_int,(Int, Int));
226 Term STD_PROTO(Yap_gmq_rdiv_int_big,(Int, Term));
227 Term STD_PROTO(Yap_gmq_rdiv_big_int,(Term, Int));
228 Term STD_PROTO(Yap_gmq_rdiv_big_big,(Term, Term));
229
230 Term STD_PROTO(Yap_gmp_add_ints,(Int, Int));
231 Term STD_PROTO(Yap_gmp_sub_ints,(Int, Int));
232 Term STD_PROTO(Yap_gmp_mul_ints,(Int, Int));
233 Term STD_PROTO(Yap_gmp_sll_ints,(Int, Int));
234 Term STD_PROTO(Yap_gmp_add_int_big,(Int, Term));
235 Term STD_PROTO(Yap_gmp_sub_int_big,(Int, Term));
236 Term STD_PROTO(Yap_gmp_sub_big_int,(Term, Int));
237 Term STD_PROTO(Yap_gmp_mul_int_big,(Int, Term));
238 Term STD_PROTO(Yap_gmp_div_int_big,(Int, Term));
239 Term STD_PROTO(Yap_gmp_div_big_int,(Term, Int));
240 Term STD_PROTO(Yap_gmp_div2_big_int,(Term, Int));
241 Term STD_PROTO(Yap_gmp_fdiv_int_big,(Int, Term));
242 Term STD_PROTO(Yap_gmp_fdiv_big_int,(Term, Int));
243 Term STD_PROTO(Yap_gmp_and_int_big,(Int, Term));
244 Term STD_PROTO(Yap_gmp_ior_int_big,(Int, Term));
245 Term STD_PROTO(Yap_gmp_xor_int_big,(Int, Term));
246 Term STD_PROTO(Yap_gmp_sll_big_int,(Term, Int));
247 Term STD_PROTO(Yap_gmp_add_big_big,(Term, Term));
248 Term STD_PROTO(Yap_gmp_sub_big_big,(Term, Term));
249 Term STD_PROTO(Yap_gmp_mul_big_big,(Term, Term));
250 Term STD_PROTO(Yap_gmp_div_big_big,(Term, Term));
251 Term STD_PROTO(Yap_gmp_div2_big_big,(Term, Term));
252 Term STD_PROTO(Yap_gmp_fdiv_big_big,(Term, Term));
253 Term STD_PROTO(Yap_gmp_and_big_big,(Term, Term));
254 Term STD_PROTO(Yap_gmp_ior_big_big,(Term, Term));
255 Term STD_PROTO(Yap_gmp_xor_big_big,(Term, Term));
256 Term STD_PROTO(Yap_gmp_mod_big_big,(Term, Term));
257 Term STD_PROTO(Yap_gmp_mod_big_int,(Term, Int));
258 Term STD_PROTO(Yap_gmp_mod_int_big,(Int, Term));
259 Term STD_PROTO(Yap_gmp_rem_big_big,(Term, Term));
260 Term STD_PROTO(Yap_gmp_rem_big_int,(Term, Int));
261 Term STD_PROTO(Yap_gmp_rem_int_big,(Int, Term));
262 Term STD_PROTO(Yap_gmp_exp_int_int,(Int,Int));
263 Term STD_PROTO(Yap_gmp_exp_int_big,(Int,Term));
264 Term STD_PROTO(Yap_gmp_exp_big_int,(Term,Int));
265 Term STD_PROTO(Yap_gmp_exp_big_big,(Term,Term));
266 Term STD_PROTO(Yap_gmp_gcd_int_big,(Int,Term));
267 Term STD_PROTO(Yap_gmp_gcd_big_big,(Term,Term));
268
269 Term STD_PROTO(Yap_gmp_big_from_64bits,(YAP_LONG_LONG));
270
271 Term STD_PROTO(Yap_gmp_float_to_big,(Float));
272 Term STD_PROTO(Yap_gmp_float_to_rational,(Float));
273 Term STD_PROTO(Yap_gmp_float_rationalize,(Float));
274 Float STD_PROTO(Yap_gmp_to_float,(Term));
275 Term STD_PROTO(Yap_gmp_add_float_big,(Float, Term));
276 Term STD_PROTO(Yap_gmp_sub_float_big,(Float, Term));
277 Term STD_PROTO(Yap_gmp_sub_big_float,(Term, Float));
278 Term STD_PROTO(Yap_gmp_mul_float_big,(Float, Term));
279 Term STD_PROTO(Yap_gmp_fdiv_float_big,(Float, Term));
280 Term STD_PROTO(Yap_gmp_fdiv_big_float,(Term, Float));
281
282 int STD_PROTO(Yap_gmp_cmp_big_int,(Term, Int));
283 #define Yap_gmp_cmp_int_big(I, T) (-Yap_gmp_cmp_big_int(T, I))
284 int STD_PROTO(Yap_gmp_cmp_big_float,(Term, Float));
285 #define Yap_gmp_cmp_float_big(D, T) (-Yap_gmp_cmp_big_float(T, D))
286 int STD_PROTO(Yap_gmp_cmp_big_big,(Term, Term));
287
288 int STD_PROTO(Yap_gmp_tcmp_big_int,(Term, Int));
289 #define Yap_gmp_tcmp_int_big(I, T) (-Yap_gmp_tcmp_big_int(T, I))
290 int STD_PROTO(Yap_gmp_tcmp_big_float,(Term, Float));
291 #define Yap_gmp_tcmp_float_big(D, T) (-Yap_gmp_tcmp_big_float(T, D))
292 int STD_PROTO(Yap_gmp_tcmp_big_big,(Term, Term));
293
294 Term STD_PROTO(Yap_gmp_neg_int,(Int));
295 Term STD_PROTO(Yap_gmp_abs_big,(Term));
296 Term STD_PROTO(Yap_gmp_neg_big,(Term));
297 Term STD_PROTO(Yap_gmp_unot_big,(Term));
298 Term STD_PROTO(Yap_gmp_floor,(Term));
299 Term STD_PROTO(Yap_gmp_ceiling,(Term));
300 Term STD_PROTO(Yap_gmp_round,(Term));
301 Term STD_PROTO(Yap_gmp_trunc,(Term));
302 Term STD_PROTO(Yap_gmp_float_fractional_part,(Term));
303 Term STD_PROTO(Yap_gmp_float_integer_part,(Term));
304 Term STD_PROTO(Yap_gmp_sign,(Term));
305 Term STD_PROTO(Yap_gmp_lsb,(Term));
306 Term STD_PROTO(Yap_gmp_msb,(Term));
307 Term STD_PROTO(Yap_gmp_popcount,(Term));
308
309 char * STD_PROTO(Yap_gmp_to_string,(Term, char *, size_t, int));
310 size_t STD_PROTO(Yap_gmp_to_size,(Term, int));
311
312 int STD_PROTO(Yap_term_to_existing_big,(Term, MP_INT *));
313 int STD_PROTO(Yap_term_to_existing_rat,(Term, MP_RAT *));
314 #endif
315
316 inline EXTERN Term Yap_Mk64IntegerTerm(YAP_LONG_LONG);
317
318 inline EXTERN Term
Yap_Mk64IntegerTerm(YAP_LONG_LONG i)319 Yap_Mk64IntegerTerm(YAP_LONG_LONG i)
320 {
321 if (i <= Int_MAX && i >= Int_MIN) {
322 return MkIntegerTerm((Int)i);
323 } else {
324 #if USE_GMP
325 return Yap_gmp_big_from_64bits(i);
326 #else
327 return MkIntTerm(-1);
328 #endif
329 }
330 }
331
332
333