1 /********************************************************************/
2 /* */
3 /* s7 Seed7 interpreter */
4 /* Copyright (C) 1990 - 2000, 2013, 2016, 2020 Thomas Mertes */
5 /* 2021 Thomas Mertes */
6 /* */
7 /* This program is free software; you can redistribute it and/or */
8 /* modify it under the terms of the GNU General Public License as */
9 /* published by the Free Software Foundation; either version 2 of */
10 /* the License, or (at your option) any later version. */
11 /* */
12 /* This program is distributed in the hope that it will be useful, */
13 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
14 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
15 /* GNU General Public License for more details. */
16 /* */
17 /* You should have received a copy of the GNU General Public */
18 /* License along with this program; if not, write to the */
19 /* Free Software Foundation, Inc., 51 Franklin Street, */
20 /* Fifth Floor, Boston, MA 02110-1301, USA. */
21 /* */
22 /* Module: Library */
23 /* File: seed7/src/blnlib.c */
24 /* Changes: 1999, 2013, 2016, 2020, 2021 Thomas Mertes */
25 /* Content: All primitive actions for the boolean type. */
26 /* */
27 /********************************************************************/
28
29 #define LOG_FUNCTIONS 0
30 #define VERBOSE_EXCEPTIONS 0
31
32 #include "version.h"
33
34 #include "stdlib.h"
35 #include "stdio.h"
36
37 #include "common.h"
38 #include "data.h"
39 #include "syvarutl.h"
40 #include "exec.h"
41 #include "objutl.h"
42 #include "runerr.h"
43
44 #undef EXTERN
45 #define EXTERN
46 #include "blnlib.h"
47
48
49
50 /**
51 * Logical 'and' for two boolean values.
52 * The logical 'and' operator works strictly left to right.
53 * If the result can be determined after the evaluation of
54 * 'boolValue1' the right operand ('boolValue2') is not evaluated.
55 * @return TRUE if boolValue1 is TRUE and boolValue2 is TRUE,
56 * FALSE otherwise.
57 */
bln_and(listType arguments)58 objectType bln_and (listType arguments)
59
60 {
61 objectType result;
62
63 /* bln_and */
64 isit_bool(arg_1(arguments));
65 if (take_bool(arg_1(arguments)) == SYS_FALSE_OBJECT) {
66 return SYS_FALSE_OBJECT;
67 } else {
68 result = evaluate(arg_3(arguments));
69 if (!fail_flag) {
70 isit_bool(result);
71 result = take_bool(result);
72 } /* if */
73 return result;
74 } /* if */
75 } /* bln_and */
76
77
78
79 /**
80 * Assign source/arg_3 to dest/arg_1.
81 * A copy function assumes that dest/arg_1 contains a legal value.
82 */
bln_cpy(listType arguments)83 objectType bln_cpy (listType arguments)
84
85 {
86 objectType dest;
87
88 /* bln_cpy */
89 dest = arg_1(arguments);
90 isit_bool(dest);
91 is_variable(dest);
92 isit_bool(arg_3(arguments));
93 dest->value.objValue = take_bool(arg_3(arguments));
94 return SYS_EMPTY_OBJECT;
95 } /* bln_cpy */
96
97
98
99 /**
100 * Initialize dest/arg_1 and assign source/arg_3 to it.
101 * A create function assumes that the contents of dest/arg_1
102 * is undefined. Create functions can be used to initialize
103 * constants.
104 */
bln_create(listType arguments)105 objectType bln_create (listType arguments)
106
107 {
108 objectType dest;
109 objectType source;
110
111 /* bln_create */
112 dest = arg_1(arguments);
113 isit_bool(arg_3(arguments));
114 source = take_bool(arg_3(arguments));
115 if (VAR_OBJECT(dest)) {
116 SET_CATEGORY_OF_OBJ(dest, VARENUMOBJECT);
117 } else {
118 SET_CATEGORY_OF_OBJ(dest, CONSTENUMOBJECT);
119 } /* if */
120 dest->value.objValue = source;
121 return SYS_EMPTY_OBJECT;
122 } /* bln_create */
123
124
125
126 /**
127 * Check if two boolean values are equal.
128 * @return TRUE if the two boolean values are equal,
129 * FALSE otherwise.
130 */
bln_eq(listType arguments)131 objectType bln_eq (listType arguments)
132
133 { /* bln_eq */
134 isit_bool(arg_1(arguments));
135 isit_bool(arg_3(arguments));
136 if (take_bool(arg_1(arguments)) == take_bool(arg_3(arguments))) {
137 return SYS_TRUE_OBJECT;
138 } else {
139 return SYS_FALSE_OBJECT;
140 } /* if */
141 } /* bln_eq */
142
143
144
145 /**
146 * Check if boolValue1 is greater than or equal to boolValue2.
147 * @return TRUE if boolValue1 is TRUE or boolValue2 is FALSE,
148 * FALSE otherwise.
149 */
bln_ge(listType arguments)150 objectType bln_ge (listType arguments)
151
152 { /* bln_ge */
153 isit_bool(arg_1(arguments));
154 isit_bool(arg_3(arguments));
155 if (take_bool(arg_1(arguments)) == SYS_TRUE_OBJECT) {
156 return SYS_TRUE_OBJECT;
157 } else {
158 if (take_bool(arg_3(arguments)) == SYS_TRUE_OBJECT) {
159 return SYS_FALSE_OBJECT;
160 } else {
161 return SYS_TRUE_OBJECT;
162 } /* if */
163 } /* if */
164 } /* bln_ge */
165
166
167
168 /**
169 * Check if boolValue1 is greater than boolValue2.
170 * @return TRUE if boolValue1 is TRUE and boolValue2 is FALSE,
171 * FALSE otherwise.
172 */
bln_gt(listType arguments)173 objectType bln_gt (listType arguments)
174
175 { /* bln_gt */
176 isit_bool(arg_1(arguments));
177 isit_bool(arg_3(arguments));
178 if (take_bool(arg_1(arguments)) == SYS_FALSE_OBJECT) {
179 return SYS_FALSE_OBJECT;
180 } else {
181 if (take_bool(arg_3(arguments)) == SYS_TRUE_OBJECT) {
182 return SYS_FALSE_OBJECT;
183 } else {
184 return SYS_TRUE_OBJECT;
185 } /* if */
186 } /* if */
187 } /* bln_gt */
188
189
190
191 /**
192 * Convert an integer to a boolean value.
193 * @return FALSE if number is 0,
194 * TRUE if number is 1.
195 * @exception RANGE_ERROR If 'number/arg_1' is neither 0 nor 1.
196 */
bln_iconv1(listType arguments)197 objectType bln_iconv1 (listType arguments)
198
199 {
200 intType number;
201
202 /* bln_iconv1 */
203 isit_int(arg_1(arguments));
204 number = take_int(arg_1(arguments));
205 if (unlikely(number < 0 || number >= 2)) {
206 return raise_exception(SYS_RNG_EXCEPTION);
207 } else if (number != 0) {
208 return SYS_TRUE_OBJECT;
209 } else {
210 return SYS_FALSE_OBJECT;
211 } /* if */
212 } /* bln_iconv1 */
213
214
215
216 /**
217 * Convert an integer to a boolean value.
218 * @return FALSE if number is 0,
219 * TRUE if number is 1.
220 * @exception RANGE_ERROR If 'number/arg_3' is neither 0 nor 1.
221 */
bln_iconv3(listType arguments)222 objectType bln_iconv3 (listType arguments)
223
224 {
225 intType number;
226
227 /* bln_iconv3 */
228 isit_int(arg_3(arguments));
229 number = take_int(arg_3(arguments));
230 if (unlikely(number < 0 || number >= 2)) {
231 return raise_exception(SYS_RNG_EXCEPTION);
232 } else if (number != 0) {
233 return SYS_TRUE_OBJECT;
234 } else {
235 return SYS_FALSE_OBJECT;
236 } /* if */
237 } /* bln_iconv3 */
238
239
240
241 /**
242 * Check if boolValue1 is less than or equal to boolValue2.
243 * @return TRUE if boolValue1 is FALSE or boolValue2 is TRUE,
244 * FALSE otherwise.
245 */
bln_le(listType arguments)246 objectType bln_le (listType arguments)
247
248 { /* bln_le */
249 isit_bool(arg_1(arguments));
250 isit_bool(arg_3(arguments));
251 if (take_bool(arg_1(arguments)) == SYS_FALSE_OBJECT) {
252 return SYS_TRUE_OBJECT;
253 } else {
254 return take_bool(arg_3(arguments));
255 } /* if */
256 } /* bln_le */
257
258
259
260 /**
261 * Check if boolValue1 is less than boolValue2.
262 * @return TRUE if boolValue1 is FALSE and boolValue2 is TRUE,
263 * FALSE otherwise.
264 */
bln_lt(listType arguments)265 objectType bln_lt (listType arguments)
266
267 { /* bln_lt */
268 isit_bool(arg_1(arguments));
269 isit_bool(arg_3(arguments));
270 if (take_bool(arg_1(arguments)) == SYS_TRUE_OBJECT) {
271 return SYS_FALSE_OBJECT;
272 } else {
273 return take_bool(arg_3(arguments));
274 } /* if */
275 } /* bln_lt */
276
277
278
279 /**
280 * Check if two boolean values are not equal.
281 * @return FALSE if the two boolean values are equal,
282 * TRUE otherwise.
283 */
bln_ne(listType arguments)284 objectType bln_ne (listType arguments)
285
286 { /* bln_ne */
287 isit_bool(arg_1(arguments));
288 isit_bool(arg_3(arguments));
289 if (take_bool(arg_1(arguments)) != take_bool(arg_3(arguments))) {
290 return SYS_TRUE_OBJECT;
291 } else {
292 return SYS_FALSE_OBJECT;
293 } /* if */
294 } /* bln_ne */
295
296
297
298 /**
299 * Negate a boolean value.
300 * @return TRUE if boolValue is FALSE,
301 * FALSE otherwise.
302 */
bln_not(listType arguments)303 objectType bln_not (listType arguments)
304
305 { /* bln_not */
306 isit_bool(arg_2(arguments));
307 if (take_bool(arg_2(arguments)) == SYS_TRUE_OBJECT) {
308 return SYS_FALSE_OBJECT;
309 } else {
310 return SYS_TRUE_OBJECT;
311 } /* if */
312 } /* bln_not */
313
314
315
316 /**
317 * Inclusive logical 'or' for two boolean values.
318 * The logical 'or' operator works strictly left to right.
319 * If the result can be determined after the evaluation of
320 * 'boolValue1' the right operand ('boolValue2') is not evaluated.
321 * @return TRUE if boolValue1 is TRUE or boolValue2 is TRUE (or both are true),
322 * FALSE otherwise.
323 */
bln_or(listType arguments)324 objectType bln_or (listType arguments)
325
326 {
327 objectType result;
328
329 /* bln_or */
330 isit_bool(arg_1(arguments));
331 if (take_bool(arg_1(arguments)) == SYS_TRUE_OBJECT) {
332 return SYS_TRUE_OBJECT;
333 } else {
334 result = evaluate(arg_3(arguments));
335 if (!fail_flag) {
336 isit_bool(result);
337 result = take_bool(result);
338 } /* if */
339 return result;
340 } /* if */
341 } /* bln_or */
342
343
344
345 /**
346 * Convert to integer.
347 * @return 0 if boolValue is FALSE, and
348 * 1 if boolValue is TRUE.
349 */
bln_ord(listType arguments)350 objectType bln_ord (listType arguments)
351
352 {
353 intType ordinal;
354
355 /* bln_ord */
356 isit_bool(arg_1(arguments));
357 ordinal = take_bool(arg_1(arguments)) == SYS_TRUE_OBJECT;
358 return bld_int_temp(ordinal);
359 } /* bln_ord */
360
361
362
363 /**
364 * Predecessor of a boolean value.
365 * @return FALSE, if 'boolValue/arg_1' is TRUE.
366 * @exception RANGE_ERROR If 'boolValue/arg_1' is FALSE.
367 */
bln_pred(listType arguments)368 objectType bln_pred (listType arguments)
369
370 { /* bln_pred */
371 isit_bool(arg_1(arguments));
372 if (likely(take_bool(arg_1(arguments)) == SYS_TRUE_OBJECT)) {
373 return SYS_FALSE_OBJECT;
374 } else {
375 return raise_exception(SYS_RNG_EXCEPTION);
376 } /* if */
377 } /* bln_pred */
378
379
380 /**
381 * Successor of a boolean value.
382 * @return TRUE, if 'boolValue/arg_1' is FALSE.
383 * @exception RANGE_ERROR If 'boolValue/arg_1' is TRUE.
384 */
bln_succ(listType arguments)385 objectType bln_succ (listType arguments)
386
387 { /* bln_succ */
388 isit_bool(arg_1(arguments));
389 if (likely(take_bool(arg_1(arguments)) == SYS_FALSE_OBJECT)) {
390 return SYS_TRUE_OBJECT;
391 } else {
392 return raise_exception(SYS_RNG_EXCEPTION);
393 } /* if */
394 } /* bln_succ */
395
396
397 /**
398 * Ternary operator condition/arg_1 ? thenValue/arg_3 : elseValue/arg_5
399 * @return thenValue/arg_3 if condition/arg_1 is TRUE, and
400 * elseValue/arg_5 if condition/arg_1 is FALSE.
401 */
bln_ternary(listType arguments)402 objectType bln_ternary (listType arguments)
403
404 {
405 objectType result;
406
407 /* bln_ternary */
408 isit_bool(arg_1(arguments));
409 if (take_bool(arg_1(arguments)) == SYS_TRUE_OBJECT) {
410 result = evaluate(arg_3(arguments));
411 } else {
412 result = evaluate(arg_5(arguments));
413 } /* if */
414 if (result != NULL &&
415 (CATEGORY_OF_OBJ(result) == CONSTENUMOBJECT ||
416 CATEGORY_OF_OBJ(result) == VARENUMOBJECT)) {
417 result = result->value.objValue;
418 } /* if */
419 return result;
420 } /* bln_ternary */
421
422
423
424 /**
425 * Get 'boolean' value of the object referenced by 'aReference/arg_1'.
426 * @return the 'boolean' value of the referenced object.
427 * @exception RANGE_ERROR If 'aReference/arg_1' is NIL or
428 * if the value is not TRUE_OBJECT or FALSE_OBJECT.
429 */
bln_value(listType arguments)430 objectType bln_value (listType arguments)
431
432 {
433 objectType obj_arg;
434
435 /* bln_value */
436 isit_reference(arg_1(arguments));
437 obj_arg = take_reference(arg_1(arguments));
438 if (obj_arg != NULL) {
439 if (CATEGORY_OF_OBJ(obj_arg) == CONSTENUMOBJECT ||
440 CATEGORY_OF_OBJ(obj_arg) == VARENUMOBJECT) {
441 obj_arg = obj_arg->value.objValue;
442 } /* if */
443 if (obj_arg->type_of != NULL &&
444 obj_arg->type_of->owningProg != NULL) {
445 if (obj_arg == TRUE_OBJECT(obj_arg->type_of->owningProg)) {
446 return SYS_TRUE_OBJECT;
447 } else if (obj_arg == FALSE_OBJECT(obj_arg->type_of->owningProg)) {
448 return SYS_FALSE_OBJECT;
449 } /* if */
450 } /* if */
451 } /* if */
452 logError(printf("bln_value(");
453 trace1(obj_arg);
454 printf("): Value not TRUE_OBJECT or FALSE_OBJECT.\n"););
455 return raise_exception(SYS_RNG_EXCEPTION);
456 } /* bln_value */
457