CoCalc -- exprs.c

Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.

GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
Project: cocalc-sagemath-dev-slelievre
Views: ⁴¹⁸³⁴⁶
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
Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.

Product

Resources

Company

Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more, all in one place.

Real-time collaboration for Jupyter Notebooks, Linux Terminals, LaTeX, VS Code, R IDE, and more,
all in one place.
