Contact
CoCalc Logo Icon
StoreFeaturesDocsShareSupport News AboutSign UpSign In
| Download

GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it

Path: gap4r8 / src / exprs.c
Views: 415065
1
/****************************************************************************
2
**
3
*W exprs.c GAP source Martin Schönert
4
**
5
**
6
*Y Copyright (C) 1996, Lehrstuhl D für Mathematik, RWTH Aachen, Germany
7
*Y (C) 1998 School Math and Comp. Sci., University of St Andrews, Scotland
8
*Y Copyright (C) 2002 The GAP Group
9
**
10
** This file contains the functions of the expressions package.
11
**
12
** The expressions package is the part of the interpreter that evaluates
13
** expressions to their values and prints expressions.
14
*/
15
#include "system.h" /* Ints, UInts */
16
17
18
#include "gasman.h" /* garbage collector */
19
#include "objects.h" /* objects */
20
#include "scanner.h" /* scanner */
21
22
#include "gap.h" /* error handling, initialisation */
23
24
#include "gvars.h" /* global variables */
25
26
#include "ariths.h" /* basic arithmetic */
27
#include "records.h" /* generic records */
28
#include "lists.h" /* generic lists */
29
30
#include "bool.h" /* booleans */
31
#include "integer.h" /* integers */
32
33
#include "permutat.h" /* permutations */
34
#include "trans.h" /* transformations */
35
#include "pperm.h" /* partial perms */
36
37
#include "precord.h" /* plain records */
38
39
#include "plist.h" /* plain lists */
40
#include "range.h" /* ranges */
41
#include "string.h" /* strings */
42
43
#include "code.h" /* coder */
44
#include "calls.h"
45
#include "stats.h"
46
47
48
#include "exprs.h" /* expressions */
49
50
#include "tls.h" /* thread-local storage */
51
#include "profile.h" /* installing methods */
52
#include "aobjects.h" /* atomic objects */
53
54
#include "vars.h" /* variables */
55
56
#include <assert.h>
57
58
59
/****************************************************************************
60
**
61
62
*F OBJ_REFLVAR(<expr>) . . . . . . . . . . . value of a reference to a local
63
**
64
** 'OBJ_REFLVAR' returns the value of the reference to a local variable
65
** <expr>.
66
**
67
** 'OBJ_REFLVAR' is defined in the declaration part of this package as
68
** follows
69
**
70
#ifdef NO_LVAR_CHECKS
71
#define OBJ_REFLVAR(expr) \
72
OBJ_LVAR( LVAR_REFLVAR( (expr) ) )
73
#endif
74
#ifndef NO_LVAR_CHECKS
75
#define OBJ_REFLVAR(expr) \
76
(*(Obj*)(((char*)TLS(PtrLVars))+(expr)+5) != 0 ? \
77
*(Obj*)(((char*)TLS(PtrLVars))+(expr)+5) : \
78
ObjLVar( LVAR_REFLVAR( expr ) ) )
79
#endif
80
*/
81
82
83
/****************************************************************************
84
**
85
*F OBJ_INTEXPR(<expr>) . . . . . . . . . . . value of an integer expression
86
**
87
** 'OBJ_INTEXPR' returns the (immediate) integer value of the (immediate)
88
** integer expression <expr>.
89
**
90
** 'OBJ_INTEXPR(<expr>)' should be 'OBJ_INT(INT_INTEXPR(<expr>))', but for
91
** performance reasons we implement it as '(Obj)(<expr>)'. This is of
92
** course highly dependent on (immediate) integer expressions and
93
** (immediate) integer values having the same representation.
94
**
95
** 'OBJ_INTEXPR' is defined in the declaration part of this package as
96
** follow
97
**
98
#define OBJ_INTEXPR(expr) \
99
((Obj)(Int)(Int4)(expr))
100
*/
101
102
103
/****************************************************************************
104
**
105
*F EVAL_EXPR(<expr>) . . . . . . . . . . . . . . . . evaluate an expression
106
**
107
** 'EVAL_EXPR' evaluates the expression <expr>.
108
**
109
** 'EVAL_EXPR' returns the value of <expr>.
110
**
111
** 'EVAL_EXPR' causes the evaluation of <expr> by dispatching to the
112
** evaluator, i.e., to the function that evaluates expressions of the type
113
** of <expr>.
114
**
115
** Note that 'EVAL_EXPR' does not use 'TNUM_EXPR', since it also handles the
116
** two special cases that 'TNUM_EXPR' handles.
117
**
118
** 'EVAL_EXPR' is defined in the declaration part of this package as follows:
119
**
120
#define EVAL_EXPR(expr) \
121
(IS_REFLVAR(expr) ? OBJ_REFLVAR(expr) : \
122
(IS_INTEXPR(expr) ? OBJ_INTEXPR(expr) : \
123
(*EvalExprFuncs[ TNUM_STAT(expr) ])( expr ) ))
124
*/
125
126
127
/****************************************************************************
128
**
129
*V EvalExprFuncs[<type>] . . . . . evaluator for expressions of type <type>
130
**
131
** 'EvalExprFuncs' is the dispatch table that contains for every type of
132
** expressions a pointer to the evaluator for expressions of this type,
133
** i.e., the function that should be called to evaluate expressions of this
134
** type.
135
*/
136
Obj (* EvalExprFuncs [256]) ( Expr expr );
137
138
139
/****************************************************************************
140
**
141
*F EVAL_BOOL_EXPR(<expr>) . . . . evaluate an expression to a boolean value
142
**
143
** 'EVAL_BOOL_EXPR' evaluates the expression <expr> and checks that the
144
** value is either 'true' or 'false'. If the expression does not evaluate
145
** to 'true' or 'false', then an error is signalled.
146
**
147
** 'EVAL_BOOL_EXPR' returns the value of <expr> (which is either 'true' or
148
** 'false').
149
**
150
** 'EVAL_BOOL_EXPR' is defined in the declaration part of this package as
151
** follows
152
**
153
#define EVAL_BOOL_EXPR(expr) \
154
( (*EvalBoolFuncs[ TNUM_EXPR( expr ) ])( expr ) )
155
*/
156
157
158
/****************************************************************************
159
**
160
*V EvalBoolFuncs[<type>] . . boolean evaluator for expression of type <type>
161
**
162
** 'EvalBoolFuncs' is the dispatch table that contains for every type of
163
** expression a pointer to a boolean evaluator for expressions of this type,
164
** i.e., a pointer to a function which is guaranteed to return a boolean
165
** value that should be called to evaluate expressions of this type.
166
*/
167
Obj (* EvalBoolFuncs [256]) ( Expr expr );
168
169
170
/****************************************************************************
171
**
172
*F EvalUnknownExpr(<expr>) . . . . . . . evaluate expression of unknown type
173
**
174
** 'EvalUnknownExpr' is the evaluator that is called if an attempt is made
175
** to evaluate an expression <expr> of an unknown type. It signals an
176
** error. If this is ever called, then GAP is in serious trouble, such as
177
** an overwritten type field of an expression.
178
*/
179
Obj EvalUnknownExpr (
180
Expr expr )
181
{
182
Pr( "Panic: tried to evaluate an expression of unknown type '%d'\n",
183
(Int)TNUM_EXPR(expr), 0L );
184
return 0;
185
}
186
187
188
/****************************************************************************
189
**
190
*F EvalUnknownBool(<expr>) . . . . boolean evaluator for general expressions
191
**
192
** 'EvalUnknownBool' evaluates the expression <expr> (using 'EVAL_EXPR'),
193
** and checks that the value is either 'true' or 'false'. If the expression
194
** does not evaluate to 'true' or 'false', then an error is signalled.
195
**
196
** This is the default function in 'EvalBoolFuncs' used for expressions that
197
** are not a priori known to evaluate to a boolean value (such as
198
** function calls).
199
*/
200
Obj EvalUnknownBool (
201
Expr expr )
202
{
203
Obj val; /* value, result */
204
205
/* evaluate the expression */
206
val = EVAL_EXPR( expr );
207
208
/* check that the value is either 'true' or 'false' */
209
while ( val != True && val != False ) {
210
val = ErrorReturnObj(
211
"<expr> must be 'true' or 'false' (not a %s)",
212
(Int)TNAM_OBJ(val), 0L,
213
"you can replace <expr> via 'return <expr>;'" );
214
}
215
216
/* return the value */
217
return val;
218
}
219
220
221
/****************************************************************************
222
**
223
*F EvalOr(<expr>) . . . . . . . . . . . . . evaluate a boolean or operation
224
**
225
** 'EvalOr' evaluates the or-expression <expr> and returns its value, i.e.,
226
** 'true' if either of the operands is 'true', and 'false' otherwise.
227
** 'EvalOr' is called from 'EVAL_EXPR' to evaluate expressions of type
228
** 'T_OR'.
229
**
230
** If '<expr>.left' is already 'true' 'EvalOr' returns 'true' without
231
** evaluating '<expr>.right'. This allows constructs like
232
**
233
** if (index > max) or (list[index] = 0) then ... fi;
234
*/
235
Obj EvalOr (
236
Expr expr )
237
{
238
Obj opL; /* evaluated left operand */
239
Expr tmp; /* temporary expression */
240
241
/* evaluate and test the left operand */
242
tmp = ADDR_EXPR(expr)[0];
243
opL = EVAL_BOOL_EXPR( tmp );
244
if ( opL != False ) {
245
return True;
246
}
247
248
/* evaluate and test the right operand */
249
tmp = ADDR_EXPR(expr)[1];
250
return EVAL_BOOL_EXPR( tmp );
251
}
252
253
254
/****************************************************************************
255
**
256
*F EvalAnd(<expr>) . . . . . . . . . . . . evaluate a boolean and operation
257
**
258
** 'EvalAnd' evaluates the and-expression <expr> and returns its value,
259
** i.e., 'true' if both operands are 'true', and 'false' otherwise.
260
** 'EvalAnd' is called from 'EVAL_EXPR' to evaluate expressions of type
261
** 'T_AND'.
262
**
263
** If '<expr>.left' is already 'false' 'EvalAnd' returns 'false' without
264
** evaluating '<expr>.right'. This allows constructs like
265
**
266
** if (index <= max) and (list[index] = 0) then ... fi;
267
*/
268
extern Obj NewAndFilter (
269
Obj oper1,
270
Obj oper2 );
271
272
Obj EvalAnd (
273
Expr expr )
274
{
275
Obj opL; /* evaluated left operand */
276
Obj opR; /* evaluated right operand */
277
Expr tmp; /* temporary expression */
278
279
/* if the left operand is 'false', this is the result */
280
tmp = ADDR_EXPR(expr)[0];
281
opL = EVAL_EXPR( tmp );
282
if ( opL == False ) {
283
return opL;
284
}
285
286
/* if the left operand is 'true', the result is the right operand */
287
else if ( opL == True ) {
288
tmp = ADDR_EXPR(expr)[1];
289
return EVAL_BOOL_EXPR( tmp );
290
}
291
292
/* handle the 'and' of two filters */
293
else if ( TNUM_OBJ(opL) == T_FUNCTION ) {
294
tmp = ADDR_EXPR(expr)[1];
295
opR = EVAL_EXPR( tmp );
296
if ( TNUM_OBJ(opR) == T_FUNCTION ) {
297
return NewAndFilter( opL, opR );
298
}
299
else {
300
ErrorQuit(
301
"<expr> must be 'true' or 'false' (not a %s)",
302
(Int)TNAM_OBJ(opL), 0L );
303
}
304
}
305
306
/* signal an error */
307
else {
308
ErrorQuit(
309
"<expr> must be 'true' or 'false' (not a %s)",
310
(Int)TNAM_OBJ(opL), 0L );
311
}
312
313
/* please 'lint' */
314
return 0;
315
}
316
317
318
/****************************************************************************
319
**
320
*F EvalNot(<expr>) . . . . . . . . . . . . . . . . . negate a boolean value
321
**
322
** 'EvalNot' evaluates the not-expression <expr> and returns its value,
323
** i.e., 'true' if the operand is 'false', and 'false' otherwise. 'EvalNot'
324
** is called from 'EVAL_EXPR' to evaluate expressions of type 'T_NOT'.
325
*/
326
Obj EvalNot (
327
Expr expr )
328
{
329
Obj val; /* value, result */
330
Obj op; /* evaluated operand */
331
Expr tmp; /* temporary expression */
332
333
/* evaluate the operand to a boolean */
334
tmp = ADDR_EXPR(expr)[0];
335
op = EVAL_BOOL_EXPR( tmp );
336
337
/* compute the negation */
338
val = (op == False ? True : False);
339
340
/* return the negated value */
341
return val;
342
}
343
344
345
/****************************************************************************
346
**
347
*F EvalEq(<expr>) . . . . . . . . . . . . . . . . . . evaluate a comparison
348
**
349
** 'EvalEq' evaluates the equality-expression <expr> and returns its value,
350
** i.e., 'true' if the operand '<expr>.left' is equal to the operand
351
** '<expr>.right' and 'false' otherwise. 'EvalEq' is called from
352
** 'EVAL_EXPR' to evaluate expressions of type 'T_EQ'.
353
**
354
** 'EvalEq' evaluates the operands and then calls the 'EQ' macro.
355
*/
356
Obj EvalEq (
357
Expr expr )
358
{
359
Obj val; /* value, result */
360
Obj opL; /* evaluated left operand */
361
Obj opR; /* evaluated right operand */
362
Expr tmp; /* temporary expression */
363
364
/* get the operands */
365
tmp = ADDR_EXPR(expr)[0];
366
opL = EVAL_EXPR( tmp );
367
tmp = ADDR_EXPR(expr)[1];
368
opR = EVAL_EXPR( tmp );
369
370
/* compare the operands */
371
SET_BRK_CALL_TO(expr); /* Note possible call for FuncWhere */
372
val = (EQ( opL, opR ) ? True : False);
373
374
/* return the value */
375
return val;
376
}
377
378
379
/****************************************************************************
380
**
381
*F EvalNe(<expr>) . . . . . . . . . . . . . . . . . . evaluate a comparison
382
**
383
** 'EvalNe' evaluates the comparison-expression <expr> and returns its
384
** value, i.e., 'true' if the operand '<expr>.left' is not equal to the
385
** operand '<expr>.right' and 'false' otherwise. 'EvalNe' is called from
386
** 'EVAL_EXPR' to evaluate expressions of type 'T_LT'.
387
**
388
** 'EvalNe' is simply implemented as 'not <objL> = <objR>'.
389
*/
390
Obj EvalNe (
391
Expr expr )
392
{
393
Obj val; /* value, result */
394
Obj opL; /* evaluated left operand */
395
Obj opR; /* evaluated right operand */
396
Expr tmp; /* temporary expression */
397
398
/* get the operands */
399
tmp = ADDR_EXPR(expr)[0];
400
opL = EVAL_EXPR( tmp );
401
tmp = ADDR_EXPR(expr)[1];
402
opR = EVAL_EXPR( tmp );
403
404
/* compare the operands */
405
SET_BRK_CALL_TO(expr); /* Note possible call for FuncWhere */
406
val = (EQ( opL, opR ) ? False : True);
407
408
/* return the value */
409
return val;
410
}
411
412
413
/****************************************************************************
414
**
415
*F EvalLt(<expr>) . . . . . . . . . . . . . . . . . . evaluate a comparison
416
**
417
** 'EvalLt' evaluates the comparison-expression <expr> and returns its
418
** value, i.e., 'true' if the operand '<expr>.left' is less than the operand
419
** '<expr>.right' and 'false' otherwise. 'EvalLt' is called from
420
** 'EVAL_EXPR' to evaluate expressions of type 'T_LT'.
421
**
422
** 'EvalLt' evaluates the operands and then calls the 'LT' macro.
423
*/
424
Obj EvalLt (
425
Expr expr )
426
{
427
Obj val; /* value, result */
428
Obj opL; /* evaluated left operand */
429
Obj opR; /* evaluated right operand */
430
Expr tmp; /* temporary expression */
431
432
/* get the operands */
433
tmp = ADDR_EXPR(expr)[0];
434
opL = EVAL_EXPR( tmp );
435
tmp = ADDR_EXPR(expr)[1];
436
opR = EVAL_EXPR( tmp );
437
438
/* compare the operands */
439
SET_BRK_CALL_TO(expr); /* Note possible call for FuncWhere */
440
val = (LT( opL, opR ) ? True : False);
441
442
/* return the value */
443
return val;
444
}
445
446
447
/****************************************************************************
448
**
449
*F EvalGe(<expr>) . . . . . . . . . . . . . . . . . . evaluate a comparison
450
**
451
** 'EvalGe' evaluates the comparison-expression <expr> and returns its
452
** value, i.e., 'true' if the operand '<expr>.left' is greater than or equal
453
** to the operand '<expr>.right' and 'false' otherwise. 'EvalGe' is called
454
** from 'EVAL_EXPR' to evaluate expressions of type 'T_GE'.
455
**
456
** 'EvalGe' is simply implemented as 'not <objL> < <objR>'.
457
*/
458
Obj EvalGe (
459
Expr expr )
460
{
461
Obj val; /* value, result */
462
Obj opL; /* evaluated left operand */
463
Obj opR; /* evaluated right operand */
464
Expr tmp; /* temporary expression */
465
466
/* get the operands */
467
tmp = ADDR_EXPR(expr)[0];
468
opL = EVAL_EXPR( tmp );
469
tmp = ADDR_EXPR(expr)[1];
470
opR = EVAL_EXPR( tmp );
471
472
/* compare the operands */
473
SET_BRK_CALL_TO(expr); /* Note possible call for FuncWhere */
474
val = (LT( opL, opR ) ? False : True);
475
476
/* return the value */
477
return val;
478
}
479
480
481
/****************************************************************************
482
**
483
*F EvalGt(<expr>) . . . . . . . . . . . . . . . . . . evaluate a comparison
484
**
485
** 'EvalGt' evaluates the comparison-expression <expr> and returns its
486
** value, i.e., 'true' if the operand '<expr>.left' is greater than the
487
** operand '<expr>.right' and 'false' otherwise. 'EvalGt' is called from
488
** 'EVAL_EXPR' to evaluate expressions of type 'T_GT'.
489
**
490
** 'EvalGt' is simply implemented as '<objR> < <objL>'.
491
*/
492
Obj EvalGt (
493
Expr expr )
494
{
495
Obj val; /* value, result */
496
Obj opL; /* evaluated left operand */
497
Obj opR; /* evaluated right operand */
498
Expr tmp; /* temporary expression */
499
500
/* get the operands */
501
tmp = ADDR_EXPR(expr)[0];
502
opL = EVAL_EXPR( tmp );
503
tmp = ADDR_EXPR(expr)[1];
504
opR = EVAL_EXPR( tmp );
505
506
/* compare the operands */
507
SET_BRK_CALL_TO(expr); /* Note possible call for FuncWhere */
508
val = (LT( opR, opL ) ? True : False);
509
510
/* return the value */
511
return val;
512
}
513
514
515
/****************************************************************************
516
**
517
*F EvalLe(<expr>) . . . . . . . . . . . . . . . . . . evaluate a comparison
518
**
519
** 'EvalLe' evaluates the comparison-expression <expr> and returns its
520
** value, i.e., 'true' if the operand '<expr>.left' is less or equal to the
521
** operand '<expr>.right' and 'false' otherwise. 'EvalLe' is called from
522
** 'EVAL_EXPR' to evaluate expressions of type 'T_LE'.
523
**
524
** 'EvalLe' is simply implemented as 'not <objR> < <objR>'.
525
*/
526
Obj EvalLe (
527
Expr expr )
528
{
529
Obj val; /* value, result */
530
Obj opL; /* evaluated left operand */
531
Obj opR; /* evaluated right operand */
532
Expr tmp; /* temporary expression */
533
534
/* get the operands */
535
tmp = ADDR_EXPR(expr)[0];
536
opL = EVAL_EXPR( tmp );
537
tmp = ADDR_EXPR(expr)[1];
538
opR = EVAL_EXPR( tmp );
539
540
/* compare the operands */
541
SET_BRK_CALL_TO(expr); /* Note possible call for FuncWhere */
542
val = (LT( opR, opL ) ? False : True);
543
544
/* return the value */
545
return val;
546
}
547
548
549
/****************************************************************************
550
**
551
*F EvalIn(<in>) . . . . . . . . . . . . . . . test for membership in a list
552
**
553
** 'EvalIn' evaluates the in-expression <expr> and returns its value, i.e.,
554
** 'true' if the operand '<expr>.left' is a member of '<expr>.right' and
555
** 'false' otherwise. 'EvalIn' is called from 'EVAL_EXPR' to evaluate
556
** expressions of type 'T_IN'.
557
*/
558
Obj EvalIn (
559
Expr expr )
560
{
561
Obj val; /* value, result */
562
Obj opL; /* evaluated left operand */
563
Obj opR; /* evaluated right operand */
564
Expr tmp; /* temporary expression */
565
566
/* evaluate <opL> */
567
tmp = ADDR_EXPR(expr)[0];
568
opL = EVAL_EXPR( tmp );
569
570
/* evaluate <opR> */
571
tmp = ADDR_EXPR(expr)[1];
572
opR = EVAL_EXPR( tmp );
573
574
/* perform the test */
575
SET_BRK_CALL_TO(expr); /* Note possible call for FuncWhere */
576
val = (IN( opL, opR ) ? True : False);
577
578
/* return the value */
579
return val;
580
}
581
582
583
/****************************************************************************
584
**
585
*F EvalSum(<expr>) . . . . . . . . . . . . . . . . . . . . . evaluate a sum
586
**
587
** 'EvalSum' evaluates the sum-expression <expr> and returns its value,
588
** i.e., the sum of the two operands '<expr>.left' and '<expr>.right'.
589
** 'EvalSum' is called from 'EVAL_EXPR' to evaluate expressions of type
590
** 'T_SUM'.
591
**
592
** 'EvalSum' evaluates the operands and then calls the 'SUM' macro.
593
*/
594
Obj EvalSum (
595
Expr expr )
596
{
597
Obj val; /* value, result */
598
Obj opL; /* evaluated left operand */
599
Obj opR; /* evaluated right operand */
600
Expr tmp; /* temporary expression */
601
602
/* get the operands */
603
tmp = ADDR_EXPR(expr)[0];
604
opL = EVAL_EXPR( tmp );
605
tmp = ADDR_EXPR(expr)[1];
606
opR = EVAL_EXPR( tmp );
607
608
/* first try to treat the operands as small integers with small result */
609
if ( ! ARE_INTOBJS( opL, opR ) || ! SUM_INTOBJS( val, opL, opR ) ) {
610
611
/* if that doesn't work, dispatch to the addition function */
612
SET_BRK_CALL_TO(expr); /* Note possible call for FuncWhere */
613
val = SUM( opL, opR );
614
615
}
616
617
/* return the value */
618
return val;
619
}
620
621
622
/****************************************************************************
623
**
624
*F EvalAInv(<expr>) . . . . . . . . . . . . . . evaluate a additive inverse
625
**
626
** 'EvalAInv' evaluates the additive inverse-expression and returns its
627
** value, i.e., the additive inverse of the operand. 'EvalAInv' is called
628
** from 'EVAL_EXPR' to evaluate expressions of type 'T_AINV'.
629
**
630
** 'EvalAInv' evaluates the operand and then calls the 'AINV' macro.
631
*/
632
Obj EvalAInv (
633
Expr expr )
634
{
635
Obj val; /* value, result */
636
Obj opL; /* evaluated left operand */
637
Expr tmp; /* temporary expression */
638
639
/* get the operands */
640
tmp = ADDR_EXPR(expr)[0];
641
opL = EVAL_EXPR( tmp );
642
643
/* compute the additive inverse */
644
SET_BRK_CALL_TO(expr); /* Note possible call for FuncWhere */
645
val = AINV( opL );
646
647
/* return the value */
648
return val;
649
}
650
651
652
/****************************************************************************
653
**
654
*F EvalDiff(<expr>) . . . . . . . . . . . . . . . . . evaluate a difference
655
**
656
** 'EvalDiff' evaluates the difference-expression <expr> and returns its
657
** value, i.e., the difference of the two operands '<expr>.left' and
658
** '<expr>.right'. 'EvalDiff' is called from 'EVAL_EXPR' to evaluate
659
** expressions of type 'T_DIFF'.
660
**
661
** 'EvalDiff' evaluates the operands and then calls the 'DIFF' macro.
662
*/
663
Obj EvalDiff (
664
Expr expr )
665
{
666
Obj val; /* value, result */
667
Obj opL; /* evaluated left operand */
668
Obj opR; /* evaluated right operand */
669
Expr tmp; /* temporary expression */
670
671
/* get the operands */
672
tmp = ADDR_EXPR(expr)[0];
673
opL = EVAL_EXPR( tmp );
674
tmp = ADDR_EXPR(expr)[1];
675
opR = EVAL_EXPR( tmp );
676
677
/* first try to treat the operands as small integers with small result */
678
if ( ! ARE_INTOBJS( opL, opR ) || ! DIFF_INTOBJS( val, opL, opR ) ) {
679
680
/* if that doesn't work, dispatch to the subtraction function */
681
SET_BRK_CALL_TO(expr); /* Note possible call for FuncWhere */
682
val = DIFF( opL, opR );
683
684
}
685
686
/* return the value */
687
return val;
688
}
689
690
691
/****************************************************************************
692
**
693
*F EvalProd(<expr>) . . . . . . . . . . . . . . . . . . evaluate a product
694
**
695
** 'EvalProd' evaluates the product-expression <expr> and returns it value,
696
** i.e., the product of the two operands '<expr>.left' and '<expr>.right'.
697
** 'EvalProd' is called from 'EVAL_EXPR' to evaluate expressions of type
698
** 'T_PROD'.
699
**
700
** 'EvalProd' evaluates the operands and then calls the 'PROD' macro.
701
*/
702
Obj EvalProd (
703
Expr expr )
704
{
705
Obj val; /* result */
706
Obj opL; /* evaluated left operand */
707
Obj opR; /* evaluated right operand */
708
Expr tmp; /* temporary expression */
709
710
/* get the operands */
711
tmp = ADDR_EXPR(expr)[0];
712
opL = EVAL_EXPR( tmp );
713
tmp = ADDR_EXPR(expr)[1];
714
opR = EVAL_EXPR( tmp );
715
716
/* first try to treat the operands as small integers with small result */
717
if ( ! ARE_INTOBJS( opL, opR ) || ! PROD_INTOBJS( val, opL, opR ) ) {
718
719
/* if that doesn't work, dispatch to the multiplication function */
720
SET_BRK_CALL_TO(expr); /* Note possible call for FuncWhere */
721
val = PROD( opL, opR );
722
723
}
724
725
/* return the value */
726
return val;
727
}
728
729
730
/****************************************************************************
731
**
732
*F EvalInv(<expr>) . . . . . . . . . . . . evaluate a multiplicative inverse
733
**
734
** 'EvalInv' evaluates the multiplicative inverse-expression and returns its
735
** value, i.e., the multiplicative inverse of the operand. 'EvalInv' is
736
** called from 'EVAL_EXPR' to evaluate expressions of type 'T_INV'.
737
**
738
** 'EvalInv' evaluates the operand and then calls the 'INV' macro.
739
*/
740
Obj EvalInv (
741
Expr expr )
742
{
743
Obj val; /* value, result */
744
Obj opL; /* evaluated left operand */
745
Expr tmp; /* temporary expression */
746
747
/* get the operands */
748
tmp = ADDR_EXPR(expr)[0];
749
opL = EVAL_EXPR( tmp );
750
751
/* compute the multiplicative inverse */
752
SET_BRK_CALL_TO(expr); /* Note possible call for FuncWhere */
753
val = INV_MUT( opL );
754
755
/* return the value */
756
return val;
757
}
758
759
760
/****************************************************************************
761
**
762
*F EvalQuo(<expr>) . . . . . . . . . . . . . . . . . . . evaluate a quotient
763
**
764
** 'EvalQuo' evaluates the quotient-expression <expr> and returns its value,
765
** i.e., the quotient of the two operands '<expr>.left' and '<expr>.right'.
766
** 'EvalQuo' is called from 'EVAL_EXPR' to evaluate expressions of type
767
** 'T_QUO'.
768
**
769
** 'EvalQuo' evaluates the operands and then calls the 'QUO' macro.
770
*/
771
Obj EvalQuo (
772
Expr expr )
773
{
774
Obj val; /* value, result */
775
Obj opL; /* evaluated left operand */
776
Obj opR; /* evaluated right operand */
777
Expr tmp; /* temporary expression */
778
779
/* get the operands */
780
tmp = ADDR_EXPR(expr)[0];
781
opL = EVAL_EXPR( tmp );
782
tmp = ADDR_EXPR(expr)[1];
783
opR = EVAL_EXPR( tmp );
784
785
/* dispatch to the division function */
786
SET_BRK_CALL_TO(expr); /* Note possible call for FuncWhere */
787
val = QUO( opL, opR );
788
789
/* return the value */
790
return val;
791
}
792
793
794
/****************************************************************************
795
**
796
*F EvalMod(<expr>) . . . . . . . . . . . . . . . . . . evaluate a remainder
797
**
798
** 'EvalMod' evaluates the remainder-expression <expr> and returns its
799
** value, i.e., the remainder of the two operands '<expr>.left' and
800
** '<expr>.right'. 'EvalMod' is called from 'EVAL_EXPR' to evaluate
801
** expressions of type 'T_MOD'.
802
**
803
** 'EvalMod' evaluates the operands and then calls the 'MOD' macro.
804
*/
805
Obj EvalMod (
806
Expr expr )
807
{
808
Obj val; /* value, result */
809
Obj opL; /* evaluated left operand */
810
Obj opR; /* evaluated right operand */
811
Expr tmp; /* temporary expression */
812
813
/* get the operands */
814
tmp = ADDR_EXPR(expr)[0];
815
opL = EVAL_EXPR( tmp );
816
tmp = ADDR_EXPR(expr)[1];
817
opR = EVAL_EXPR( tmp );
818
819
/* dispatch to the remainder function */
820
SET_BRK_CALL_TO(expr); /* Note possible call for FuncWhere */
821
val = MOD( opL, opR );
822
823
/* return the value */
824
return val;
825
}
826
827
828
/****************************************************************************
829
**
830
*F EvalPow(<expr>) . . . . . . . . . . . . . . . . . . . . evaluate a power
831
**
832
** 'EvalPow' evaluates the power-expression <expr> and returns its value,
833
** i.e., the power of the two operands '<expr>.left' and '<expr>.right'.
834
** 'EvalPow' is called from 'EVAL_EXPR' to evaluate expressions of type
835
** 'T_POW'.
836
**
837
** 'EvalPow' evaluates the operands and then calls the 'POW' macro.
838
*/
839
Obj EvalPow (
840
Expr expr )
841
{
842
Obj val; /* value, result */
843
Obj opL; /* evaluated left operand */
844
Obj opR; /* evaluated right operand */
845
Expr tmp; /* temporary expression */
846
847
/* get the operands */
848
tmp = ADDR_EXPR(expr)[0];
849
opL = EVAL_EXPR( tmp );
850
tmp = ADDR_EXPR(expr)[1];
851
opR = EVAL_EXPR( tmp );
852
853
/* dispatch to the powering function */
854
SET_BRK_CALL_TO(expr); /* Note possible call for FuncWhere */
855
val = POW( opL, opR );
856
857
/* return the value */
858
return val;
859
}
860
861
862
/****************************************************************************
863
**
864
*F EvalIntExpr(<expr>) . . . . . . . . . evaluate literal integer expression
865
**
866
** 'EvalIntExpr' evaluates the literal integer expression <expr> and returns
867
** its value.
868
*/
869
#define IDDR_EXPR(expr) ((UInt2*)ADDR_EXPR(expr))
870
871
Obj EvalIntExpr (
872
Expr expr )
873
{
874
Obj val; /* integer, result */
875
876
877
/* allocate the integer */
878
val = NewBag( ((UInt *)ADDR_EXPR(expr))[0], SIZE_EXPR(expr)-sizeof(UInt));
879
memcpy((void *)ADDR_OBJ(val), (void *)(((UInt *)ADDR_EXPR(expr))+1), (size_t) (SIZE_EXPR(expr)-sizeof(UInt)));
880
881
/* return the value */
882
return val;
883
}
884
885
886
/****************************************************************************
887
**
888
*F EvalTrueExpr(<expr>) . . . . . . . . . evaluate literal true expression
889
**
890
** 'EvalTrueExpr' evaluates the literal true expression <expr> and returns
891
** its value (True).
892
*/
893
Obj EvalTrueExpr (
894
Expr expr )
895
{
896
return True;
897
}
898
899
900
/****************************************************************************
901
**
902
*F EvalFalseExpr(<expr>) . . . . . . . . . evaluate literal false expression
903
**
904
** 'EvalFalseExpr' evaluates the literal false expression <expr> and returns
905
** its value (False).
906
*/
907
Obj EvalFalseExpr (
908
Expr expr )
909
{
910
return False;
911
}
912
913
914
/****************************************************************************
915
**
916
*F EvalCharExpr(<expr>) . . . . . . evaluate a literal character expression
917
**
918
** 'EvalCharExpr' evaluates the literal character expression <expr> and
919
** returns its value.
920
*/
921
Obj EvalCharExpr (
922
Expr expr )
923
{
924
return ObjsChar[ ((UChar*)ADDR_EXPR(expr))[0] ];
925
}
926
927
928
/****************************************************************************
929
**
930
*F EvalPermExpr(<expr>) . . . . . . . . . evaluate a permutation expression
931
**
932
** 'EvalPermExpr' evaluates the permutation expression <expr>.
933
*/
934
Obj EvalPermExpr (
935
Expr expr )
936
{
937
Obj perm; /* permutation, result */
938
UInt4 * ptr4; /* pointer into perm */
939
UInt2 * ptr2; /* pointer into perm */
940
Obj val; /* one entry as value */
941
UInt c, p, l; /* entries in permutation */
942
UInt m; /* maximal entry in permutation */
943
Expr cycle; /* one cycle of permutation */
944
UInt i, j, k; /* loop variable */
945
946
/* special case for identity permutation */
947
if ( SIZE_EXPR(expr) == 0 ) {
948
return IdentityPerm;
949
}
950
951
/* allocate the new permutation */
952
m = 0;
953
perm = NEW_PERM4( 0 );
954
955
/* loop over the cycles */
956
for ( i = 1; i <= SIZE_EXPR(expr)/sizeof(Expr); i++ ) {
957
cycle = ADDR_EXPR(expr)[i-1];
958
959
/* loop over the entries of the cycle */
960
c = p = l = 0;
961
for ( j = SIZE_EXPR(cycle)/sizeof(Expr); 1 <= j; j-- ) {
962
963
/* get and check current entry for the cycle */
964
val = EVAL_EXPR( ADDR_EXPR( cycle )[j-1] );
965
while ( ! IS_INTOBJ(val) || INT_INTOBJ(val) <= 0 ) {
966
val = ErrorReturnObj(
967
"Permutation: <expr> must be a positive integer (not a %s)",
968
(Int)TNAM_OBJ(val), 0L,
969
"you can replace <expr> via 'return <expr>;'" );
970
}
971
c = INT_INTOBJ(val);
972
973
/* if necessary resize the permutation */
974
if ( SIZE_OBJ(perm)/sizeof(UInt4) < c ) {
975
ResizeBag( perm, (c + 1023) / 1024 * 1024 * sizeof(UInt4) );
976
ptr4 = ADDR_PERM4( perm );
977
for ( k = m+1; k <= SIZE_OBJ(perm)/sizeof(UInt4); k++ ) {
978
ptr4[k-1] = k-1;
979
}
980
}
981
if ( m < c ) {
982
m = c;
983
}
984
985
/* check that the cycles are disjoint */
986
ptr4 = ADDR_PERM4( perm );
987
if ( (p != 0 && p == c) || (ptr4[c-1] != c-1) ) {
988
return ErrorReturnObj(
989
"Permutation: cycles must be disjoint",
990
0L, 0L,
991
"you can replace permutation <perm> via 'return <perm>;'" );
992
}
993
994
/* enter the previous entry at current location */
995
ptr4 = ADDR_PERM4( perm );
996
if ( p != 0 ) { ptr4[c-1] = p-1; }
997
else { l = c; }
998
999
/* remember current entry for next round */
1000
p = c;
1001
}
1002
1003
/* enter first (last popped) entry at last (first popped) location */
1004
ptr4 = ADDR_PERM4( perm );
1005
ptr4[l-1] = p-1;
1006
1007
}
1008
1009
/* if possible represent the permutation with short entries */
1010
if ( m <= 65536UL ) {
1011
ptr2 = ADDR_PERM2( perm );
1012
ptr4 = ADDR_PERM4( perm );
1013
for ( k = 1; k <= m; k++ ) {
1014
ptr2[k-1] = ptr4[k-1];
1015
};
1016
RetypeBag( perm, T_PERM2 );
1017
ResizeBag( perm, m * sizeof(UInt2) );
1018
}
1019
1020
/* otherwise just shorten the permutation */
1021
else {
1022
ResizeBag( perm, m * sizeof(UInt4) );
1023
}
1024
1025
/* return the permutation */
1026
return perm;
1027
}
1028
1029
1030
/****************************************************************************
1031
**
1032
*F EvalListExpr(<expr>) . . . . . evaluate list expression to a list value
1033
**
1034
** 'EvalListExpr' evaluates the list expression, i.e., not yet evaluated
1035
** list, <expr> to a list value.
1036
**
1037
** 'EvalListExpr' just calls 'ListExpr1' and 'ListExpr2' to evaluate the
1038
** list expression.
1039
*/
1040
Obj ListExpr1 ( Expr expr );
1041
void ListExpr2 ( Obj list, Expr expr );
1042
Obj RecExpr1 ( Expr expr );
1043
void RecExpr2 ( Obj rec, Expr expr );
1044
1045
Obj EvalListExpr (
1046
Expr expr )
1047
{
1048
Obj list; /* list value, result */
1049
1050
/* evalute the list expression */
1051
list = ListExpr1( expr );
1052
ListExpr2( list, expr );
1053
1054
/* return the result */
1055
return list;
1056
}
1057
1058
1059
/****************************************************************************
1060
**
1061
*F EvalListTildeExpr(<expr>) . . . . evaluate a list expression with a tilde
1062
**
1063
** 'EvalListTildeExpr' evaluates the list expression, i.e., not yet
1064
** evaluated list, <expr> to a list value. The difference to 'EvalListExpr'
1065
** is that in <expr> there are occurrences of '~' referring to this list
1066
** value.
1067
**
1068
** 'EvalListTildeExpr' just calls 'ListExpr1' to create the list, assigns
1069
** the list to the variable '~', and finally calls 'ListExpr2' to evaluate
1070
** the subexpressions into the list. Thus subexpressions in the list
1071
** expression can refer to this variable and its subobjects to create
1072
** objects that are not trees.
1073
*/
1074
Obj EvalListTildeExpr (
1075
Expr expr )
1076
{
1077
Obj list; /* list value, result */
1078
Obj tilde; /* old value of tilde */
1079
1080
/* remember the old value of '~' */
1081
tilde = VAL_GVAR( Tilde );
1082
1083
/* create the list value */
1084
list = ListExpr1( expr );
1085
1086
/* assign the list to '~' */
1087
AssGVar( Tilde, list );
1088
1089
/* evaluate the subexpressions into the list value */
1090
ListExpr2( list, expr );
1091
1092
/* restore old value of '~' */
1093
AssGVar( Tilde, tilde );
1094
1095
/* return the list value */
1096
return list;
1097
}
1098
1099
1100
/****************************************************************************
1101
**
1102
*F ListExpr1(<expr>) . . . . . . . . . . . make a list for a list expression
1103
*F ListExpr2(<list>,<expr>) . . . enter the sublists for a list expression
1104
**
1105
** 'ListExpr1' and 'ListExpr2' together evaluate the list expression <expr>
1106
** into the list <list>.
1107
**
1108
** 'ListExpr1' allocates a new plain list of the same size as the list
1109
** expression <expr> and returns this list.
1110
**
1111
** 'ListExpr2' evaluates the subexpression of <expr> and puts the values
1112
** into the list <list> (which should be a plain list of the same size as
1113
** the list expression <expr>, e.g., the one allocated by 'ListExpr1').
1114
**
1115
** This two step allocation is necessary, because list expressions such as
1116
** '[ [1], ~[1] ]' requires that the value of one subexpression is entered
1117
** into the list value before the next subexpression is evaluated.
1118
*/
1119
Obj ListExpr1 (
1120
Expr expr )
1121
{
1122
Obj list; /* list value, result */
1123
Int len; /* logical length of the list */
1124
1125
/* get the length of the list */
1126
len = SIZE_EXPR(expr) / sizeof(Expr);
1127
1128
/* allocate the list value */
1129
if ( 0 == len ) {
1130
list = NEW_PLIST( T_PLIST_EMPTY, len );
1131
}
1132
else {
1133
list = NEW_PLIST( T_PLIST, len );
1134
}
1135
SET_LEN_PLIST( list, len );
1136
1137
/* return the list */
1138
return list;
1139
}
1140
1141
void ListExpr2 (
1142
Obj list,
1143
Expr expr )
1144
{
1145
Obj sub; /* value of a subexpression */
1146
Int len; /* logical length of the list */
1147
Int i; /* loop variable */
1148
Int posshole; /* initially 0, set to 1 at
1149
first empty position, then
1150
next full position causes
1151
the list to be made
1152
non-dense */
1153
1154
/* get the length of the list */
1155
len = SIZE_EXPR(expr) / sizeof(Expr);
1156
1157
/* initially we have not seen a hole */
1158
posshole = 0;
1159
1160
/* handle the subexpressions */
1161
for ( i = 1; i <= len; i++ ) {
1162
1163
/* if the subexpression is empty */
1164
if ( ADDR_EXPR(expr)[i-1] == 0 ) {
1165
if (!posshole)
1166
posshole = 1;
1167
continue;
1168
}
1169
else
1170
{
1171
if (posshole == 1)
1172
{
1173
SET_FILT_LIST(list, FN_IS_NDENSE);
1174
posshole = 2;
1175
}
1176
1177
/* special case if subexpression is a list expression */
1178
if ( TNUM_EXPR( ADDR_EXPR(expr)[i-1] ) == T_LIST_EXPR ) {
1179
sub = ListExpr1( ADDR_EXPR(expr)[i-1] );
1180
SET_ELM_PLIST( list, i, sub );
1181
CHANGED_BAG( list );
1182
ListExpr2( sub, ADDR_EXPR(expr)[i-1] );
1183
}
1184
1185
/* special case if subexpression is a record expression */
1186
else if ( TNUM_EXPR( ADDR_EXPR(expr)[i-1] ) == T_REC_EXPR ) {
1187
sub = RecExpr1( ADDR_EXPR(expr)[i-1] );
1188
SET_ELM_PLIST( list, i, sub );
1189
CHANGED_BAG( list );
1190
RecExpr2( sub, ADDR_EXPR(expr)[i-1] );
1191
}
1192
1193
/* general case */
1194
else {
1195
sub = EVAL_EXPR( ADDR_EXPR(expr)[i-1] );
1196
SET_ELM_PLIST( list, i, sub );
1197
CHANGED_BAG( list );
1198
}
1199
}
1200
1201
}
1202
if (!posshole)
1203
SET_FILT_LIST(list, FN_IS_DENSE);
1204
1205
}
1206
1207
1208
/****************************************************************************
1209
**
1210
*F EvalRangeExpr(<expr>) . . . . . eval a range expression to a range value
1211
**
1212
** 'EvalRangeExpr' evaluates the range expression <expr> to a range value.
1213
*/
1214
Obj EvalRangeExpr (
1215
Expr expr )
1216
{
1217
Obj range; /* range, result */
1218
Obj val; /* subvalue of range */
1219
Int low; /* low (as C integer) */
1220
Int inc; /* increment (as C integer) */
1221
Int high; /* high (as C integer) */
1222
1223
/* evaluate the low value */
1224
val = EVAL_EXPR( ADDR_EXPR(expr)[0] );
1225
while ( ! IS_INTOBJ(val) ) {
1226
val = ErrorReturnObj(
1227
"Range: <first> must be an integer less than 2^%d (not a %s)",
1228
NR_SMALL_INT_BITS, (Int)TNAM_OBJ(val),
1229
"you can replace <first> via 'return <first>;'" );
1230
}
1231
low = INT_INTOBJ( val );
1232
1233
/* evaluate the second value (if present) */
1234
if ( SIZE_EXPR(expr) == 3*sizeof(Expr) ) {
1235
val = EVAL_EXPR( ADDR_EXPR(expr)[1] );
1236
while ( ! IS_INTOBJ(val) || INT_INTOBJ(val) == low ) {
1237
if ( ! IS_INTOBJ(val) ) {
1238
val = ErrorReturnObj(
1239
"Range: <second> must be an integer less than 2^%d (not a %s)",
1240
NR_SMALL_INT_BITS, (Int)TNAM_OBJ(val),
1241
"you can replace <second> via 'return <second>;'" );
1242
}
1243
else {
1244
val = ErrorReturnObj(
1245
"Range: <second> must not be equal to <first> (%d)",
1246
(Int)low, 0L,
1247
"you can replace the integer <second> via 'return <second>;'" );
1248
}
1249
}
1250
inc = INT_INTOBJ(val) - low;
1251
}
1252
else {
1253
inc = 1;
1254
}
1255
1256
/* evaluate and check the high value */
1257
val = EVAL_EXPR( ADDR_EXPR(expr)[ SIZE_EXPR(expr)/sizeof(Expr)-1 ] );
1258
while ( ! IS_INTOBJ(val) || (INT_INTOBJ(val) - low) % inc != 0 ) {
1259
if ( ! IS_INTOBJ(val) ) {
1260
val = ErrorReturnObj(
1261
"Range: <last> must be an integer less than 2^%d (not a %s)",
1262
NR_SMALL_INT_BITS, (Int)TNAM_OBJ(val),
1263
"you can replace <last> via 'return <last>;'" );
1264
}
1265
else {
1266
val = ErrorReturnObj(
1267
"Range: <last>-<first> (%d) must be divisible by <inc> (%d)",
1268
(Int)(INT_INTOBJ(val)-low), (Int)inc,
1269
"you can replace the integer <last> via 'return <last>;'" );
1270
}
1271
}
1272
high = INT_INTOBJ(val);
1273
1274
/* if <low> is larger than <high> the range is empty */
1275
if ( (0 < inc && high < low) || (inc < 0 && low < high) ) {
1276
range = NEW_PLIST( T_PLIST, 0 );
1277
SET_LEN_PLIST( range, 0 );
1278
}
1279
1280
/* if <low> is equal to <high> the range is a singleton list */
1281
else if ( low == high ) {
1282
range = NEW_PLIST( T_PLIST, 1 );
1283
SET_LEN_PLIST( range, 1 );
1284
SET_ELM_PLIST( range, 1, INTOBJ_INT(low) );
1285
}
1286
1287
/* else make the range */
1288
else {
1289
/* the length must be a small integer as well */
1290
if ((high-low) / inc + 1 >= (1L<<NR_SMALL_INT_BITS)) {
1291
ErrorQuit("Range: the length of a range must be less than 2^%d.",
1292
NR_SMALL_INT_BITS, 0L);
1293
}
1294
if ( 0 < inc )
1295
range = NEW_RANGE_SSORT();
1296
else
1297
range = NEW_RANGE_NSORT();
1298
SET_LEN_RANGE( range, (high-low) / inc + 1 );
1299
SET_LOW_RANGE( range, low );
1300
SET_INC_RANGE( range, inc );
1301
}
1302
1303
/* return the range */
1304
return range;
1305
}
1306
1307
1308
/****************************************************************************
1309
**
1310
*F EvalStringExpr(<expr>) . . . . eval string expressions to a string value
1311
**
1312
** 'EvalStringExpr' evaluates the string expression <expr> to a string
1313
** value.
1314
*/
1315
Obj EvalStringExpr (
1316
Expr expr )
1317
{
1318
Obj string; /* string value, result */
1319
UInt len; /* size of expression */
1320
1321
len = *((UInt *)ADDR_EXPR(expr));
1322
string = NEW_STRING(len);
1323
memcpy((void *)ADDR_OBJ(string), (void *)ADDR_EXPR(expr),
1324
SIZEBAG_STRINGLEN(len) );
1325
1326
/* return the string */
1327
return string;
1328
}
1329
1330
/****************************************************************************
1331
**
1332
*F EvalFloatExprLazy(<expr>) . . . . eval float expressions to a float value
1333
**
1334
** 'EvalFloatExpr' evaluates the float expression <expr> to a float
1335
** value.
1336
*/
1337
static Obj CONVERT_FLOAT_LITERAL;
1338
static Obj FLOAT_LITERAL_CACHE;
1339
static UInt GVAR_FLOAT_LITERAL_CACHE;
1340
static Obj MAX_FLOAT_LITERAL_CACHE_SIZE;
1341
1342
Obj EvalFloatExprLazy (
1343
Expr expr )
1344
{
1345
Obj string; /* string value */
1346
UInt len; /* size of expression */
1347
UInt ix;
1348
Obj cache= 0;
1349
Obj fl;
1350
1351
ix = ((UInt *)ADDR_EXPR(expr))[1];
1352
if (ix && (!MAX_FLOAT_LITERAL_CACHE_SIZE ||
1353
MAX_FLOAT_LITERAL_CACHE_SIZE == INTOBJ_INT(0) ||
1354
ix <= INT_INTOBJ(MAX_FLOAT_LITERAL_CACHE_SIZE))) {
1355
cache = FLOAT_LITERAL_CACHE;
1356
if (!cache)
1357
{
1358
cache = NEW_PLIST(T_PLIST,ix);
1359
AssGVar(GVAR_FLOAT_LITERAL_CACHE, cache);
1360
}
1361
else
1362
assert(IS_PLIST(cache));
1363
GROW_PLIST(cache,ix);
1364
fl = ELM_PLIST(cache,ix);
1365
if (fl)
1366
return fl;
1367
}
1368
len = *((UInt *)ADDR_EXPR(expr));
1369
string = NEW_STRING(len);
1370
memcpy((void *)CHARS_STRING(string),
1371
(void *)((char *)ADDR_EXPR(expr) + 2*sizeof(UInt)),
1372
len );
1373
fl = CALL_1ARGS(CONVERT_FLOAT_LITERAL, string);
1374
if (cache) {
1375
SET_ELM_PLIST(cache, ix, fl);
1376
CHANGED_BAG(cache);
1377
if (LEN_PLIST(cache) < ix)
1378
SET_LEN_PLIST(cache, ix);
1379
}
1380
1381
return fl;
1382
}
1383
1384
/****************************************************************************
1385
**
1386
*F EvalFloatExprEager(<expr>) . . . . eval float expressions to a float value
1387
**
1388
** 'EvalFloatExpr' evaluates the float expression <expr> to a float
1389
** value.
1390
*/
1391
static Obj EAGER_FLOAT_LITERAL_CACHE;
1392
1393
Obj EvalFloatExprEager (
1394
Expr expr )
1395
{
1396
UInt ix;
1397
Obj cache= 0;
1398
Obj fl;
1399
1400
ix = ((UInt *)ADDR_EXPR(expr))[0];
1401
cache = EAGER_FLOAT_LITERAL_CACHE;
1402
assert(IS_PLIST(cache));
1403
fl = ELM_PLIST(cache,ix);
1404
assert(fl);
1405
return fl;
1406
}
1407
1408
1409
/****************************************************************************
1410
**
1411
*F EvalRecExpr(<expr>) . . . . . . eval record expression to a record value
1412
**
1413
** 'EvalRecExpr' evaluates the record expression, i.e., not yet evaluated
1414
** record, <expr> to a record value.
1415
**
1416
** 'EvalRecExpr' just calls 'RecExpr1' and 'RecExpr2' to evaluate the record
1417
** expression.
1418
*/
1419
Obj EvalRecExpr (
1420
Expr expr )
1421
{
1422
Obj rec; /* record value, result */
1423
1424
/* evaluate the record expression */
1425
rec = RecExpr1( expr );
1426
RecExpr2( rec, expr );
1427
1428
/* return the result */
1429
return rec;
1430
}
1431
1432
1433
/****************************************************************************
1434
**
1435
*F EvalRecTildeExpr(<expr>) . . . evaluate a record expression with a tilde
1436
**
1437
** 'EvalRecTildeExpr' evaluates the record expression, i.e., not yet
1438
** evaluated record, <expr> to a record value. The difference to
1439
** 'EvalRecExpr' is that in <expr> there are occurrences of '~' referring to
1440
** this record value.
1441
**
1442
** 'EvalRecTildeExpr' just calls 'RecExpr1' to create teh record, assigns
1443
** the record to the variable '~', and finally calls 'RecExpr2' to evaluate
1444
** the subexpressions into the record. Thus subexpressions in the record
1445
** expression can refer to this variable and its subobjects to create
1446
** objects that are not trees.
1447
*/
1448
Obj EvalRecTildeExpr (
1449
Expr expr )
1450
{
1451
Obj rec; /* record value, result */
1452
Obj tilde; /* old value of tilde */
1453
1454
/* remember the old value of '~' */
1455
tilde = VAL_GVAR( Tilde );
1456
1457
/* create the record value */
1458
rec = RecExpr1( expr );
1459
1460
/* assign the record value to the variable '~' */
1461
AssGVar( Tilde, rec );
1462
1463
/* evaluate the subexpressions into the record value */
1464
RecExpr2( rec, expr );
1465
1466
/* restore the old value of '~' */
1467
AssGVar( Tilde, tilde );
1468
1469
/* return the record value */
1470
return rec;
1471
}
1472
1473
1474
/****************************************************************************
1475
**
1476
*F RecExpr1(<expr>) . . . . . . . . . make a record for a record expression
1477
*F RecExpr2(<rec>,<expr>) . . enter the subobjects for a record expression
1478
**
1479
** 'RecExpr1' and 'RecExpr2' together evaluate the record expression <expr>
1480
** into the record <rec>.
1481
**
1482
** 'RecExpr1' allocates a new record of the same size as the record
1483
** expression <expr> and returns this record.
1484
**
1485
** 'RecExpr2' evaluates the subexpressions of <expr> and puts the values
1486
** into the record <rec> (which should be a record of the same size as the
1487
** record expression <expr>, e.g., the one allocated by 'RecExpr1').
1488
**
1489
** This two step allocation is necessary, because record expressions such as
1490
** 'rec( a := 1, ~.a )' requires that the value of one subexpression is
1491
** entered into the record value before the next subexpression is evaluated.
1492
*/
1493
Obj RecExpr1 (
1494
Expr expr )
1495
{
1496
Obj rec; /* record value, result */
1497
Int len; /* number of components */
1498
1499
/* get the number of components */
1500
len = SIZE_EXPR( expr ) / (2*sizeof(Expr));
1501
1502
/* allocate the record value */
1503
rec = NEW_PREC( len );
1504
1505
/* return the record */
1506
return rec;
1507
}
1508
1509
void RecExpr2 (
1510
Obj rec,
1511
Expr expr )
1512
{
1513
UInt rnam; /* name of component */
1514
Obj sub; /* value of subexpression */
1515
Int len; /* number of components */
1516
Expr tmp; /* temporary variable */
1517
Int i; /* loop variable */
1518
1519
/* get the number of components */
1520
len = SIZE_EXPR( expr ) / (2*sizeof(Expr));
1521
1522
/* handle the subexpressions */
1523
for ( i = 1; i <= len; i++ ) {
1524
1525
/* handle the name */
1526
tmp = ADDR_EXPR(expr)[2*i-2];
1527
if ( IS_INTEXPR(tmp) ) {
1528
rnam = (UInt)INT_INTEXPR(tmp);
1529
}
1530
else {
1531
rnam = RNamObj( EVAL_EXPR(tmp) );
1532
}
1533
1534
/* if the subexpression is empty (cannot happen for records) */
1535
tmp = ADDR_EXPR(expr)[2*i-1];
1536
if ( tmp == 0 ) {
1537
continue;
1538
}
1539
1540
/* special case if subexpression is a list expression */
1541
else if ( TNUM_EXPR( tmp ) == T_LIST_EXPR ) {
1542
sub = ListExpr1( tmp );
1543
AssPRec(rec,rnam,sub);
1544
ListExpr2( sub, tmp );
1545
}
1546
1547
/* special case if subexpression is a record expression */
1548
else if ( TNUM_EXPR( tmp ) == T_REC_EXPR ) {
1549
sub = RecExpr1( tmp );
1550
AssPRec(rec,rnam,sub);
1551
RecExpr2( sub, tmp );
1552
}
1553
1554
/* general case */
1555
else {
1556
sub = EVAL_EXPR( tmp );
1557
AssPRec(rec,rnam,sub);
1558
}
1559
}
1560
SortPRecRNam(rec,0);
1561
1562
}
1563
1564
1565
/****************************************************************************
1566
**
1567
*F PrintExpr(<expr>) . . . . . . . . . . . . . . . . . . print an expression
1568
**
1569
** 'PrintExpr' prints the expression <expr>.
1570
**
1571
** 'PrintExpr' simply dispatches through the table 'PrintExprFuncs' to the
1572
** appropriate printer.
1573
*/
1574
void PrintExpr (
1575
Expr expr )
1576
{
1577
(*PrintExprFuncs[ TNUM_EXPR(expr) ])( expr );
1578
}
1579
1580
1581
/****************************************************************************
1582
**
1583
*V PrintExprFuncs[<type>] . . printing function for objects of type <type>
1584
**
1585
** 'PrintExprFuncs' is the dispatching table that contains for every type of
1586
** expressions a pointer to the printer for expressions of this type, i.e.,
1587
** the function that should be called to print expressions of this type.
1588
*/
1589
void (* PrintExprFuncs[256] ) ( Expr expr );
1590
1591
1592
/****************************************************************************
1593
**
1594
*F PrintUnknownExpr(<expr>) . . . . . . . print expression of unknown type
1595
**
1596
** 'PrintUnknownExpr' is the printer that is called if an attempt is made to
1597
** print an expression <expr> of an unknown type. It signals an error. If
1598
** this is ever called, then GAP is in serious trouble, such as an
1599
** overwritten type field of an expression.
1600
*/
1601
void PrintUnknownExpr (
1602
Expr expr )
1603
{
1604
Pr( "Panic: tried to print an expression of unknown type '%d'\n",
1605
(Int)TNUM_EXPR(expr), 0L );
1606
}
1607
1608
1609
/****************************************************************************
1610
**
1611
*V PrintPreceedence . . . . . . . . . . . . . . . current preceedence level
1612
**
1613
** 'PrintPreceedence' contains the current preceedence level, i.e. an
1614
** integer indicating the binding power of the currently printed operator.
1615
** If one of the operands is an operation that has lower binding power it is
1616
** printed in parenthesis. If the right operand has the same binding power
1617
** it is put in parenthesis, since all the operations are left associative.
1618
** Preceedence: 14: ^; 12: mod,/,*; 10: -,+; 8: in,=; 6: not; 4: and; 2: or.
1619
** This sometimes puts in superflous parenthesis: 2 * f( (3 + 4) ), since it
1620
** doesn't know that a function call adds automatically parenthesis.
1621
*/
1622
UInt PrintPreceedence;
1623
1624
1625
/****************************************************************************
1626
**
1627
*F PrintNot(<expr>) . . . . . . . . . . . . . print a boolean not operator
1628
**
1629
** 'PrintNot' print a not operation in the following form: 'not <expr>'.
1630
*/
1631
void PrintNot (
1632
Expr expr )
1633
{
1634
UInt oldPrec;
1635
1636
oldPrec = PrintPreceedence;
1637
PrintPreceedence = 6;
1638
1639
/* if necessary print the opening parenthesis */
1640
if ( oldPrec >= PrintPreceedence ) Pr("%>(%>",0L,0L);
1641
else Pr("%2>",0L,0L);
1642
1643
Pr("not%> ",0L,0L);
1644
PrintExpr( ADDR_EXPR(expr)[0] );
1645
Pr("%<",0L,0L);
1646
1647
/* if necessary print the closing parenthesis */
1648
if ( oldPrec >= PrintPreceedence ) Pr("%2<)",0L,0L);
1649
else Pr("%2<",0L,0L);
1650
1651
PrintPreceedence = oldPrec;
1652
}
1653
1654
1655
/****************************************************************************
1656
**
1657
*F PrintBinop(<expr>) . . . . . . . . . . . . . . prints a binary operator
1658
**
1659
** 'PrintBinop' prints the binary operator expression <expr>, using
1660
** 'PrintPreceedence' for parenthesising.
1661
*/
1662
void PrintAInv (
1663
Expr expr )
1664
{
1665
UInt oldPrec;
1666
1667
oldPrec = PrintPreceedence;
1668
PrintPreceedence = 11;
1669
1670
/* if necessary print the opening parenthesis */
1671
if ( oldPrec >= PrintPreceedence ) Pr("%>(%>",0L,0L);
1672
else Pr("%2>",0L,0L);
1673
1674
Pr("-%> ",0L,0L);
1675
PrintExpr( ADDR_EXPR(expr)[0] );
1676
Pr("%<",0L,0L);
1677
1678
/* if necessary print the closing parenthesis */
1679
if ( oldPrec >= PrintPreceedence ) Pr("%2<)",0L,0L);
1680
else Pr("%2<",0L,0L);
1681
1682
PrintPreceedence = oldPrec;
1683
}
1684
1685
void PrintInv (
1686
Expr expr )
1687
{
1688
UInt oldPrec;
1689
1690
oldPrec = PrintPreceedence;
1691
PrintPreceedence = 14;
1692
Pr("%> ",0L,0L);
1693
PrintExpr( ADDR_EXPR(expr)[0] );
1694
Pr("%<^-1",0L,0L);
1695
PrintPreceedence = oldPrec;
1696
}
1697
1698
void PrintBinop (
1699
Expr expr )
1700
{
1701
UInt oldPrec; /* old preceedence level */
1702
const Char * op; /* operand */
1703
/* remember the current preceedence level */
1704
oldPrec = PrintPreceedence;
1705
1706
/* select the new preceedence level */
1707
switch ( TNUM_EXPR(expr) ) {
1708
case T_OR: op = "or"; PrintPreceedence = 2; break;
1709
case T_AND: op = "and"; PrintPreceedence = 4; break;
1710
case T_EQ: op = "="; PrintPreceedence = 8; break;
1711
case T_LT: op = "<"; PrintPreceedence = 8; break;
1712
case T_GT: op = ">"; PrintPreceedence = 8; break;
1713
case T_NE: op = "<>"; PrintPreceedence = 8; break;
1714
case T_LE: op = "<="; PrintPreceedence = 8; break;
1715
case T_GE: op = ">="; PrintPreceedence = 8; break;
1716
case T_IN: op = "in"; PrintPreceedence = 8; break;
1717
case T_SUM: op = "+"; PrintPreceedence = 10; break;
1718
case T_DIFF: op = "-"; PrintPreceedence = 10; break;
1719
case T_PROD: op = "*"; PrintPreceedence = 12; break;
1720
case T_QUO: op = "/"; PrintPreceedence = 12; break;
1721
case T_MOD: op = "mod"; PrintPreceedence = 12; break;
1722
case T_POW: op = "^"; PrintPreceedence = 16; break;
1723
default: op = "<bogus-operator>"; break;
1724
}
1725
1726
/* if necessary print the opening parenthesis */
1727
if ( oldPrec > PrintPreceedence ) Pr("%>(%>",0L,0L);
1728
else Pr("%2>",0L,0L);
1729
1730
/* print the left operand */
1731
if ( TNUM_EXPR(expr) == T_POW
1732
&& (( (IS_INTEXPR(ADDR_EXPR(expr)[0])
1733
&& INT_INTEXPR(ADDR_EXPR(expr)[0]) < 0)
1734
|| TNUM_EXPR(ADDR_EXPR(expr)[0]) == T_INTNEG)
1735
|| TNUM_EXPR(ADDR_EXPR(expr)[0]) == T_POW) ) {
1736
Pr( "(", 0L, 0L );
1737
PrintExpr( ADDR_EXPR(expr)[0] );
1738
Pr( ")", 0L, 0L );
1739
}
1740
else {
1741
PrintExpr( ADDR_EXPR(expr)[0] );
1742
}
1743
1744
/* print the operator */
1745
Pr("%2< %2>%s%> %<",(Int)op,0L);
1746
1747
/* print the right operand */
1748
PrintPreceedence++;
1749
PrintExpr( ADDR_EXPR(expr)[1] );
1750
PrintPreceedence--;
1751
1752
/* if necessary print the closing parenthesis */
1753
if ( oldPrec > PrintPreceedence ) Pr("%2<)",0L,0L);
1754
else Pr("%2<",0L,0L);
1755
1756
/* restore the old preceedence level */
1757
PrintPreceedence = oldPrec;
1758
}
1759
1760
1761
/****************************************************************************
1762
**
1763
*F PrintIntExpr(<expr>) . . . . . . . . . . . . print an integer expression
1764
**
1765
** 'PrintIntExpr' prints the literal integer expression <expr>.
1766
*/
1767
void PrintIntExpr (
1768
Expr expr )
1769
{
1770
if ( IS_INTEXPR(expr) ) {
1771
Pr( "%d", INT_INTEXPR(expr), 0L );
1772
}
1773
else {
1774
PrintInt(EvalIntExpr(expr));
1775
}
1776
}
1777
1778
1779
/****************************************************************************
1780
**
1781
*F PrintTrueExpr(<expr>) . . . . . . . . . . . print literal true expression
1782
*/
1783
void PrintTrueExpr (
1784
Expr expr )
1785
{
1786
Pr( "true", 0L, 0L );
1787
}
1788
1789
1790
/****************************************************************************
1791
**
1792
*F PrintFalseExpr(<expr>) . . . . . . . . . print literal false expression
1793
*/
1794
void PrintFalseExpr (
1795
Expr expr )
1796
{
1797
Pr( "false", 0L, 0L );
1798
}
1799
1800
1801
/****************************************************************************
1802
**
1803
*F PrintCharExpr(<expr>) . . . . . . . . print literal character expression
1804
*/
1805
void PrintCharExpr (
1806
Expr expr )
1807
{
1808
UChar chr;
1809
1810
chr = *(UChar*)ADDR_EXPR(expr);
1811
if ( chr == '\n' ) Pr("'\\n'",0L,0L);
1812
else if ( chr == '\t' ) Pr("'\\t'",0L,0L);
1813
else if ( chr == '\r' ) Pr("'\\r'",0L,0L);
1814
else if ( chr == '\b' ) Pr("'\\b'",0L,0L);
1815
else if ( chr == '\03' ) Pr("'\\c'",0L,0L);
1816
else if ( chr == '\'' ) Pr("'\\''",0L,0L);
1817
else if ( chr == '\\' ) Pr("'\\\\'",0L,0L);
1818
else Pr("'%c'",(Int)chr,0L);
1819
}
1820
1821
1822
/****************************************************************************
1823
**
1824
*F PrintPermExpr(<expr>) . . . . . . . . . . print a permutation expression
1825
**
1826
** 'PrintPermExpr' prints the permutation expression <expr>.
1827
*/
1828
void PrintPermExpr (
1829
Expr expr )
1830
{
1831
Expr cycle; /* one cycle of permutation expr. */
1832
UInt i, j; /* loop variables */
1833
1834
/* if there are no cycles, print the identity permutation */
1835
if ( SIZE_EXPR(expr) == 0 ) {
1836
Pr("()",0L,0L);
1837
}
1838
1839
/* print all cycles */
1840
for ( i = 1; i <= SIZE_EXPR(expr)/sizeof(Expr); i++ ) {
1841
cycle = ADDR_EXPR(expr)[i-1];
1842
Pr("%>(",0L,0L);
1843
1844
/* print all entries of that cycle */
1845
for ( j = 1; j <= SIZE_EXPR(cycle)/sizeof(Expr); j++ ) {
1846
Pr("%>",0L,0L);
1847
PrintExpr( ADDR_EXPR(cycle)[j-1] );
1848
Pr("%<",0L,0L);
1849
if ( j < SIZE_EXPR(cycle)/sizeof(Expr) ) Pr(",",0L,0L);
1850
}
1851
1852
Pr("%<)",0L,0L);
1853
}
1854
}
1855
1856
1857
/****************************************************************************
1858
**
1859
*F PrintListExpr(<expr>) . . . . . . . . . . . . . . print a list expression
1860
**
1861
** 'PrintListExpr' prints the list expression <expr>.
1862
*/
1863
void PrintListExpr (
1864
Expr expr )
1865
{
1866
Int len; /* logical length of <list> */
1867
Expr elm; /* one element from <list> */
1868
Int i; /* loop variable */
1869
1870
/* get the logical length of the list */
1871
len = SIZE_EXPR( expr ) / sizeof(Expr);
1872
1873
/* loop over the entries */
1874
Pr("%2>[ %2>",0L,0L);
1875
for ( i = 1; i <= len; i++ ) {
1876
elm = ADDR_EXPR(expr)[i-1];
1877
if ( elm != 0 ) {
1878
if ( 1 < i ) Pr("%<,%< %2>",0L,0L);
1879
PrintExpr( elm );
1880
}
1881
else {
1882
if ( 1 < i ) Pr("%2<,%2>",0L,0L);
1883
}
1884
}
1885
Pr(" %4<]",0L,0L);
1886
}
1887
1888
1889
/****************************************************************************
1890
**
1891
*F PrintRangeExpr(<expr>) . . . . . . . . . . . . . print range expression
1892
**
1893
** 'PrintRangeExpr' prints the record expression <expr>.
1894
*/
1895
void PrintRangeExpr (
1896
Expr expr )
1897
{
1898
if ( SIZE_EXPR( expr ) == 2*sizeof(Expr) ) {
1899
Pr("%2>[ %2>",0L,0L); PrintExpr( ADDR_EXPR(expr)[0] );
1900
Pr("%2< .. %2>",0L,0L); PrintExpr( ADDR_EXPR(expr)[1] );
1901
Pr(" %4<]",0L,0L);
1902
}
1903
else {
1904
Pr("%2>[ %2>",0L,0L); PrintExpr( ADDR_EXPR(expr)[0] );
1905
Pr("%<,%< %2>",0L,0L); PrintExpr( ADDR_EXPR(expr)[1] );
1906
Pr("%2< .. %2>",0L,0L); PrintExpr( ADDR_EXPR(expr)[2] );
1907
Pr(" %4<]",0L,0L);
1908
}
1909
}
1910
1911
1912
/****************************************************************************
1913
**
1914
*F PrintStringExpr(<expr>) . . . . . . . . . . . . print a string expression
1915
**
1916
** 'PrintStringExpr' prints the string expression <expr>.
1917
*/
1918
void PrintStringExpr (
1919
Expr expr )
1920
{
1921
PrintString(EvalStringExpr(expr));
1922
/*Pr( "\"%S\"", (Int)ADDR_EXPR(expr), 0L );*/
1923
}
1924
1925
/****************************************************************************
1926
**
1927
*F PrintFloatExpr(<expr>) . . . . . . . . . . . . print a float expression
1928
**
1929
** 'PrintFloatExpr' prints the float expression <expr>.
1930
*/
1931
void PrintFloatExprLazy (
1932
Expr expr )
1933
{
1934
Pr("%s", (Int)(((char *)ADDR_EXPR(expr) + 2*sizeof(UInt))), 0L);
1935
}
1936
1937
/****************************************************************************
1938
**
1939
*F PrintFloatExprEager(<expr>) . . . . . . . . . . . . print a float expression
1940
**
1941
** 'PrintFloatExpr' prints the float expression <expr>.
1942
*/
1943
void PrintFloatExprEager (
1944
Expr expr )
1945
{
1946
Char mark;
1947
Pr("%s", (Int)(((char *)ADDR_EXPR(expr) + 3*sizeof(UInt))), 0L);
1948
Pr("_",0L,0L);
1949
mark = (Char)(((UInt *)ADDR_EXPR(expr))[2]);
1950
if (mark != '\0') {
1951
Pr("%c",mark,0L);
1952
}
1953
}
1954
1955
1956
/****************************************************************************
1957
**
1958
*F PrintRecExpr(<expr>) . . . . . . . . . . . . . print a record expression
1959
**
1960
** 'PrintRecExpr' the record expression <expr>.
1961
*/
1962
void PrintRecExpr1 (
1963
Expr expr )
1964
{
1965
Expr tmp; /* temporary variable */
1966
UInt i; /* loop variable */
1967
1968
for ( i = 1; i <= SIZE_EXPR(expr)/(2*sizeof(Expr)); i++ ) {
1969
/* print an ordinary record name */
1970
tmp = ADDR_EXPR(expr)[2*i-2];
1971
if ( IS_INTEXPR(tmp) ) {
1972
Pr( "%I", (Int)NAME_RNAM( INT_INTEXPR(tmp) ), 0L );
1973
}
1974
1975
/* print an evaluating record name */
1976
else {
1977
Pr(" (",0L,0L);
1978
PrintExpr( tmp );
1979
Pr(")",0L,0L);
1980
}
1981
1982
/* print the component */
1983
tmp = ADDR_EXPR(expr)[2*i-1];
1984
Pr("%< := %>",0L,0L);
1985
PrintExpr( tmp );
1986
if ( i < SIZE_EXPR(expr)/(2*sizeof(Expr)) )
1987
Pr("%2<,\n%2>",0L,0L);
1988
1989
}
1990
}
1991
1992
void PrintRecExpr (
1993
Expr expr )
1994
{
1995
Pr("%2>rec(\n%2>",0L,0L);
1996
PrintRecExpr1(expr);
1997
Pr(" %4<)",0L,0L);
1998
1999
}
2000
2001
2002
/****************************************************************************
2003
**
2004
2005
*F * * * * * * * * * * * * * initialize package * * * * * * * * * * * * * * *
2006
*/
2007
2008
2009
/****************************************************************************
2010
**
2011
2012
*F InitKernel( <module> ) . . . . . . . . initialise kernel data structures
2013
*/
2014
static Int InitKernel (
2015
StructInitInfo * module )
2016
{
2017
UInt type; /* loop variable */
2018
2019
InitFopyGVar("CONVERT_FLOAT_LITERAL",&CONVERT_FLOAT_LITERAL);
2020
InitCopyGVar("FLOAT_LITERAL_CACHE",&FLOAT_LITERAL_CACHE);
2021
InitCopyGVar("EAGER_FLOAT_LITERAL_CACHE",&EAGER_FLOAT_LITERAL_CACHE);
2022
InitCopyGVar("MAX_FLOAT_LITERAL_CACHE_SIZE",&MAX_FLOAT_LITERAL_CACHE_SIZE);
2023
2024
2025
/* clear the evaluation dispatch table */
2026
for ( type = 0; type < 256; type++ ) {
2027
InstallEvalExprFunc( type , EvalUnknownExpr);
2028
InstallEvalBoolFunc( type , EvalUnknownBool);
2029
}
2030
2031
/* install the evaluators for logical operations */
2032
InstallEvalExprFunc( T_OR , EvalOr);
2033
InstallEvalExprFunc( T_AND , EvalAnd);
2034
InstallEvalExprFunc( T_NOT , EvalNot);
2035
2036
/* the logical operations are guaranteed to return booleans */
2037
InstallEvalBoolFunc( T_OR , EvalOr);
2038
InstallEvalBoolFunc( T_AND , EvalAnd);
2039
InstallEvalBoolFunc( T_NOT , EvalNot);
2040
2041
/* install the evaluators for comparison operations */
2042
InstallEvalExprFunc( T_EQ , EvalEq);
2043
InstallEvalExprFunc( T_NE , EvalNe);
2044
InstallEvalExprFunc( T_LT , EvalLt);
2045
InstallEvalExprFunc( T_GE , EvalGe);
2046
InstallEvalExprFunc( T_GT , EvalGt);
2047
InstallEvalExprFunc( T_LE , EvalLe);
2048
InstallEvalExprFunc( T_IN , EvalIn);
2049
2050
/* the comparison operations are guaranteed to return booleans */
2051
InstallEvalBoolFunc( T_EQ , EvalEq);
2052
InstallEvalBoolFunc( T_NE , EvalNe);
2053
InstallEvalBoolFunc( T_LT , EvalLt);
2054
InstallEvalBoolFunc( T_GE , EvalGe);
2055
InstallEvalBoolFunc( T_GT , EvalGt);
2056
InstallEvalBoolFunc( T_LE , EvalLe);
2057
InstallEvalBoolFunc( T_IN , EvalIn);
2058
2059
/* install the evaluators for binary operations */
2060
InstallEvalExprFunc( T_SUM , EvalSum);
2061
InstallEvalExprFunc( T_AINV , EvalAInv);
2062
InstallEvalExprFunc( T_DIFF , EvalDiff);
2063
InstallEvalExprFunc( T_PROD , EvalProd);
2064
InstallEvalExprFunc( T_INV , EvalInv);
2065
InstallEvalExprFunc( T_QUO , EvalQuo);
2066
InstallEvalExprFunc( T_MOD , EvalMod);
2067
InstallEvalExprFunc( T_POW , EvalPow);
2068
2069
/* install the evaluators for literal expressions */
2070
InstallEvalExprFunc( T_INT_EXPR , EvalIntExpr);
2071
InstallEvalExprFunc( T_TRUE_EXPR , EvalTrueExpr);
2072
InstallEvalExprFunc( T_FALSE_EXPR , EvalFalseExpr);
2073
InstallEvalExprFunc( T_CHAR_EXPR , EvalCharExpr);
2074
InstallEvalExprFunc( T_PERM_EXPR , EvalPermExpr);
2075
2076
/* install the evaluators for list and record expressions */
2077
InstallEvalExprFunc( T_LIST_EXPR , EvalListExpr);
2078
InstallEvalExprFunc( T_LIST_TILD_EXPR , EvalListTildeExpr);
2079
InstallEvalExprFunc( T_RANGE_EXPR , EvalRangeExpr);
2080
InstallEvalExprFunc( T_STRING_EXPR , EvalStringExpr);
2081
InstallEvalExprFunc( T_REC_EXPR , EvalRecExpr);
2082
InstallEvalExprFunc( T_REC_TILD_EXPR , EvalRecTildeExpr);
2083
InstallEvalExprFunc( T_FLOAT_EXPR_LAZY , EvalFloatExprLazy);
2084
InstallEvalExprFunc( T_FLOAT_EXPR_EAGER , EvalFloatExprEager);
2085
2086
/* clear the tables for the printing dispatching */
2087
for ( type = 0; type < 256; type++ ) {
2088
InstallPrintExprFunc( type , PrintUnknownExpr);
2089
}
2090
2091
/* install the printers for logical operations */
2092
InstallPrintExprFunc( T_OR , PrintBinop);
2093
InstallPrintExprFunc( T_AND , PrintBinop);
2094
InstallPrintExprFunc( T_NOT , PrintNot);
2095
2096
/* install the printers for comparison operations */
2097
InstallPrintExprFunc( T_EQ , PrintBinop);
2098
InstallPrintExprFunc( T_LT , PrintBinop);
2099
InstallPrintExprFunc( T_NE , PrintBinop);
2100
InstallPrintExprFunc( T_GE , PrintBinop);
2101
InstallPrintExprFunc( T_GT , PrintBinop);
2102
InstallPrintExprFunc( T_LE , PrintBinop);
2103
InstallPrintExprFunc( T_IN , PrintBinop);
2104
2105
/* install the printers for binary operations */
2106
InstallPrintExprFunc( T_SUM , PrintBinop);
2107
InstallPrintExprFunc( T_AINV , PrintAInv);
2108
InstallPrintExprFunc( T_DIFF , PrintBinop);
2109
InstallPrintExprFunc( T_PROD , PrintBinop);
2110
InstallPrintExprFunc( T_INV , PrintInv);
2111
InstallPrintExprFunc( T_QUO , PrintBinop);
2112
InstallPrintExprFunc( T_MOD , PrintBinop);
2113
InstallPrintExprFunc( T_POW , PrintBinop);
2114
2115
/* install the printers for literal expressions */
2116
InstallPrintExprFunc( T_INTEXPR , PrintIntExpr);
2117
InstallPrintExprFunc( T_INT_EXPR , PrintIntExpr);
2118
InstallPrintExprFunc( T_TRUE_EXPR , PrintTrueExpr);
2119
InstallPrintExprFunc( T_FALSE_EXPR , PrintFalseExpr);
2120
InstallPrintExprFunc( T_CHAR_EXPR , PrintCharExpr);
2121
InstallPrintExprFunc( T_PERM_EXPR , PrintPermExpr);
2122
2123
/* install the printers for list and record expressions */
2124
InstallPrintExprFunc( T_LIST_EXPR , PrintListExpr);
2125
InstallPrintExprFunc( T_LIST_TILD_EXPR , PrintListExpr);
2126
InstallPrintExprFunc( T_RANGE_EXPR , PrintRangeExpr);
2127
InstallPrintExprFunc( T_STRING_EXPR , PrintStringExpr);
2128
InstallPrintExprFunc( T_FLOAT_EXPR_LAZY , PrintFloatExprLazy);
2129
InstallPrintExprFunc( T_FLOAT_EXPR_EAGER , PrintFloatExprEager);
2130
InstallPrintExprFunc( T_REC_EXPR , PrintRecExpr);
2131
InstallPrintExprFunc( T_REC_TILD_EXPR , PrintRecExpr);
2132
2133
/* return success */
2134
return 0;
2135
}
2136
2137
2138
static Int InitLibrary (
2139
StructInitInfo * module )
2140
{
2141
GVAR_FLOAT_LITERAL_CACHE = GVarName("FLOAT_LITERAL_CACHE");
2142
return 0;
2143
}
2144
2145
/****************************************************************************
2146
**
2147
*F InitInfoExprs() . . . . . . . . . . . . . . . . . table of init functions
2148
*/
2149
static StructInitInfo module = {
2150
MODULE_BUILTIN, /* type */
2151
"exprs", /* name */
2152
0, /* revision entry of c file */
2153
0, /* revision entry of h file */
2154
0, /* version */
2155
0, /* crc */
2156
InitKernel, /* initKernel */
2157
InitLibrary, /* initLibrary */
2158
0, /* checkInit */
2159
0, /* preSave */
2160
0, /* postSave */
2161
InitLibrary /* postRestore */
2162
};
2163
2164
StructInitInfo * InitInfoExprs ( void )
2165
{
2166
return &module;
2167
}
2168
2169
2170
/****************************************************************************
2171
**
2172
2173
*E exprs.c . . . . . . . . . . . . . . . . . . . . . . . . . . . . ends here
2174
*/
2175
2176