CoCalc -- fplsa4.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
Path: gap4r8 / pkg / FPLSA-1.2.1 / src / fplsa4.c
Views: ⁴¹⁸³⁴⁶
1
/************************************************************************/
2
/*      File fplsa4.c   Last touch January 5, 1999                      */
3
/*      Calculation of finitely presented Lie superalgebras             */
4
/*      Version 4 of April 15, 1997.                                    */
5
/*      e-mail: [email protected], [email protected]                          */
6
/*                      Contents                                        */
7
/*_0    Choice of compilation                                           */
8
/*_1    System constants                                                */
9
/*_2    Type definitions                                                */
10
/*_3    Constants and enumerations                                      */
11
/*_4    Macrodefinitions                                                */
12
/*_5    Global variables and arrays                                     */
13
/*_6    Function descriptions                                           */
14
/*_6_0    Main and top level functions                                  */
15
/*_6_1    Pairing functions                                             */
16
/*_6_2    Substitution (replacing) functions                            */
17
/*_6_3    Lie and scalar algebra functions                              */
18
/*_6_4    Scalar polynomial algebraic functions                         */
19
/*_6_5    Big number functions                                          */
20
/*_6_6    Copy and delete functions                                     */
21
/*_6_7    Technical functions                                           */
22
/*_6_8    Input functions                                               */
23
/*_6_9    Output functions                                              */
24
/*_6_10   Debugging functions                                           */
25
/************************************************************************/
26

27

28
/*_0    Choice of compilation============================================*/
29

30
#define RATIONAL_FIELD  /*  Working over the field R ??
31
                            otherwise over the ring Z */
32
#define ECHO_TO_SCREEN        /* Echo session to screen ?? */
33
#define RELATION_N_TO_SCREEN  /* Watch increasing RelationN ?? */
34
//#define SPP_2000  /* Big ending computer ?? */
35
#define SPACE_STATISTICS  /* Space statistics ?? */
36
//#define INTEGER_MAX_SIZE  /* Multiprecision number maximum size ?? */
37
//#define INTEGER_ALLOCATION_CHECK  /* Control of integer allocations ?? */
38
//#define POLY_ARRAY_ALLOCATION_CHECK /* Control of allocations of ?? plynomial arrays in stack */
39

40
/* GAP output ?? */
41
/* Avoid message file, session file,                              */
42
/*       compulsory suffix '.in' for input file,                  */
43
/*       and printing comments to the screen ?                    */
44
#define GAP
45
/**/
46

47
//#define DEBUG /* Debugging ?? */
48
//#define MEMORY /* Check memory balance ?? */
49

50
/* Include files	*/
51

52
#include <stdio.h>
53
#include <time.h>
54
#include <stdlib.h>
55
#include <ctype.h>
56
#include <string.h>
57
#if defined(SPP_2000)
58
#include <alloca.h>  /* This file the genuine SPP compiler requires */
59
#endif
60

61

62
#if defined(__GNUC__) || defined(__clang__)
63
#define ATTRIBUTE_NORETURN  __attribute__ ((noreturn))
64
#else
65
#define ATTRIBUTE_NORETURN
66
#endif
67

68

69
#if defined(DEBUG)  /* Debug definitions ===============================*/
70

71
/* Set condition for debug output ??
72
*/
73
#define D_CONDITION   if(Debug>=5873)
74
/*            Examples of D_CONDITION
75
      `empty' if(Debug>=11951211) current!!
76
      if(Debug>=25283LU)*e7* *e70*
77
      if(Debug%10 == 0)  if(Debug>=17566)    */
78
/* Set condition to stop debugging ??
79
*/
80
#define D_EXIT  if(Debug > 5882) EXIT;
81
/*            Examples of D_EXIT
82
      `empty' if(Debug > 21420LU) EXIT;
83
       if(Debug > 26969LU) EXIT;*e7* if(Debug > 21420LU) EXIT;*e70*
84
       if(Debug > 30881LU) EXIT; if(Debug >= 18399) EXIT;
85
*/
86

87
/* Switches for debugging particular functions ?? */
88

89
#define D_CHECK_EXACTNESS_OF_DIVISION
90
//#define D_ADD_PAIR_TO_LIE_MONOMIAL
91
#define D_GENERATE_RELATIONS
92
//#if defined(D_GENERATE_RELATIONS)  /* Put tables ?? */
93
//#define D_PUT_RELATIONS
94
//#define D_PUT_LIE_MONOMIAL
95
//#define D_GET_LIE_MONOMIAL
96
//#define D_GET_LIE_SUM
97
//#define D_GET_LIE_TERM
98
#define D_INTEGER_CANCELLATION
99
#define D_INTEGER_GCD
100
#define D_INTEGER_PRODUCT
101
#define D_INTEGER_QUOTIENT
102
#define D_INTEGER_SUM
103
#define D_LIE_SUM_ADDITION
104
#define D_LIE_SUM_DIV_INTEGER
105
//#define D_LIE_SUM_DIV_SCALAR_SUM
106
#define D_LIE_SUM_MULT_INTEGER
107
//#define D_LIE_SUM_MULT_SCALAR_SUM
108
#define D_MAKE_RELATION_RHS
109
//#define D_NEW_JACOBI_RELATION
110
#define D_NORMALIZE_RELATION
111
//#define D_PAIR_MONOMIAL_MONOMIAL
112
//#define D_PAIR_MONOMIAL_SUM
113
//#define D_PAIR_SUM_MONOMIAL
114
//#define D_PAIR_SUM_SUM
115
//#define D_POLY_CONTENT
116
//#define D_POLY_GCD
117
//#define D_POLY_QUOTIENT
118
//#define D_POLY_PSEUDO_REMAINDER
119
//#define D_SCALAR_SUM_CANCELLATION
120
#define D_SUBSTITUTE_RELATION_IN_RELATION
121
#define D_IN_SET     uint debug=Debug;\
122
                     D_CONDITION\
123
                       PutDebugHeader(debug, f_name, "in"),
124
#define D_IN_CLOSE   Debug++; D_EXIT
125

126
#define D_OUT_OPEN   D_CONDITION PutDebugHeader(debug, f_name, "out"),
127

128
#else      /* Empty definitions for DEBUG off */
129

130
#define D_IN_SET
131
#define D_IN_CLOSE
132
#define D_OUT_OPEN
133

134
#endif
135

136
/* Check memory balance definitions */
137

138
#if defined(MEMORY)              /* `n_...' are unique */
139
#define IN_SET_N_LT      int n_lt  = -CurrentNLT;
140
#define IN_SET_N_INT     int n_int = -CurrentNINT;
141
#define IN_SET_N_ST      int n_st  = -CurrentNST;
142
#define IN_SET_N_SF      int n_sf  = -CurrentNSF;
143

144
#define OUT_SET_N_LT     n_lt  += CurrentNLT;
145
#define OUT_SET_N_INT    n_int += CurrentNINT;
146
#define OUT_SET_N_ST     n_st  += CurrentNST;
147
#define OUT_SET_N_SF     n_sf  += CurrentNSF;
148

149
#define ADD_LIE_SUM_NS(a) \
150
    AddLieSumNs(a, PLUS, &n_lt, &n_int, &n_st, &n_sf);
151

152
#define SUBTRACT_LIE_SUM_NS(a) \
153
    AddLieSumNs(a, MINUS, &n_lt, &n_int, &n_st, &n_sf);
154

155
#define ADD_SCALAR_SUM_NS(a) \
156
    AddScalarSumNs(a, PLUS, &n_int, &n_st, &n_sf);
157

158
#define SUBTRACT_SCALAR_SUM_NS(a) \
159
    AddScalarSumNs(a, MINUS, &n_int, &n_st, &n_sf);
160

161
#define CHECK_NS \
162
  if(n_lt != 0) {PutNodeBalance("\nNodeLT (Lie terms)",\
163
                                f_name, n_lt); EXIT;}\
164
  if(n_int != 0) {PutIntegerBalance(f_name, n_int); EXIT;}\
165
  if(n_st != 0) {PutNodeBalance("\nNodeST (scalar terms)",\
166
                                f_name, n_st); EXIT;}\
167
  if(n_sf != 0) {PutNodeBalance("\nNodeSF (scalar factors)",\
168
                                f_name, n_sf); EXIT;}
169

170
/* Particular functions */
171
/*----------------------------------------------------------*/
172
#define M_OUT_GET_LIE_MONOMIAL \
173
  OUT_SET_NS\
174
  SUBTRACT_LIE_SUM_NS(a)\
175
  CHECK_NS
176
/*----------------------------------------------------------*/
177
#define M_OUT_GET_LIE_SUM \
178
  OUT_SET_NS\
179
  SUBTRACT_LIE_SUM_NS(lsum)\
180
  CHECK_NS
181
/*----------------------------------------------------------*/
182
#define M_OUT_GET_LIE_TERM \
183
  OUT_SET_NS\
184
  SUBTRACT_LIE_SUM_NS(lterm)\
185
  CHECK_NS
186
/*----------------------------------------------------------*/
187
#define M_IN_LIE_SUM_ADDITION  \
188
  ADD_LIE_SUM_NS(a)\
189
  ADD_LIE_SUM_NS(b)
190
#define M_OUT_LIE_SUM_ADDITION  \
191
  OUT_SET_NS\
192
  SUBTRACT_LIE_SUM_NS(sum)\
193
  CHECK_NS
194
/*----------------------------------------------------------*/
195
/*   No sense to print debug information, memory check only */
196
#define IN_LIE_SUM_COPY  \
197
    IN_SET_FUNCTION_NAME("LieSumCopy...")\
198
    IN_SET_NS
199
#define OUT_LIE_SUM_COPY  \
200
    OUT_SET_NS\
201
    SUBTRACT_LIE_SUM_NS(ca)\
202
    CHECK_NS
203
/*----------------------------------------------------------*/
204
/*   No sense to print debug information, memory check only */
205
#define IN_LIE_SUM_KILL  \
206
    IN_SET_FUNCTION_NAME("LieSumKill...")\
207
    IN_SET_NS\
208
    ADD_LIE_SUM_NS(a)
209
#define OUT_LIE_SUM_KILL \
210
    OUT_SET_NS\
211
    CHECK_NS
212
/*----------------------------------------------------------*/
213
#define M_IN_LIE_SUM_DIV_INTEGER  \
214
  ADD_LIE_SUM_NS(b)
215
#define M_OUT_LIE_SUM_DIV_INTEGER  \
216
  OUT_SET_NS\
217
  SUBTRACT_LIE_SUM_NS(b)\
218
  CHECK_NS
219
/*----------------------------------------------------------*/
220
#define M_IN_LIE_SUM_DIV_SCALAR_SUM  \
221
  ADD_LIE_SUM_NS(b)\
222
  ADD_SCALAR_SUM_NS(den)
223
#define M_OUT_LIE_SUM_DIV_SCALAR_SUM  \
224
  OUT_SET_NS\
225
  SUBTRACT_LIE_SUM_NS(b)\
226
  CHECK_NS
227
/*----------------------------------------------------------*/
228
#define M_IN_LIE_SUM_MULT_SCALAR_SUM  \
229
  ADD_LIE_SUM_NS(b)\
230
  ADD_SCALAR_SUM_NS(num)
231
#define M_OUT_LIE_SUM_MULT_SCALAR_SUM  \
232
  OUT_SET_NS\
233
  SUBTRACT_LIE_SUM_NS(b)\
234
  CHECK_NS
235
/*----------------------------------------------------------*/
236
#define M_IN_LIE_SUM_MULT_INTEGER  \
237
  ADD_LIE_SUM_NS(b)
238
#define M_OUT_LIE_SUM_MULT_INTEGER  M_OUT_LIE_SUM_DIV_INTEGER
239
/*----------------------------------------------------------*/
240
#define M_OUT_MAKE_RELATION_RHS    M_OUT_GET_LIE_MONOMIAL
241
/*----------------------------------------------------------*/
242
#define M_OUT_NEW_JACOBI_RELATION  M_OUT_GET_LIE_MONOMIAL
243
/*----------------------------------------------------------*/
244
#define M_IN_NORMALIZE_RELATION  \
245
  ADD_LIE_SUM_NS(a)
246
#define M_OUT_NORMALIZE_RELATION   M_OUT_GET_LIE_MONOMIAL
247
/*----------------------------------------------------------*/
248
#define M_OUT_PAIR_MONOMIAL_MONOMIAL  M_OUT_GET_LIE_MONOMIAL
249
/*----------------------------------------------------------*/
250
#define M_IN_PAIR_MONOMIAL_SUM  \
251
  ADD_LIE_SUM_NS(a)
252
#define M_OUT_PAIR_MONOMIAL_SUM  \
253
  OUT_SET_NS\
254
  SUBTRACT_LIE_SUM_NS(s)\
255
  CHECK_NS
256
/*----------------------------------------------------------*/
257
#define M_IN_PAIR_SUM_MONOMIAL  \
258
  ADD_LIE_SUM_NS(a)
259
#define M_OUT_PAIR_SUM_MONOMIAL  \
260
  OUT_SET_NS\
261
  SUBTRACT_LIE_SUM_NS(s)\
262
  CHECK_NS
263
/*----------------------------------------------------------*/
264
#define M_IN_PAIR_SUM_SUM  \
265
  ADD_LIE_SUM_NS(a)\
266
  ADD_LIE_SUM_NS(b)
267
#define M_OUT_PAIR_SUM_SUM  \
268
  OUT_SET_NS\
269
  SUBTRACT_LIE_SUM_NS(a)\
270
  CHECK_NS
271
/*----------------------------------------------------------*/
272
#define M_IN_POLY_CONTENT
273
#define M_OUT_POLY_CONTENT  \
274
  OUT_SET_NS\
275
  SUBTRACT_SCALAR_SUM_NS(b)\
276
  CHECK_NS
277
/*----------------------------------------------------------*/
278
#define M_IN_POLY_GCD
279
#define M_OUT_POLY_GCD  \
280
  OUT_SET_NS\
281
  SUBTRACT_SCALAR_SUM_NS(b)\
282
  CHECK_NS
283
/*----------------------------------------------------------*/
284
#define M_IN_POLY_QUOTIENT  \
285
  ADD_SCALAR_SUM_NS(a)\
286
  ADD_SCALAR_SUM_NS(b)
287
#define M_OUT_POLY_QUOTIENT  \
288
  OUT_SET_NS\
289
  SUBTRACT_SCALAR_SUM_NS(c)\
290
  CHECK_NS
291
/*----------------------------------------------------------*/
292
#define M_IN_POLY_PSEUDO_REMAINDER  \
293
  ADD_SCALAR_SUM_NS(a)\
294
  ADD_SCALAR_SUM_NS(b)
295
#define M_OUT_POLY_PSEUDO_REMAINDER  \
296
  OUT_SET_NS\
297
  SUBTRACT_SCALAR_SUM_NS(a)\
298
  CHECK_NS
299
/*----------------------------------------------------------*/
300
/*   No sense to print debug information, memory check only */
301
#define IN_REDUCE_RELATIONS  \
302
    IN_SET_FUNCTION_NAME("ReduceRelations")\
303
    IN_SET_NS\
304
    {\
305
      int o;\
306
      for(o = 0; o < RelationN; o++)\
307
        ADD_LIE_SUM_NS(RELATION_LIE_SUM(o))\
308
    }
309
#define OUT_REDUCE_RELATIONS  \
310
    OUT_SET_NS\
311
    {\
312
      int o;\
313
      for(o = 0; o < RelationN; o++)\
314
        SUBTRACT_LIE_SUM_NS(RELATION_LIE_SUM(o))\
315
    }\
316
    CHECK_NS
317
/*----------------------------------------------------------*/
318
#define M_IN_SCALAR_SUM_CANCELLATION  \
319
  ADD_SCALAR_SUM_NS(*pnum)\
320
  ADD_SCALAR_SUM_NS(*pden)
321
#define M_OUT_SCALAR_SUM_CANCELLATION  \
322
  OUT_SET_NS\
323
  SUBTRACT_SCALAR_SUM_NS(*pnum)\
324
  SUBTRACT_SCALAR_SUM_NS(*pden)\
325
  CHECK_NS
326
/*----------------------------------------------------------*/
327
#define M_IN_SUBSTITUTE_RELATION_IN_RELATION  \
328
  ADD_LIE_SUM_NS(a)
329
#define M_OUT_SUBSTITUTE_RELATION_IN_RELATION  \
330
  OUT_SET_NS\
331
  SUBTRACT_LIE_SUM_NS(a)\
332
  CHECK_NS
333

334
#define  MM_CURRENT_N_LT    ,--CurrentNLT
335
#define  PP_CURRENT_N_LT    ++CurrentNLT;
336

337
#define  MM_CURRENT_N_SF    ,--CurrentNSF
338
#define  PP_CURRENT_N_SF    ++CurrentNSF;
339

340
#define  MM_CURRENT_N_ST    ,--CurrentNST
341
#define  PP_CURRENT_N_ST    ++CurrentNST;
342

343
#define  MM_CURRENT_N_INT   ,--CurrentNINT
344
#define  PP_CURRENT_N_INT   ;++CurrentNINT
345

346
#else       /* MEMORY off */
347

348
#define  MM_CURRENT_N_LT
349
#define  PP_CURRENT_N_LT
350
#define  MM_CURRENT_N_SF
351
#define  PP_CURRENT_N_SF
352
#define  MM_CURRENT_N_ST
353
#define  PP_CURRENT_N_ST
354
#define  MM_CURRENT_N_INT
355
#define  PP_CURRENT_N_INT
356

357
#define IN_SET_N_LT
358
#define IN_SET_N_INT
359
#define IN_SET_N_ST
360
#define IN_SET_N_SF
361

362
#define OUT_SET_N_LT
363
#define OUT_SET_N_INT
364
#define OUT_SET_N_ST
365
#define OUT_SET_N_SF
366

367
#define M_OUT_GET_LIE_MONOMIAL
368
#define M_OUT_GET_LIE_SUM
369
#define M_OUT_GET_LIE_TERM
370
#define M_IN_LIE_SUM_ADDITION
371
#define M_OUT_LIE_SUM_ADDITION
372
#define IN_LIE_SUM_COPY
373
#define OUT_LIE_SUM_COPY
374
#define IN_LIE_SUM_KILL
375
#define OUT_LIE_SUM_KILL
376
#define M_IN_LIE_SUM_DIV_INTEGER
377
#define M_OUT_LIE_SUM_DIV_INTEGER
378
#define M_IN_LIE_SUM_DIV_SCALAR_SUM
379
#define M_OUT_LIE_SUM_DIV_SCALAR_SUM
380
#define M_IN_LIE_SUM_MULT_SCALAR_SUM
381
#define M_OUT_LIE_SUM_MULT_SCALAR_SUM
382
#define M_IN_LIE_SUM_MULT_INTEGER
383
#define M_OUT_LIE_SUM_MULT_INTEGER
384
#define M_OUT_MAKE_RELATION_RHS
385
#define M_OUT_NEW_JACOBI_RELATION
386
#define M_IN_NORMALIZE_RELATION
387
#define M_OUT_NORMALIZE_RELATION
388
#define M_OUT_PAIR_MONOMIAL_MONOMIAL
389
#define M_IN_PAIR_MONOMIAL_SUM
390
#define M_OUT_PAIR_MONOMIAL_SUM
391
#define M_IN_PAIR_SUM_MONOMIAL
392
#define M_OUT_PAIR_SUM_MONOMIAL
393
#define M_IN_PAIR_SUM_SUM
394
#define M_OUT_PAIR_SUM_SUM
395
#define M_IN_POLY_CONTENT
396
#define M_OUT_POLY_CONTENT
397
#define M_IN_POLY_GCD
398
#define M_OUT_POLY_GCD
399
#define M_IN_POLY_QUOTIENT
400
#define M_OUT_POLY_QUOTIENT
401
#define M_IN_POLY_PSEUDO_REMAINDER
402
#define M_OUT_POLY_PSEUDO_REMAINDER
403
#define IN_REDUCE_RELATIONS
404
#define OUT_REDUCE_RELATIONS
405
#define M_IN_SCALAR_SUM_CANCELLATION
406
#define M_OUT_SCALAR_SUM_CANCELLATION
407
#define M_IN_SUBSTITUTE_RELATION_IN_RELATION
408
#define M_OUT_SUBSTITUTE_RELATION_IN_RELATION
409
#endif
410

411
#define IN_SET_NS IN_SET_N_LT IN_SET_N_INT IN_SET_N_ST IN_SET_N_SF
412
#define OUT_SET_NS OUT_SET_N_LT OUT_SET_N_INT OUT_SET_N_ST OUT_SET_N_SF
413

414

415
#if defined(DEBUG) || defined(MEMORY)             /* `f_name' is unique */
416
#define IN_SET_FUNCTION_NAME(fname) char * f_name = fname;
417
#else
418
#define IN_SET_FUNCTION_NAME(fname)
419
#endif
420

421
#if defined(D_ADD_PAIR_TO_LIE_MONOMIAL) /*------------------------------*/
422
                                        /*   Only debugging makes sense */
423
#define IN_ADD_PAIR_TO_LIE_MONOMIAL \
424
    IN_SET_FUNCTION_NAME("AddPairToLieMonomial")\
425
    D_IN_SET\
426
      PutDebugLieMonomial("i", i),\
427
      PutDebugLieMonomial("j", j),\
428
      PutDebugLieMonomialTable(-1);\
429
    D_IN_CLOSE
430

431
#define OUT_ADD_PAIR_TO_LIE_MONOMIAL_OLD \
432
    D_OUT_OPEN\
433
      PutDebugLieMonomial("Old monomial", ijp);
434
#define OUT_ADD_PAIR_TO_LIE_MONOMIAL_NEW  \
435
    D_OUT_OPEN\
436
      PutDebugLieMonomialTable(ijp);
437
#else
438
#define IN_ADD_PAIR_TO_LIE_MONOMIAL     D_IN_CLOSE
439
#define OUT_ADD_PAIR_TO_LIE_MONOMIAL_OLD
440
#define OUT_ADD_PAIR_TO_LIE_MONOMIAL_NEW
441
#endif
442
#if defined(D_GENERATE_RELATIONS) /*-----------------------------------*/
443
                                       /*   Only debugging makes sense */
444
#define IN_GENERATE_RELATIONS  \
445
    IN_SET_FUNCTION_NAME("GenerateRelations")\
446
    D_IN_SET\
447
      IN_PUT_RELATIONS\
448
      IN_PUT_LIE_MONOMIAL\
449
      PutDebugLieSum("rel", a),\
450
      PutDebugLieMonomial("gen", gen);\
451
    D_IN_CLOSE
452

453
#define OUT_GENERATE_RELATIONS \
454
    D_OUT_OPEN\
455
      PutDebugLieSum("d_rel", a);
456
#else
457
#define  IN_GENERATE_RELATIONS     D_IN_CLOSE
458
#define  OUT_GENERATE_RELATIONS
459
#endif
460
#if defined(D_INTEGER_CANCELLATION) /*----- (k*n)/(k*d) -> n/d --------*/
461
                                    /* Only debugging makes sense      */
462
#define IN_INTEGER_CANCELLATION \
463
    IN_SET_FUNCTION_NAME("IntegerCancellation")\
464
    D_IN_SET\
465
      PutDebugInteger("num", num),\
466
      PutDebugInteger("den", den);\
467
    D_IN_CLOSE
468
#define OUT_INTEGER_CANCELLATION \
469
    D_OUT_OPEN\
470
      PutDebugInteger("num", num),\
471
      PutDebugInteger("den", den);
472
#else
473
#define IN_INTEGER_CANCELLATION    D_IN_CLOSE
474
#define OUT_INTEGER_CANCELLATION
475
#endif
476
#if defined(D_INTEGER_GCD) /*------------------------------------------*/
477
                                    /* Only debugging makes sense      */
478
#define IN_INTEGER_GCD  \
479
    IN_SET_FUNCTION_NAME("IntegerGCD")\
480
    D_IN_SET\
481
      PutDebugInteger("u", u),\
482
      PutDebugInteger("v", v);\
483
    D_IN_CLOSE
484
#define OUT_INTEGER_GCD  \
485
    D_OUT_OPEN\
486
      PutDebugInteger("GCD", u);
487
#else
488
#define IN_INTEGER_GCD       D_IN_CLOSE
489
#define OUT_INTEGER_GCD
490
#endif
491
#if defined(D_INTEGER_PRODUCT)  /*------------- n*m -------------------*/
492
                                    /* Only debugging makes sense      */
493
#define IN_INTEGER_PRODUCT  \
494
    IN_SET_FUNCTION_NAME("IntegerProduct")\
495
    D_IN_SET\
496
      PutDebugInteger("u", u),\
497
      PutDebugInteger("v", v);\
498
    D_IN_CLOSE
499
#define OUT_INTEGER_PRODUCT  \
500
    D_OUT_OPEN\
501
      PutDebugInteger("u*v", w0);
502
#else
503
#define IN_INTEGER_PRODUCT    D_IN_CLOSE
504
#define OUT_INTEGER_PRODUCT
505
#endif
506
#if defined(D_INTEGER_QUOTIENT)  /*------------------------------------*/
507
                                    /* Only debugging makes sense      */
508
#define IN_INTEGER_QUOTIENT  \
509
    IN_SET_FUNCTION_NAME("IntegerQuotient")\
510
    D_IN_SET\
511
      PutDebugInteger("a", a),\
512
      PutDebugInteger("b", b);\
513
    D_IN_CLOSE
514
#define OUT_INTEGER_QUOTIENT  \
515
    D_OUT_OPEN\
516
      PutDebugInteger("a/b", pm);
517
#else
518
#define IN_INTEGER_QUOTIENT    D_IN_CLOSE
519
#define OUT_INTEGER_QUOTIENT
520
#endif
521
#if defined(D_INTEGER_SUM)       /*------------------------------------*/
522
                                    /* Only debugging makes sense      */
523
#define IN_INTEGER_SUM  \
524
    IN_SET_FUNCTION_NAME("IntegerSum")\
525
    D_IN_SET\
526
      PutDebugInteger("a", a),\
527
      PutDebugInteger("b", b);\
528
    D_IN_CLOSE
529
#define OUT_INTEGER_SUM  \
530
    D_OUT_OPEN\
531
      PutDebugInteger("c", c);
532
#else
533
#define IN_INTEGER_SUM    D_IN_CLOSE
534
#define OUT_INTEGER_SUM
535
#endif
536

537
#if defined(D_GET_LIE_MONOMIAL) /*-------------------------------------*/
538
#define D_IN_GET_LIE_MONOMIAL   D_IN_SET\
539
                                  PutDebugString("*pstr", *pstr);\
540
                                D_IN_CLOSE
541
#define D_OUT_GET_LIE_MONOMIAL  D_OUT_OPEN\
542
                                  PutDebugLieSum("a", a);
543
#else
544
#define D_IN_GET_LIE_MONOMIAL   D_IN_CLOSE
545
#define D_OUT_GET_LIE_MONOMIAL
546
#endif
547
#if defined(D_GET_LIE_SUM) /*------------------------------------------*/
548
#define D_IN_GET_LIE_SUM     D_IN_SET\
549
                               PutDebugString("*pstr", *pstr);\
550
                             D_IN_CLOSE
551
#define D_OUT_GET_LIE_SUM    D_OUT_OPEN\
552
                               PutDebugLieSum("lsum", lsum);
553
#else
554
#define D_IN_GET_LIE_SUM     D_IN_CLOSE
555
#define D_OUT_GET_LIE_SUM
556
#endif
557
#if defined(D_GET_LIE_TERM) /*-----------------------------------------*/
558
#define D_IN_GET_LIE_TERM  D_IN_SET\
559
                             PutDebugString("*pstr", *pstr);\
560
                           D_IN_CLOSE
561
#define D_OUT_GET_LIE_TERM D_OUT_OPEN\
562
                             PutDebugLieSum("lterm", lterm);
563
#else
564
#define D_IN_GET_LIE_TERM  D_IN_CLOSE
565
#define D_OUT_GET_LIE_TERM
566
#endif
567
#if defined(D_LIE_SUM_ADDITION) /*---------- a + b (Lie) --------------*/
568
#define D_IN_LIE_SUM_ADDITION  D_IN_SET\
569
                                 PutDebugLieSum("a", a),\
570
                                 PutDebugLieSum("b", b);\
571
                               D_IN_CLOSE
572
#define D_OUT_LIE_SUM_ADDITION D_OUT_OPEN\
573
                                 PutDebugLieSum("sum", sum);
574
#else
575
#define D_IN_LIE_SUM_ADDITION  D_IN_CLOSE
576
#define D_OUT_LIE_SUM_ADDITION
577
#endif
578
#if defined(D_LIE_SUM_DIV_INTEGER)  /*--------- uint/BIGINT ----------------*/
579
#define D_IN_LIE_SUM_DIV_INTEGER   D_IN_SET\
580
                                     PutDebugLieSum("lsum", b),\
581
                                     PutDebugInteger("den", den);\
582
                                   D_IN_CLOSE
583
#define D_OUT_LIE_SUM_DIV_INTEGER  D_OUT_OPEN\
584
                                     PutDebugLieSum("lsum", b);
585
#else
586
#define D_IN_LIE_SUM_DIV_INTEGER   D_IN_CLOSE
587
#define D_OUT_LIE_SUM_DIV_INTEGER
588
#endif
589
#if defined(D_LIE_SUM_DIV_SCALAR_SUM)  /*--------- uint/uint --------------*/
590
#define D_IN_LIE_SUM_DIV_SCALAR_SUM   D_IN_SET\
591
                                        PutDebugLieSum("lsum", b),\
592
                                        PutDebugScalarSum("den", den);\
593
                                      D_IN_CLOSE
594
#define D_OUT_LIE_SUM_DIV_SCALAR_SUM  D_OUT_OPEN\
595
                                        PutDebugLieSum("lsum", b);
596
#else
597
#define D_IN_LIE_SUM_DIV_SCALAR_SUM   D_IN_CLOSE
598
#define D_OUT_LIE_SUM_DIV_SCALAR_SUM
599
#endif
600
#if defined(D_LIE_SUM_MULT_SCALAR_SUM)  /*--------- uint*uint --------------*/
601
#define D_IN_LIE_SUM_MULT_SCALAR_SUM   D_IN_SET\
602
                                         PutDebugLieSum("lsum", b),\
603
                                         PutDebugScalarSum("num", num);\
604
                                       D_IN_CLOSE
605
#define D_OUT_LIE_SUM_MULT_SCALAR_SUM  D_OUT_OPEN\
606
                                         PutDebugLieSum("lsum", b);
607
#else
608
#define D_IN_LIE_SUM_MULT_SCALAR_SUM   D_IN_CLOSE
609
#define D_OUT_LIE_SUM_MULT_SCALAR_SUM
610
#endif
611
#if defined(D_LIE_SUM_MULT_INTEGER)  /*------- uint*BIGINT -----------------*/
612
#define D_IN_LIE_SUM_MULT_INTEGER   D_IN_SET\
613
                                      PutDebugLieSum("lsum", b),\
614
                                      PutDebugInteger("num", num);\
615
                                    D_IN_CLOSE
616
#define D_OUT_LIE_SUM_MULT_INTEGER  D_OUT_OPEN\
617
                                      PutDebugLieSum("lsum", b);
618
#else
619
#define D_IN_LIE_SUM_MULT_INTEGER   D_IN_CLOSE
620
#define D_OUT_LIE_SUM_MULT_INTEGER
621
#endif
622
#if defined(D_MAKE_RELATION_RHS)   /*----------------------------------*/
623
#define D_IN_MAKE_RELATION_RHS     D_IN_SET\
624
                                     PutDebugLieSum("rel",\
625
                                         RELATION_LIE_SUM(i));\
626
                                   D_IN_CLOSE
627
#define D_OUT_MAKE_RELATION_RHS    D_OUT_OPEN\
628
                                     PutDebugLieSum("r.h.s", a);
629
#else
630
#define D_IN_MAKE_RELATION_RHS     D_IN_CLOSE
631
#define D_OUT_MAKE_RELATION_RHS
632
#endif
633
#if defined(D_NEW_JACOBI_RELATION) /*----------------------------------*/
634
#define D_IN_NEW_JACOBI_RELATION   D_IN_SET\
635
                                     PutDebugLieMonomial("l", l);\
636
                                   D_IN_CLOSE
637
#define D_OUT_NEW_JACOBI_RELATION  D_OUT_OPEN\
638
                                     PutDebugLieSum("a", a);
639
#else
640
#define D_IN_NEW_JACOBI_RELATION   D_IN_CLOSE
641
#define D_OUT_NEW_JACOBI_RELATION
642
#endif
643
#if defined(D_NORMALIZE_RELATION) /*-----------------------------------*/
644
#define D_IN_NORMALIZE_RELATION    D_IN_SET\
645
                                     PutDebugLieSum("a", a);\
646
                                   D_IN_CLOSE
647
#define D_OUT_NORMALIZE_RELATION   D_OUT_OPEN\
648
                                     PutDebugLieSum("a", a);
649
#else
650
#define D_IN_NORMALIZE_RELATION    D_IN_CLOSE
651
#define D_OUT_NORMALIZE_RELATION
652
#endif
653
#if defined(D_PAIR_MONOMIAL_MONOMIAL) /*---------[mona, monb]----------*/
654
#define D_IN_PAIR_MONOMIAL_MONOMIAL    D_IN_SET\
655
                                         PutDebugLieMonomial("i", i),\
656
                                         PutDebugLieMonomial("j", j);\
657
                                       D_IN_CLOSE
658
#define D_OUT_PAIR_MONOMIAL_MONOMIAL   D_OUT_OPEN\
659
                                         PutDebugLieSum("a", a);
660
#else
661
#define D_IN_PAIR_MONOMIAL_MONOMIAL    D_IN_CLOSE
662
#define D_OUT_PAIR_MONOMIAL_MONOMIAL
663
#endif
664
#if defined(D_PAIR_MONOMIAL_SUM) /*-----------[mon, a]-----------------*/
665
#define D_IN_PAIR_MONOMIAL_SUM  D_IN_SET\
666
                                  PutDebugLieMonomial("mon", mon),\
667
                                  PutDebugLieSum("a", a);\
668
                                D_IN_CLOSE
669
#define D_OUT_PAIR_MONOMIAL_SUM D_OUT_OPEN\
670
                                  PutDebugLieSum("s", s);
671
#else
672
#define D_IN_PAIR_MONOMIAL_SUM  D_IN_CLOSE
673
#define D_OUT_PAIR_MONOMIAL_SUM
674
#endif
675
#if defined(D_PAIR_SUM_MONOMIAL) /*-----------[a, mon]-----------------*/
676
#define D_IN_PAIR_SUM_MONOMIAL  D_IN_SET\
677
                                  PutDebugLieSum("a", a),\
678
                                  PutDebugLieMonomial("mon", mon);\
679
                                D_IN_CLOSE
680
#define D_OUT_PAIR_SUM_MONOMIAL D_OUT_OPEN\
681
                                  PutDebugLieSum("s", s);
682
#else
683
#define D_IN_PAIR_SUM_MONOMIAL  D_IN_CLOSE
684
#define D_OUT_PAIR_SUM_MONOMIAL
685
#endif
686
#if defined(D_PAIR_SUM_SUM)    /*----------------[a, b]---------------*/
687
#define D_IN_PAIR_SUM_SUM  D_IN_SET\
688
                             PutDebugLieSum("a", a),\
689
                             PutDebugLieSum("b", b);\
690
                           D_IN_CLOSE
691
#define D_OUT_PAIR_SUM_SUM D_OUT_OPEN\
692
                             PutDebugLieSum("a", a);
693
#else
694
#define D_IN_PAIR_SUM_SUM    D_IN_CLOSE
695
#define D_OUT_PAIR_SUM_SUM
696
#endif
697
#if defined(D_POLY_CONTENT) /*--------------------------------------------*/
698
#define D_IN_POLY_CONTENT  D_IN_SET\
699
                             PutDebugScalarSum("a", a),\
700
                             PutDebugString("mp", \
701
                                ParameterName + mp*NameLength1);\
702
                           D_IN_CLOSE
703
#define D_OUT_POLY_CONTENT D_OUT_OPEN\
704
                             PutDebugScalarSum("b", b);
705
#else
706
#define D_IN_POLY_CONTENT  D_IN_CLOSE
707
#define D_OUT_POLY_CONTENT
708
#endif
709
#if defined(D_POLY_GCD) /*--------------------------------------------*/
710
#define D_IN_POLY_GCD  D_IN_SET\
711
                         PutDebugScalarSum("a", a),\
712
                         PutDebugScalarSum("b", b);\
713
                       D_IN_CLOSE
714
#define D_OUT_POLY_GCD D_OUT_OPEN\
715
                         PutDebugScalarSum("b", b);
716
#else
717
#define D_IN_POLY_GCD    D_IN_CLOSE
718
#define D_OUT_POLY_GCD
719
#endif
720
#if defined(D_POLY_QUOTIENT) /*--------------------------------------------*/
721
#define D_IN_POLY_QUOTIENT  D_IN_SET\
722
                              PutDebugScalarSum("a", a),\
723
                              PutDebugScalarSum("b", b);\
724
                            D_IN_CLOSE
725
#define D_OUT_POLY_QUOTIENT D_OUT_OPEN\
726
                              PutDebugScalarSum("c", c);
727
#else
728
#define D_IN_POLY_QUOTIENT    D_IN_CLOSE
729
#define D_OUT_POLY_QUOTIENT
730
#endif
731
#if defined(D_POLY_PSEUDO_REMAINDER) /*------------------------------------*/
732
#define D_IN_POLY_PSEUDO_REMAINDER  D_IN_SET\
733
                                      PutDebugScalarSum("a", a),\
734
                                      PutDebugScalarSum("b", b);\
735
                                    D_IN_CLOSE
736
#define D_OUT_POLY_PSEUDO_REMAINDER D_OUT_OPEN\
737
                                      PutDebugScalarSum("a", a);
738
#else
739
#define D_IN_POLY_PSEUDO_REMAINDER  D_IN_CLOSE
740
#define D_OUT_POLY_PSEUDO_REMAINDER
741
#endif
742
#if defined(D_SCALAR_SUM_CANCELLATION) /*----- (k*n)/(k*d) -> n/d ----*/
743
#define D_IN_SCALAR_SUM_CANCELLATION  D_IN_SET\
744
                                        PutDebugScalarSum("*pnum", *pnum),\
745
                                        PutDebugScalarSum("*pden", *pden);\
746
                                      D_IN_CLOSE
747
#define D_OUT_SCALAR_SUM_CANCELLATION D_OUT_OPEN\
748
                                        PutDebugScalarSum("*pnum", *pnum),\
749
                                        PutDebugScalarSum("*pden", *pden);
750
#else
751
#define D_IN_SCALAR_SUM_CANCELLATION    D_IN_CLOSE
752
#define D_OUT_SCALAR_SUM_CANCELLATION
753
#endif
754
#if defined(D_SUBSTITUTE_RELATION_IN_RELATION)  /*--------------------*/
755
#define D_IN_SUBSTITUTE_RELATION_IN_RELATION  D_IN_SET\
756
                                                PutDebugLieSum("r", r),\
757
                                                PutDebugLieSum("a", a);\
758
                                              D_IN_CLOSE
759
#define D_OUT_SUBSTITUTE_RELATION_IN_RELATION  D_OUT_OPEN\
760
                                                 PutDebugLieSum("a", a);
761
#else
762
#define D_IN_SUBSTITUTE_RELATION_IN_RELATION  D_IN_CLOSE
763
#define D_OUT_SUBSTITUTE_RELATION_IN_RELATION
764
#endif
765

766
/* Set INs and OUTs for particular functions */
767

768
/*--------------------------------------------------------------------*/
769
#define IN_GET_LIE_MONOMIAL \
770
    IN_SET_FUNCTION_NAME("GetLieMonomial")\
771
    IN_SET_NS\
772
    D_IN_GET_LIE_MONOMIAL
773
#define OUT_GET_LIE_MONOMIAL \
774
    D_OUT_GET_LIE_MONOMIAL\
775
    M_OUT_GET_LIE_MONOMIAL
776
/*--------------------------------------------------------------------*/
777
#define IN_GET_LIE_SUM \
778
    IN_SET_FUNCTION_NAME("GetLieSum")\
779
    IN_SET_NS\
780
    D_IN_GET_LIE_SUM
781
#define OUT_GET_LIE_SUM \
782
    D_OUT_GET_LIE_SUM\
783
    M_OUT_GET_LIE_SUM
784
/*--------------------------------------------------------------------*/
785
#define IN_GET_LIE_TERM \
786
    IN_SET_FUNCTION_NAME("GetLieTerm")\
787
    IN_SET_NS\
788
    D_IN_GET_LIE_TERM
789
#define OUT_GET_LIE_TERM \
790
    D_OUT_GET_LIE_TERM\
791
    M_OUT_GET_LIE_TERM
792
/*--------------------------------------------------------------------*/
793
#define IN_LIE_SUM_ADDITION  \
794
    IN_SET_FUNCTION_NAME("LieSumAddition")\
795
    IN_SET_NS\
796
    D_IN_LIE_SUM_ADDITION\
797
    M_IN_LIE_SUM_ADDITION
798
#define OUT_LIE_SUM_ADDITION  \
799
    D_OUT_LIE_SUM_ADDITION\
800
    M_OUT_LIE_SUM_ADDITION
801
/*--------------------------------------------------------------------*/
802
#define IN_LIE_SUM_DIV_INTEGER  \
803
    LS_B_LSUM_DIV_INT\
804
    IN_SET_FUNCTION_NAME("LieSumDivInteger")\
805
    IN_SET_NS\
806
    D_IN_LIE_SUM_DIV_INTEGER\
807
    M_IN_LIE_SUM_DIV_INTEGER
808
#define OUT_LIE_SUM_DIV_INTEGER  \
809
    D_OUT_LIE_SUM_DIV_INTEGER\
810
    M_OUT_LIE_SUM_DIV_INTEGER
811
/*--------------------------------------------------------------------*/
812
#define IN_LIE_SUM_DIV_SCALAR_SUM  \
813
    LS_B_LSUM_DIV_SS\
814
    IN_SET_FUNCTION_NAME("LieSumDivScalarSum")\
815
    IN_SET_NS\
816
    D_IN_LIE_SUM_DIV_SCALAR_SUM\
817
    M_IN_LIE_SUM_DIV_SCALAR_SUM
818
#define OUT_LIE_SUM_DIV_SCALAR_SUM  \
819
    D_OUT_LIE_SUM_DIV_SCALAR_SUM\
820
    M_OUT_LIE_SUM_DIV_SCALAR_SUM
821
/*--------------------------------------------------------------------*/
822
#define IN_LIE_SUM_MULT_SCALAR_SUM  \
823
    LS_B_LSUM_MULT_SS\
824
    IN_SET_FUNCTION_NAME("LieSumMultScalarSum")\
825
    IN_SET_NS\
826
    D_IN_LIE_SUM_MULT_SCALAR_SUM\
827
    M_IN_LIE_SUM_MULT_SCALAR_SUM
828
#define OUT_LIE_SUM_MULT_SCALAR_SUM  \
829
    D_OUT_LIE_SUM_MULT_SCALAR_SUM\
830
    M_OUT_LIE_SUM_MULT_SCALAR_SUM
831
/*--------------------------------------------------------------------*/
832
#define IN_LIE_SUM_MULT_INTEGER  \
833
    LS_B_LSUM_MULT_INT\
834
    IN_SET_FUNCTION_NAME("LieSumMultInteger")\
835
    IN_SET_NS\
836
    D_IN_LIE_SUM_MULT_INTEGER\
837
    M_IN_LIE_SUM_MULT_INTEGER
838
#define OUT_LIE_SUM_MULT_INTEGER  \
839
    D_OUT_LIE_SUM_MULT_INTEGER\
840
    M_OUT_LIE_SUM_MULT_INTEGER
841
/*--------------------------------------------------------------------*/
842
#define IN_MAKE_RELATION_RHS \
843
    IN_SET_FUNCTION_NAME("MakeRelationRHS...")\
844
    IN_SET_NS\
845
    D_IN_MAKE_RELATION_RHS
846
#define OUT_MAKE_RELATION_RHS \
847
    D_OUT_MAKE_RELATION_RHS\
848
    M_OUT_MAKE_RELATION_RHS
849
/*--------------------------------------------------------------------*/
850
#define IN_NEW_JACOBI_RELATION  \
851
    IN_SET_FUNCTION_NAME("NewJacobiRelation")\
852
    IN_SET_NS\
853
    D_IN_NEW_JACOBI_RELATION
854
#define OUT_NEW_JACOBI_RELATION  \
855
    D_OUT_NEW_JACOBI_RELATION\
856
    M_OUT_NEW_JACOBI_RELATION
857
/*--------------------------------------------------------------------*/
858
#define IN_NORMALIZE_RELATION  \
859
    IN_SET_FUNCTION_NAME("NormalizeRelation...")\
860
    IN_SET_NS\
861
    D_IN_NORMALIZE_RELATION\
862
    M_IN_NORMALIZE_RELATION
863
#define OUT_NORMALIZE_RELATION  \
864
    D_OUT_NORMALIZE_RELATION\
865
    M_OUT_NORMALIZE_RELATION
866
/*--------------------------------------------------------------------*/
867
#define IN_PAIR_MONOMIAL_MONOMIAL  \
868
    IN_SET_FUNCTION_NAME("PairMonomialMonomial...")\
869
    IN_SET_NS\
870
    D_IN_PAIR_MONOMIAL_MONOMIAL
871
#define OUT_PAIR_MONOMIAL_MONOMIAL  \
872
    D_OUT_PAIR_MONOMIAL_MONOMIAL\
873
    M_OUT_PAIR_MONOMIAL_MONOMIAL
874
/*--------------------------------------------------------------------*/
875
#define IN_PAIR_MONOMIAL_SUM  \
876
    IN_SET_FUNCTION_NAME("PairMonomialSum...")\
877
    IN_SET_NS\
878
    D_IN_PAIR_MONOMIAL_SUM\
879
    M_IN_PAIR_MONOMIAL_SUM
880
#define OUT_PAIR_MONOMIAL_SUM  \
881
    D_OUT_PAIR_MONOMIAL_SUM\
882
    M_OUT_PAIR_MONOMIAL_SUM
883
/*--------------------------------------------------------------------*/
884
#define IN_PAIR_SUM_MONOMIAL  \
885
    IN_SET_FUNCTION_NAME("PairSumMonomial...")\
886
    IN_SET_NS\
887
    D_IN_PAIR_SUM_MONOMIAL\
888
    M_IN_PAIR_SUM_MONOMIAL
889
#define OUT_PAIR_SUM_MONOMIAL  \
890
    D_OUT_PAIR_SUM_MONOMIAL\
891
    M_OUT_PAIR_SUM_MONOMIAL
892
/*--------------------------------------------------------------------*/
893
#define IN_PAIR_SUM_SUM  \
894
    IN_SET_FUNCTION_NAME("PairSumSum...")\
895
    IN_SET_NS\
896
    D_IN_PAIR_SUM_SUM\
897
    M_IN_PAIR_SUM_SUM
898
#define OUT_PAIR_SUM_SUM  \
899
    D_OUT_PAIR_SUM_SUM\
900
    M_OUT_PAIR_SUM_SUM
901
/*--------------------------------------------------------------------*/
902
#define IN_POLY_CONTENT  \
903
    IN_SET_FUNCTION_NAME("PolyContent")\
904
    IN_SET_NS\
905
    D_IN_POLY_CONTENT\
906
    M_IN_POLY_CONTENT
907
#define OUT_POLY_CONTENT  \
908
    D_OUT_POLY_CONTENT\
909
    M_OUT_POLY_CONTENT
910
/*--------------------------------------------------------------------*/
911
#define IN_POLY_GCD  \
912
    IN_SET_FUNCTION_NAME("PolyGCD")\
913
    IN_SET_NS\
914
    D_IN_POLY_GCD\
915
    M_IN_POLY_GCD
916
#define OUT_POLY_GCD  \
917
    D_OUT_POLY_GCD\
918
    M_OUT_POLY_GCD
919
/*--------------------------------------------------------------------*/
920
#define IN_POLY_QUOTIENT  \
921
    IN_SET_FUNCTION_NAME("PolyQuotient")\
922
    IN_SET_NS\
923
    D_IN_POLY_QUOTIENT\
924
    M_IN_POLY_QUOTIENT
925
#define OUT_POLY_QUOTIENT  \
926
    D_OUT_POLY_QUOTIENT\
927
    M_OUT_POLY_QUOTIENT
928
/*--------------------------------------------------------------------*/
929
#define IN_POLY_PSEUDO_REMAINDER  \
930
    IN_SET_FUNCTION_NAME("PolyPseudoRemainder")\
931
    IN_SET_NS\
932
    D_IN_POLY_PSEUDO_REMAINDER\
933
    M_IN_POLY_PSEUDO_REMAINDER
934
#define OUT_POLY_PSEUDO_REMAINDER  \
935
    D_OUT_POLY_PSEUDO_REMAINDER\
936
    M_OUT_POLY_PSEUDO_REMAINDER
937
/*--------------------------------------------------------------------*/
938
#define IN_SCALAR_SUM_CANCELLATION  \
939
    IN_SET_FUNCTION_NAME("ScalarSumCancellation")\
940
    IN_SET_NS\
941
    D_IN_SCALAR_SUM_CANCELLATION\
942
    M_IN_SCALAR_SUM_CANCELLATION
943
#define OUT_SCALAR_SUM_CANCELLATION  \
944
    D_OUT_SCALAR_SUM_CANCELLATION\
945
    M_OUT_SCALAR_SUM_CANCELLATION
946
/*--------------------------------------------------------------------*/
947
#define IN_SUBSTITUTE_RELATION_IN_RELATION  \
948
    IN_SET_FUNCTION_NAME("SubstituteRelationInRelation...")\
949
    IN_SET_NS\
950
    D_IN_SUBSTITUTE_RELATION_IN_RELATION\
951
    M_IN_SUBSTITUTE_RELATION_IN_RELATION
952
#define OUT_SUBSTITUTE_RELATION_IN_RELATION  \
953
    D_OUT_SUBSTITUTE_RELATION_IN_RELATION\
954
    M_OUT_SUBSTITUTE_RELATION_IN_RELATION
955
/* Conditional print of Relation and Monomial tables */
956

957
#if defined(D_PUT_RELATIONS)   /*-------------------------------------*/
958
#define IN_PUT_RELATIONS       PutDebugRelations(),
959
#define OUT_PUT_RELATIONS      D_CONDITION PutDebugRelations();
960
#else
961
#define IN_PUT_RELATIONS
962
#define OUT_PUT_RELATIONS
963
#endif
964

965
#if defined(D_PUT_LIE_MONOMIAL)   /*-------------------------------------*/
966
#define IN_PUT_LIE_MONOMIAL       PutDebugLieMonomialTable(-1),
967
#define OUT_PUT_LIE_MONOMIAL      D_CONDITION PutDebugLieMonomialTable(-1);
968
#else
969
#define IN_PUT_LIE_MONOMIAL
970
#define OUT_PUT_LIE_MONOMIAL
971
#endif
972

973
#if defined(D_LIE_SUM_DIV_INTEGER) || defined(MEMORY)
974
#define LS_B_LSUM_DIV_INT  uint b = lsum; /* For "LieSumDivInteger" */
975
#else
976
#define LS_B_LSUM_DIV_INT
977
#endif
978
#if defined(D_LIE_SUM_MULT_INTEGER) || defined(MEMORY)
979
#define LS_B_LSUM_MULT_INT  uint b = lsum; /* For "LieSumMultInteger" */
980
#else
981
#define LS_B_LSUM_MULT_INT
982
#endif
983
#if defined(D_LIE_SUM_DIV_SCALAR_SUM) || defined(MEMORY)
984
#define LS_B_LSUM_DIV_SS  uint b = lsum; /* For "LieSumDivScalarSum" */
985
#else
986
#define LS_B_LSUM_DIV_SS
987
#endif
988
#if defined(D_LIE_SUM_MULT_SCALAR_SUM) || defined(MEMORY)
989
#define LS_B_LSUM_MULT_SS  uint b = lsum; /* For "LieSumMultScalarSum" */
990
#else
991
#define LS_B_LSUM_MULT_SS
992
#endif
993

994
/* Test of char functions ?? */
995
//#define TEST_FUNCTION
996

997
#if defined(INTEGER_ALLOCATION_CHECK)
998
#define INTEGER_IN_STACK(n) ;if((n)==NULL) Error(E_A_STACK_INTEGER)
999
#define INTEGER_IN_HEAP(n)  ;if((n)==NULL) Error(E_A_HEAP_INTEGER) \
1000
                            PP_CURRENT_N_INT
1001
#else
1002
#define INTEGER_IN_STACK(n)
1003
#define INTEGER_IN_HEAP(n)  PP_CURRENT_N_INT
1004
#endif
1005

1006
#if defined(POLY_ARRAY_ALLOCATION_CHECK)
1007
#define POLY_ARRAY_IN_STACK(a) ;if((a)==NULL) Error(E_A_STACK_POLY_ARRAY)
1008
#else
1009
#define POLY_ARRAY_IN_STACK(a)
1010
#endif
1011

1012
/*_1    System constants=================================================*/
1013

1014
#define NIL                                           (0u)
1015
#define NOTHING                                     (~NIL)
1016

1017
#define INTEGER_SIGN_MASK                   ((LIMB)0x8000)
1018
                      /* 1 << 15 or 0000 0000 0000 0001 */
1019
#define INTEGER_N_LIMBS_MASK  ((LIMB)(~INTEGER_SIGN_MASK))
1020
                                 /* 1111 1111 1111 1110 */
1021
#define BITS_PER_LIMB                                 (16)
1022
#define BASE_LIMB                              (0x10000lu)
1023
#define MAX_LIMB                                 (0xFFFFu)
1024
#define FIRST_GENUINE_PARAMETER  1 /* Skip i number */
1025

1026
/*_2    Type definitions================================================*/
1027

1028
typedef unsigned char byte;
1029
typedef unsigned short LIMB; /* Limb of big integer */
1030
typedef LIMB * BIGINT;  /* (Pointer to) big integer array */
1031
typedef unsigned int uint;
1032

1033
/* Element of LieMonomial table */
1034

1035
typedef struct
1036
{
1037
  int order;       /* Order of this position element */
1038
  int position;    /* Position of this order */
1039
  int left;        /* (Position of) left submonomial of Lie bracket */
1040
                   /* or ~(index of generator) if not commutator */
1041
  int right;       /* (Position of) right submonomial of Lie bracket  */
1042
                   /* or 1 for 1st generator and 0 for nexts */
1043
  struct
1044
  {
1045
    uint parity : 1;
1046
    int index : 23;  /* Index if basis element or */
1047
                   /* ~(index of relation with leading ordinal) */
1048
                   /* Number of relations < 4194303 */
1049
    uint weight : 8;  /* Weight of Lie monomial < 256 */
1050
  } info;
1051
} LIE_MON;
1052

1053
/* Element of NodeLT pool for Lie terms */
1054

1055
typedef struct
1056
{
1057
  int monomial;   /* (Position of) Lie monomial in LieMonomial table */
1058
  union
1059
  {
1060
    uint  scalar_sum;
1061
    BIGINT integer;
1062
  } numerator;
1063
  union
1064
  {
1065
    uint  scalar_sum;
1066
    BIGINT integer;
1067
  } denominator;  /* Pointer to next Lie term */
1068
  uint rptr;
1069
} NODE_LT;
1070

1071
/* Element of NodeSF pool for scalar factors */
1072

1073
typedef struct
1074
{
1075
#if defined(SPP_2000)
1076
  byte parameter; /* Parameter ordinal   */
1077
  byte degree;    /* Degree of parameter */
1078
#else
1079
  byte degree;    /* Degree of parameter */
1080
  byte parameter; /* Parameter ordinal   */
1081
#endif
1082
  uint   rptr;      /* Pointer to next parametric factor */
1083
} NODE_SF;
1084

1085
/* Element of NodeST pool for scalar terms */
1086

1087
typedef struct
1088
{
1089
  uint  monomial;  /* Scalar monomial */
1090
  BIGINT numerator; /* Integer coefficient */
1091
  uint  rptr;      /* Pointer to next parametric term */
1092
} NODE_ST;
1093

1094
/* Element of Relation table */
1095

1096
typedef struct
1097
{
1098
  uint    lie_sum;           /* Expression of relation (Lie sum) */
1099
  byte  min_generator;     /* Minimal generator for differentiation */
1100
  byte to_be_substituted; /* YES if relation must be substituted */
1101
} REL;                     /* into higher relations */
1102

1103
/*_3    Constants and enumerations======================================*/
1104

1105
/* Enumeration constants */
1106

1107
enum boolean {NO = 0, YES = 1};
1108
enum signs {PLUS = 0, MINUS = 1};
1109
enum parity {EVEN = 0, ODD = 1};
1110
enum orders {ORDER12 = -1, ORDER11 = 0, ORDER21 = 1};
1111
enum scalar_types   /* Types of scalar factors */
1112
{
1113
  I_NUMBER  =  0
1114
};
1115
enum init_file_cases   /* Initiating file fplsa4.ini (fplsa416.ini) */
1116
{
1117
  COEFFICIENT_SUM_TABLE_SIZE =  0,
1118
  CRUDE_TIME                 =  1,
1119
  ECHO_INPUT_FILE            =  2,
1120
  EVEN_BASIS_SYMBOL          =  3,
1121
  GAP_ALGEBRA_NAME           =  4,
1122
  GAP_BASIS_NAME             =  5,
1123
  GAP_RELATIONS_NAME         =  6,
1124
  GAP_OUTPUT_BASIS           =  7,
1125
  GAP_OUTPUT_COMMUTATORS     =  8,
1126
  GAP_OUTPUT_RELATIONS       =  9,
1127
  GENERATOR_MAX_N            = 10,
1128
  INPUT_DIRECTORY            = 11,
1129
  INPUT_INTEGER_SIZE         = 12,
1130
  INPUT_STRING_SIZE          = 13,
1131
  LEFT_NORMED_OUTPUT         = 14,
1132
  LIE_MONOMIAL_SIZE          = 15,
1133
  LINE_LENGTH                = 16,
1134
  NAME_LENGTH                = 17,
1135
  NODE_LT_SIZE               = 18,
1136
  NODE_SF_SIZE               = 19,
1137
  NODE_ST_SIZE               = 20,
1138
  ODD_BASIS_SYMBOL           = 21,
1139
  OUT_LINE_SIZE              = 22,
1140
  PARAMETER_MAX_N            = 23,
1141
  PUT_BASIS_ELEMENTS         = 24,
1142
  PUT_COMMUTATORS            = 25,
1143
  PUT_HILBERT_SERIES         = 26,
1144
  PUT_INITIAL_RELATIONS      = 27,
1145
  PUT_NON_ZERO_COEFFICIENTS  = 28,
1146
  PUT_PROGRAM_HEADING        = 29,
1147
  PUT_REDUCED_RELATIONS      = 30,
1148
  PUT_STATISTICS             = 31,
1149
  RELATION_SIZE              = 32,
1150
  N_INIT_CASES               = 33
1151
};
1152
enum input_file_cases   /* Items of input files */
1153
{
1154
  GENERATORS      = 0,
1155
  LIMITING_WEIGHT = 1,
1156
  PARAMETERS      = 2,
1157
  RELATIONS       = 3,
1158
  WEIGHTS         = 4,
1159
  N_INPUT_CASES   = 5
1160
};
1161
enum messages
1162
{
1163
  /* Head messages */
1164

1165
  H_PROGRAM               =  0,
1166
  H_ENTER_FILE            =  1,
1167
  H_INPUT_FILE            =  2,
1168
  H_CREATE_NEW_FILE       =  3,
1169
  H_ENTER_GENERATORS      =  4,
1170
  H_ENTER_WEIGHTS_IN_FILE =  5,
1171
  H_ENTER_LIMITING_WEIGHT =  6,
1172
  H_ENTER_PARAMETERS      =  7,
1173
  H_ENTER_RELATIONS       =  8,
1174
  H_SHOW_INPUT            =  9,
1175
  H_IN_RELATIONS          = 10,
1176
  H_NON_ZERO_COEFFICIENTS = 11,
1177
  H_REDUCED_RELATIONS     = 12,
1178
  H_BASIS_ELEMENTS        = 13,
1179
  H_HILBERT_SERIES        = 14,
1180
  H_COMMUTATORS           = 15,
1181
  H_NO_PUT_COMMUTATORS    = 16,
1182

1183
  /* Error messages */
1184

1185
  ERROR                            = 17,
1186
  E_WRONG_INI_CASE                 = 18,
1187
  E_WRONG_INPUT_CASE               = 19,
1188
  E_CANCEL_PROGRAM                 = 20,
1189
  E_UNEXPECTED_EOF                 = 21,
1190
  E_A_GENERATOR_NAME               = 22,
1191
  E_A_PARAMETER_NAME               = 23,
1192
  E_A_OUT_LINE                     = 24,
1193
  E_A_RELATION                     = 25,
1194
  E_A_LIE_MONOMIAL                 = 26,
1195
  E_A_NODE_LT                      = 27,
1196
  E_A_NODE_ST                      = 28,
1197
  E_A_NODE_SF                      = 29,
1198
  E_A_HEAP_INTEGER                 = 30,
1199
  E_A_COEFF_PARA_TABLE             = 31,
1200
  E_A_COEFF_SUM_TABLE              = 32,
1201
  E_ALLOC                          = 33,
1202
  E_A_STACK_INPUT_STRING           = 34,
1203
  E_A_STACK_INTEGER                = 35,
1204
  E_A_STACK_INTEGER_DECIMAL_STRING = 36,
1205
  E_A_STACK_POLY_ARRAY             = 37,
1206
  E_INPUT_STRING_SIZE              = 38,
1207
  E_OUT_LINE_SIZE                  = 39,
1208
  E_LIE_MONOMIAL_SIZE              = 40,
1209
  E_RELATION_SIZE                  = 41,
1210
  E_NODE_LT_SIZE                   = 42,
1211
  E_NODE_SF_SIZE                   = 43,
1212
  E_NODE_ST_SIZE                   = 44,
1213
  E_COEFF_SUM_TABLE_SIZE           = 45,
1214
  E_GENERATOR_MAX_N                = 46,
1215
  E_PARAMETER_MAX_N                = 47,
1216
  E_TOO_MUCH_INPUT_WEIGHTS         = 48,
1217
  E_NON_NUM_INPUT_WEIGHT           = 49,
1218
  E_NO_R_PARENTHESIS               = 50,
1219
  E_NO_GENERAL_POWER               = 51,
1220
  E_UNDECLARED_GENERATOR           = 52,
1221
  E_NO_COMMUTATOR_COMMA            = 53,
1222
  E_NO_COMMUTATOR_BRACKET          = 54,
1223
  E_INVALID_CHARACTER              = 55,
1224
  E_MESSAGE                        = 56
1225
};
1226

1227
/* Constants for input and output */
1228

1229
#define LEFT_COMMENT              '<'  /* In *.ini and input files */
1230
#define RIGHT_COMMENT             '>'
1231
#define SUBSCRIPT_INPUT_SIGN	  '_'
1232
#define ODD_GENERATOR_INPUT_SIGN  '-'  /* At input */
1233

1234
#define LEVEL                   '\xFF'
1235
#define MAIN_LEVEL              '\x2'
1236
#define MARGIN                  (LEVEL-1)
1237

1238
#define CASE_STRING_SIZE      256    /* Size of string to match case */
1239
#define GAP_NAME_SIZE          64    /* Including ending '\0' */
1240
#define GAP_WIDTH              79    /* Width of GAP page */
1241

1242
/*_4    Macrodefinitions==================================================*/
1243
#define COUNT_LEADING_ZERO_BITS_IN_LIMB(n,w) n=CountLeadingZeroBitsInLimb((LIMB)(w))
1244
#if 0 /* ?? Exclude the macro: the above function is slightly faster */
1245
#define COUNT_LEADING_ZERO_BITS_IN_LIMB(n, w)  (n) = (w);\
1246
                                          if((n) >= 0x100) \
1247
                                            if((n) >= 0x1000) \
1248
                                              if((n) >= 0x4000) \
1249
                                                if((n) >= 0x8000) \
1250
                                                  (n) = 0; \
1251
                                                else \
1252
                                                  (n) = 1; \
1253
                                              else \
1254
                                                if((n) >= 0x2000) \
1255
                                                  (n) = 2; \
1256
                                                else \
1257
                                                  (n) = 3; \
1258
                                            else \
1259
                                              if((n) >= 0x400) \
1260
                                                if((n) >= 0x800) \
1261
                                                  (n) = 4; \
1262
                                                else \
1263
                                                  (n) = 5; \
1264
                                              else \
1265
                                                if((n) >= 0x200) \
1266
                                                  (n) = 6; \
1267
                                                else \
1268
                                                  (n) = 7; \
1269
                                          else \
1270
                                            if((n) >= 0x10) \
1271
                                              if((n) >= 0x40) \
1272
                                                if((n) >= 0x80) \
1273
                                                  (n) = 8; \
1274
                                                else \
1275
                                                  (n) = 9; \
1276
                                              else \
1277
                                                if((n) >= 0x20) \
1278
                                                  (n) = 10; \
1279
                                                else \
1280
                                                  (n) = 11; \
1281
                                            else \
1282
                                              if((n) >= 0x4) \
1283
                                                if((n) >= 0x8) \
1284
                                                  (n) = 12; \
1285
                                                else \
1286
                                                  (n) = 13; \
1287
                                              else \
1288
                                                if((n) >= 0x2) \
1289
                                                  (n) = 14; \
1290
                                                else \
1291
                                                  if((n)) \
1292
                                                    (n) = 15; \
1293
                                                  else \
1294
                                                    (n) = 16
1295
#endif
1296

1297
#define CUT_ARRAY(arr, type, n) (arr)=(type *)realloc(arr,sizeof(type)*(n))
1298

1299
#define EXIT     do { TIME_OFF; PutStatistics(); exit(1); } while(0)
1300

1301
#define IN_LINE_MARGIN    OutLine[++PosOutLine]=MARGIN
1302

1303
#define INTEGER_MINUS(ia)  do {  if(INTEGER_IS_NEGATIVE(ia))\
1304
                                   (ia)[0] &= INTEGER_N_LIMBS_MASK;\
1305
                                 else\
1306
                                   (ia)[0] |= INTEGER_SIGN_MASK; } while(0)
1307
#define INTEGER_IS_NEGATIVE(ia)  (((ia)[0]&INTEGER_SIGN_MASK)!=0)
1308
#define INTEGER_IS_POSITIVE(ia)  (((ia)[0]&INTEGER_SIGN_MASK)==0)
1309

1310
#define INTEGER_IS_UNIT(ia)  (((ia)[0]==1) && ((ia)[1]==1))
1311
#define INTEGER_IS_UNIT_ABS(ia)  ((((ia)[0]&INTEGER_N_LIMBS_MASK)==1) &&\
1312
                              ((ia)[1]==1))
1313
#define INTEGER_IS_NOT_UNIT(ia)  (((ia)[0]!=1) || ((ia)[1]!=1))
1314
#define INTEGER_IS_NOT_UNIT_ABS(ia)  ((((ia)[0]&INTEGER_N_LIMBS_MASK)!=1) ||\
1315
                                  ((ia)[1]!=1))
1316
#define INTEGER_N_LIMBS(ia)  ((ia)[0]&INTEGER_N_LIMBS_MASK)
1317

1318
#define INTEGER_SET_MINUS(ia)       (ia)[0] |= INTEGER_SIGN_MASK
1319
#define INTEGER_SET_PLUS(ia)        (ia)[0] &= INTEGER_N_LIMBS_MASK
1320
#define INTEGER_SIGN(ia)            ((ia)[0]&INTEGER_SIGN_MASK)
1321

1322
#define INTEGER_HEAP_NEW(n,i)       (n)=(BIGINT)malloc(sizeof(LIMB)*(i))\
1323
                                    INTEGER_IN_HEAP(n)
1324
#define INTEGER_HEAP_COPY(n,o,i)    (i)=INTEGER_N_LIMBS(o);\
1325
                                    INTEGER_HEAP_NEW(n,++(i));\
1326
                                    do{(i)--; (n)[i] = (o)[i];}while(i)
1327
#define INTEGER_HEAP_COPY_DOUBLE_1(n1,n2,o,i) \
1328
                                    (i)=INTEGER_N_LIMBS(o);\
1329
                                    INTEGER_HEAP_NEW(n1,++(i)+1);\
1330
                                    INTEGER_HEAP_NEW(n2,i);\
1331
                                    do{(i)--; (n1)[i] = (n2)[i] = (o)[i];}\
1332
                                    while(i)
1333
#define INTEGER_KILL(bn)            free(bn) MM_CURRENT_N_INT
1334

1335

1336
#define INTEGER_STACK_NEW(n,i)      (n)=(BIGINT)alloca(sizeof(LIMB)*(i))\
1337
                                    INTEGER_IN_STACK(n)
1338

1339
#define INTEGER_STACK_COPY(n,o,i)   (i)=INTEGER_N_LIMBS(o);\
1340
                                    INTEGER_STACK_NEW(n,++(i));\
1341
                                    do{(i)--; (n)[i] = (o)[i];}while(i)
1342

1343
#define INTEGER_STACK_COPY_1(n,o,i) (i)=INTEGER_N_LIMBS(o);\
1344
                                    INTEGER_STACK_NEW(n,++(i)+1);\
1345
                                    do{(i)--; (n)[i] = (o)[i];}while(i)
1346

1347
#define LIE_MONOMIAL_I_RELATION(pos)    (~LIE_MONOMIAL_INDEX(pos))
1348
#define LIE_MONOMIAL_INDEX_BY_ORDER(ord) \
1349
                         LIE_MONOMIAL_INDEX(LIE_MONOMIAL_POSITION(ord))
1350
#define LIE_MONOMIAL_IS_EVEN(pos)       (LIE_MONOMIAL_PARITY(pos)==EVEN)
1351
#define LIE_MONOMIAL_IS_LEADING_BY_ORDER(ord) \
1352
                    LIE_MONOMIAL_IS_LEADING(LIE_MONOMIAL_POSITION(ord))
1353
#define LIE_MONOMIAL_IS_OCCUPIED(pos)   LIE_MONOMIAL_WEIGHT(pos)
1354
#define LIE_MONOMIAL_IS_GENERATOR(pos)  ((pos) < GeneratorN)
1355
#define LIE_MONOMIAL_IS_GENERATOR_BY_ORDER(ord) \
1356
                              (LIE_MONOMIAL_POSITION(ord) < GeneratorN)
1357
#define LIE_MONOMIAL_IS_COMMUTATOR(pos) ((pos) >= GeneratorN)
1358
#define LIE_MONOMIAL_IS_ODD(pos)        LIE_MONOMIAL_PARITY(pos)
1359
#define LIE_MONOMIAL_IS_SQUARE(pos)     (LIE_MONOMIAL_LEFT(pos)==\
1360
                                         LIE_MONOMIAL_RIGHT(pos))
1361
#define LIE_MONOMIAL_IS_NOT_SQUARE(pos)  (LIE_MONOMIAL_LEFT(pos)!=\
1362
                                          LIE_MONOMIAL_RIGHT(pos))
1363
#define LIE_MONOMIAL_LEFT(pos)          (LieMonomial[pos].left)
1364
#define LIE_MONOMIAL_RIGHT(pos)         (LieMonomial[pos].right)
1365
#define LIE_MONOMIAL_ORDER(pos)         (LieMonomial[pos].order)
1366
#define LIE_MONOMIAL_LEFT_ORDER(pos)   \
1367
                      LIE_MONOMIAL_ORDER(LIE_MONOMIAL_LEFT(pos))
1368
#define LIE_MONOMIAL_RIGHT_ORDER(pos)   \
1369
                      LIE_MONOMIAL_ORDER(LIE_MONOMIAL_RIGHT(pos))
1370
#define LIE_MONOMIAL_POSITION(ord)      (LieMonomial[ord].position)
1371
#define LIE_MONOMIAL_WEIGHT_BY_ORDER(ord) \
1372
                      LIE_MONOMIAL_WEIGHT(LIE_MONOMIAL_POSITION(ord))
1373
#define LIE_MONOMIAL_INDEX(pos)         (LieMonomial[pos].info.index)
1374
#define LIE_MONOMIAL_IS_BASIS(pos)      (LieMonomial[pos].info.index >= 0)
1375
#define LIE_MONOMIAL_IS_LEADING(pos)    (LieMonomial[pos].info.index < 0)
1376
#define LIE_MONOMIAL_PARITY(pos)        (LieMonomial[pos].info.parity)
1377
#define LIE_MONOMIAL_WEIGHT(pos)        (LieMonomial[pos].info.weight)
1378

1379
#define LIE_TERM_MONOMIAL(a)               (NodeLT[a].monomial)
1380
#define LIE_TERM_MONOMIAL_ORDER(a)         LIE_MONOMIAL_ORDER(\
1381
                                             (NodeLT[a].monomial))
1382
#define LIE_TERM_R(a)                      (NodeLT[a].rptr)
1383
#define LIE_TERM_NUMERATOR_INTEGER(a)      (NodeLT[a].numerator.integer)
1384
#define LIE_TERM_MINUS_INTEGER(a) \
1385
                        INTEGER_MINUS(NodeLT[a].numerator.integer)
1386
#define LIE_TERM_NUMERATOR_SCALAR_SUM(a)   (NodeLT[a].numerator.scalar_sum)
1387
#define LIE_TERM_DENOMINATOR_INTEGER(a)    (NodeLT[a].denominator.integer)
1388
#define LIE_TERM_DENOMINATOR_SCALAR_SUM(a) (NodeLT[a].denominator.scalar_sum)
1389

1390
#define MAX(a,b)    (((a) > (b)) ? (a) : (b))
1391

1392
#define NODE_LT_KILL(a)    LIE_TERM_R(a)=NodeLTTop,NodeLTTop=(a)\
1393
                                                     MM_CURRENT_N_LT
1394
#define NODE_SF_KILL(a)    SCALAR_FACTOR_R(a)=NodeSFTop,NodeSFTop=(a)\
1395
                                                        MM_CURRENT_N_SF
1396
#define NODE_ST_KILL(a)    SCALAR_TERM_R(a)=NodeSTTop,NodeSTTop=(a)\
1397
                                                      MM_CURRENT_N_ST
1398

1399
#define RELATION_LIE_SUM(i)           (Relation[i].lie_sum)
1400
#define RELATION_MIN_GENERATOR(i)     (Relation[i].min_generator)
1401
#define RELATION_TO_BE_SUBSTITUTED(i) (Relation[i].to_be_substituted)
1402

1403
#define SCALAR_SUM_IS_UNIT(a)  (SCALAR_TERM_MONOMIAL(a)==NIL&&\
1404
                                INTEGER_IS_UNIT(SCALAR_TERM_NUMERATOR(a)))
1405

1406
#define SCALAR_SUM_IS_UNIT_ABS(a)  (SCALAR_TERM_MONOMIAL(a)==NIL&&\
1407
                              INTEGER_IS_UNIT_ABS(SCALAR_TERM_NUMERATOR(a)))
1408

1409
#define SCALAR_SUM_IS_NOT_UNIT(a)  (SCALAR_TERM_MONOMIAL(a)!=NIL||\
1410
                                    INTEGER_IS_NOT_UNIT(\
1411
                                          SCALAR_TERM_NUMERATOR(a)))
1412

1413
#define SCALAR_TERM_MONOMIAL(a)  (NodeST[a].monomial)
1414
#define SCALAR_TERM_NUMERATOR(a) (NodeST[a].numerator)
1415
#define SCALAR_TERM_R(a)         (NodeST[a].rptr)
1416

1417
#define SCALAR_FACTOR_PARAMETER(a)    (NodeSF[a].parameter)
1418
#define SCALAR_FACTOR_IS_I_NUMBER(a)  (NodeSF[a].parameter==I_NUMBER)
1419
#define SCALAR_FACTOR_DEGREE(a)       (NodeSF[a].degree)
1420
#define SCALAR_FACTOR_WORD(a)         (*(unsigned short *)(NodeSF+(a)))
1421
#define SCALAR_FACTOR_R(a)            (NodeSF[a].rptr)
1422

1423
#define SCALAR_TERM_MINUS(a)  INTEGER_MINUS(NodeST[a].numerator)
1424
#define SCALAR_TERM_MAIN_PARAMETER(a) \
1425
                           SCALAR_FACTOR_PARAMETER(SCALAR_TERM_MONOMIAL(a))
1426
#define SCALAR_TERM_MAIN_PARAMETER_WORD(a) \
1427
                                SCALAR_FACTOR_WORD(SCALAR_TERM_MONOMIAL(a))
1428
#define SCALAR_TERM_MAIN_DEGREE(a) \
1429
                              SCALAR_FACTOR_DEGREE(SCALAR_TERM_MONOMIAL(a))
1430
#define POLY_MAIN_PARAMETER(a) ((SCALAR_TERM_MONOMIAL(a)==NIL) ? -1 :\
1431
                          SCALAR_FACTOR_PARAMETER(SCALAR_TERM_MONOMIAL(a)))
1432
#define POLY_ARRAY_STACK_NEW(a,n)   (a)=(uint*)alloca(sizeof(uint)*(n))\
1433
                                    POLY_ARRAY_IN_STACK(a)
1434

1435
#define TIME_OFF  TimeC += (CrudeTime ? time(NULL) : clock()) - TimeA
1436
#define TIME_ON   TimeA = (CrudeTime ? time(NULL) : clock())
1437

1438
/*_5    Global variables and arrays=====================================*/
1439

1440
/* Files */
1441

1442
#if !defined(GAP)
1443
FILE *MessageFile;
1444
FILE *SessionFile;
1445
#endif
1446

1447
/* Single variables */
1448

1449
int IncompletedBasis;
1450
int IncompletedRelations;
1451
int IsParametric;
1452
int LieMonomialIsNew;
1453
int SubstitutionIsDone;
1454
uint LimitingWeight;
1455
int GeneratorN;
1456
int ParameterN;
1457

1458
/* Arrays */
1459

1460
LIE_MON *LieMonomial;    /* Set of Lie monomials */
1461
int LieMonomialSize;
1462
int LieMonomialN;
1463
int LieMonomialFreePosition; /* Start search of free position */
1464
#if defined(SPACE_STATISTICS)
1465
int LieMonomialMaxN;
1466
#endif
1467

1468

1469
NODE_LT *NodeLT;         /* Pool of nodes for Lie terms */
1470
uint NodeLTSize;
1471
uint NodeLTTop = 1;
1472
#if defined(SPACE_STATISTICS)
1473
uint NodeLTTopMax;
1474
#endif
1475

1476
NODE_SF *NodeSF;         /* Pool of nodes for scalar factors */
1477
uint NodeSFSize;
1478
uint NodeSFTop = 1;
1479
#if defined(SPACE_STATISTICS)
1480
uint NodeSFTopMax;
1481
#endif
1482

1483
NODE_ST *NodeST;         /* Pool of nodes for scalar terms */
1484
uint NodeSTSize;
1485
uint NodeSTTop = 1;
1486
#if defined(SPACE_STATISTICS)
1487
uint NodeSTTopMax;
1488
#endif
1489

1490
REL *Relation;           /* Ordered set of relations */
1491
int RelationSize;
1492
int RelationN;
1493
#if defined(SPACE_STATISTICS)
1494
int MaxNRelation;
1495
#endif
1496
#if defined(INTEGER_MAX_SIZE)
1497
LIMB IntegerMaxSize;
1498
#endif
1499

1500
int CoeffSumTableSize; /* Non-zero coefficient tables variables */
1501
int CoeffSumTableN;
1502
uint *CoeffSumTable;     /* Non-zero parametric sums */
1503
int *CoeffParamTable;   /* Table for memorizing single */
1504
                         /* non-zero parameters */
1505

1506
/* Input and output variables */
1507

1508
char BasisSymbolEven;
1509
char BasisSymbolOdd;
1510
int CurrentLevel;
1511
char * GeneratorName;     /* Input names */
1512
char * ParameterName;
1513
int GeneratorMaxN;     /* Maximum number of input generators */
1514
uint InputIntegerSize;  /* Maximum size of input integer in LIMBs */
1515
int InputStringSize;   /* Size of string for reading input */
1516
int LastItemEnd;
1517
int LineLength;
1518
int Margin;
1519
int MaxLevel;
1520
int MinLevel;
1521
int NameLength1;       /* Maximum length of input name (with ending '\0') */
1522
int NewMargin;
1523
int ParameterMaxN = 1; /* Maximum number of input parameters (i at least) */
1524
int BasisElementsPut;
1525
int CommutatorsPut;
1526
int CrudeTime;         /* Prevent time variable wrapping for large tasks */
1527
int EchoInput;
1528
int GAPOutputCommutators;
1529
int GAPOutputBasis;
1530
int GAPOutputRelations;
1531
char GAPAlgebraName[GAP_NAME_SIZE];
1532
char GAPBasisName[GAP_NAME_SIZE];
1533
char GAPRelationsName[GAP_NAME_SIZE];
1534
int HeadingPut;
1535
int HilbertSeriesPut;
1536
int InitialRelationsPut;
1537
int NonZeroCoefficientsPut;
1538
int ReducedRelationsPut;
1539
int StatisticsPut;
1540
char * OutLine;           /* String for preparation of output block */
1541
int OutLineSize;
1542
int PosOutLine;
1543
int PreviousEnd;
1544
int PrintEnd;
1545

1546
uint TimeA, TimeC;
1547

1548
#if defined(DEBUG)
1549
uint Debug;
1550
#endif
1551
#if defined(MEMORY)
1552
int CurrentNLT;
1553
int CurrentNSF;
1554
int CurrentNST;
1555
int CurrentNINT;
1556

1557
#endif
1558

1559
/*_6    Function descriptions===========================================*/
1560

1561
/*_6_0          Main and top level functions============================*/
1562

1563
void ConstructFreeAlgebraBasis(void);       /* 1 call! */
1564
int FindNewPositionInRelation(int lmo);
1565
void GenerateRelations(void);               /* 1 call! */
1566
uint NewJacobiRelation(int l);           /* 1 call! */
1567
int ReduceRelations(int i);
1568

1569
/*_6_1          Pairing functions=======================================*/
1570

1571
int AddPairToLieMonomial(int i, int j);
1572
uint MakeRelationRHSInteger(int i);             /* 1 call!! */
1573
uint MakeRelationRHSParametric(int i);          /* 1 call!! */
1574
uint PairMonomialMonomialInteger(int i, int j);
1575
uint PairMonomialMonomialParametric(int i, int j);
1576
uint PairMonomialSumInteger(int mon, uint a);
1577
uint PairMonomialSumParametric(int mon, uint a);
1578
uint PairSumMonomialInteger(uint a, int mon);
1579
uint PairSumMonomialParametric(uint a, int mon);
1580
uint PairSumSumInteger(uint a, uint b);
1581
uint PairSumSumParametric(uint a, uint b);
1582

1583
/*_6_2          Substitution (replacing) functions======================*/
1584

1585
int IsMonomialInMonomial(int submon, int mon);
1586
uint SubstituteRelationInRelationInteger(uint r, uint a);
1587
uint SubstituteRelationInRelationParametric(uint r, uint a);
1588
uint SubstituteRHSInMonomialInteger(int mon, int lmonr, uint r);
1589
uint SubstituteRHSInMonomialParametric(int mon, int lmonr, uint r);
1590

1591
/*_6_3          Lie and scalar algebra functions========================*/
1592

1593
int LieLikeTermsCollectionInteger(uint a, uint b);
1594
int LieLikeTermsCollectionParametric(uint a, uint b);
1595
uint LieSumAddition(uint a, uint b);
1596
void LieSumDivInteger(uint lsum, BIGINT den);
1597
void LieSumDivScalarSum(uint lsum, uint den);
1598
void LieSumMinusInteger(uint a);
1599
void LieSumMinusParametric(uint a);
1600
void LieSumMultInteger(uint lsum, BIGINT num);
1601
#if defined(RATIONAL_FIELD)
1602
void LieSumMultRationalInteger(int a, BIGINT num, BIGINT den);
1603
#endif
1604
void LieSumMultScalarSum(uint lsum, uint num);
1605
void NormalizeRelationInteger(uint a);
1606
void NormalizeRelationParametric(uint a);
1607
uint ScalarMonomialMultiplication(int *pchange_sign, uint ma, uint mb);
1608
uint ScalarSumAddition(uint a, uint b);
1609
void ScalarSumCancellation(uint *pnum, uint *pden);
1610
void ScalarSumMinus(uint a);
1611
uint ScalarSumMultiplication(uint a, uint b);
1612
void ScalarTermMultiplication(uint a, uint b);     /* 1 call! */
1613

1614
/*_6_4          Scalar polynomial algebraic functions===================*/
1615

1616
uint ContentOfScalarSum(uint cont, uint a);
1617
void InCoeffParamTable(uint cont);
1618
void InCoeffSumTable(uint sum);
1619
void InCoeffTable(uint coe);
1620
uint PolyCoeffAtMainParameter(uint *pa, int mp);
1621
uint PolyContent(uint a, int mp);
1622
uint PolyGCD(uint a, uint b);
1623
uint PolyMainParameterTerm(uint *pa, int mp, int mpdeg);
1624
int PolynomialsAreEqual(uint a, uint b);
1625
uint PolyPseudoRemainder(uint a, uint b, int mp);  /* 1 call! */
1626
uint PolyTermGCD(uint a, uint b);
1627
void PolyTermQuotient(uint a, uint b);
1628
uint PolyQuotient(uint a, uint b);
1629

1630
/*_6_5          Big number functions====================================*/
1631

1632
int BigNMinusBigN(BIGINT a, int na, BIGINT b, int nb);
1633
LIMB BigNShiftLeft(BIGINT bign, int n, int cnt);
1634
int BigNShiftRight(BIGINT bign, int n, int cnt);
1635
int CountLeadingZeroBitsInLimb(LIMB w);
1636
void IntegerCancellation(BIGINT num, BIGINT den);
1637
BIGINT IntegerGCD(BIGINT u, BIGINT v);
1638
void IntegerProduct(BIGINT w, BIGINT u, BIGINT v);
1639
void IntegerQuotient(BIGINT c, BIGINT a, BIGINT b);
1640
void IntegerSum(BIGINT c, BIGINT a, BIGINT b);
1641

1642
/*_6_6          Copy and delete functions===============================*/
1643

1644
uint LieSumCopyInteger(uint a);
1645
uint LieSumCopyIntegerNegative(uint a);
1646
uint LieSumCopyParametric(uint a);
1647
void LieSumKillInteger(uint a);
1648
void LieSumKillParametric(uint a);
1649
uint LieTermFromMonomialInteger(int mon);
1650
uint LieTermFromMonomialParametric(int mon);
1651
uint ScalarSumCopy(uint a);
1652
void ScalarSumKill(uint a);
1653
uint ScalarTermCopy(uint a);
1654

1655
/*_6_7          Technical functions=====================================*/
1656

1657
void Error(int i_message) ATTRIBUTE_NORETURN;
1658
void Initialization(void);
1659
void *NewArray(uint n, uint size, int i_message);
1660
uint NodeLTNew(void);
1661
uint NodeSFNew(void);
1662
uint NodeSTNew(void);
1663
FILE *OpenFile(char * file_name, char * file_type);
1664

1665
/*_6_8          Input functions=========================================*/
1666

1667
int BinaryQuestion(int i_message);
1668
int FindNameInTable(char * name, char * nametab, int n_nametab);
1669
void GetGenerator(char * str);
1670
void GetInput(int n, char * fin);
1671
void GetInteger(BIGINT a, char **pstr);
1672
uint GetLieMonomial(char **pstr);
1673
uint GetLieSum(char **pstr);
1674
uint GetLieTerm(char **pstr);
1675
uint GetUInteger(char **pstr);
1676
void GetParameter(char * str);
1677
void GetRelation(char * str);
1678
uint GetScalarSum(char **pstr);
1679
uint GetScalarTerm(char **pstr);
1680
void GetWeight(char * str);
1681
int KeyBoardBytesToString(char * str);
1682
int KeyBoardStringToFile(int i_m, char * prefix, char * str, FILE *file);
1683
void ReadAndProcessStringsFromFile(void (*proc_func)(char * str), FILE *inf,
1684
                                                        char sep, char end);
1685
int ReadBooleanFromFile(FILE *file);
1686
int ReadCaseFromFile(FILE * file, char * case_str[], int n_cases);
1687
uint ReadDecimalFromFile(FILE *file);
1688
short ReadStringFromFile(char * str, FILE *file);
1689
short SkipCommentInFile(FILE *file);
1690
void SkipName(char **pstr);
1691
void SkipSpaces(char **pstr);
1692
short SkipSpacesInFile(FILE *file);
1693

1694
/*_6_9          Output functions========================================*/
1695

1696
void AddSymbolToOutLine(char c, int position);
1697
void InLineLevel(int level);
1698
void InLineNumberInBrackets(uint n);
1699
void InLineString(char * str);
1700
void InLineSubscript(char * s);
1701
void InLineSymbol(char symbol);
1702
void InLineTableName(char * name);
1703
char * UToString(uint n);
1704
void PutBasis(void);
1705
#if defined(GAP)
1706
void PutBasisGAP(void);
1707
#endif
1708
void PutBlock(void);
1709
void PutCharacter(char c);
1710
#if defined(GAP)
1711
void PutCharacterGAP(char c);
1712
#endif
1713
void PutCoefficientTable(void);
1714
void PutCommutators(void);
1715
#if defined(GAP)
1716
void PutCommutatorsGAP(void);
1717
#endif
1718
void PutDegree(uint deg);
1719
void PutDimensions(void);
1720
void PutDots(void);
1721
void PutEnd(void);
1722
void PutFormattedU(char * format, uint i);
1723
void PutIntegerUnsigned(BIGINT bn);
1724
#if defined(GAP)
1725
void PutIntegerUnsignedGAP(BIGINT bn);
1726
#endif
1727
void PutLieBareTerm(void (*put_lie_mon)(int a), uint a);
1728
void PutLieBasisElement(int pos);
1729
void PutLieMonomialLeftNormed(int pos);
1730
void PutLieMonomialStandard(int pos);
1731
#if defined(GAP)
1732
void PutLieMonomialGAP(int pos);
1733
#endif
1734
void PutLieSum(void (*put_lie_mon)(int a), uint a);
1735
void PutMessage(int i_message);
1736
void PutRelations(int i);
1737
#if defined(GAP)
1738
void PutRelationsGAP(void);
1739
#endif
1740
void PutScalarBareTerm(uint a);
1741
void PutScalarFactor(uint a);
1742
void PutScalarSum(uint a);
1743
void PutStart(void);
1744
void PutStatistics(void);
1745
void PutString(char * str);
1746
#if defined(GAP)
1747
void PutStringGAP(char * str);
1748
#endif
1749
void PutStringStandard(char * str);
1750
void PutSymbol(char c);
1751

1752
/* Global function variables */
1753

1754
int (*LieLikeTermsCollection)(uint a, uint b) = LieLikeTermsCollectionInteger;
1755
uint (*LieSumCopy)(uint a) = LieSumCopyInteger;
1756
void (*LieSumKill)(uint a) = LieSumKillInteger;
1757
void (*LieSumMinus)(uint a) = LieSumMinusInteger;
1758
uint (*LieTermFromMonomial)(int mon) = LieTermFromMonomialInteger;
1759
void (*NormalizeRelation)(uint a) = NormalizeRelationInteger;
1760
uint (*PairMonomialMonomial)(int i, int j) = PairMonomialMonomialInteger;
1761
uint (*PairMonomialSum)(int mon, uint a) = PairMonomialSumInteger;
1762
uint (*PairSumMonomial)(uint a, int mon) = PairSumMonomialInteger;
1763
uint (*PairSumSum)(uint a, uint b) = PairSumSumInteger;
1764
void (*PutLieMonomial)(int pos) = PutLieMonomialStandard;
1765
uint (*SubstituteRelationInRelation)(uint r, uint a) =
1766
SubstituteRelationInRelationInteger;
1767

1768
/*_6_10   Debugging functions===========================================*/
1769

1770
#if defined(DEBUG)
1771
void PutDebugHeader(uint debug, char * f_name, char * in_out);
1772
void PutDebugInteger(char * name, BIGINT u);
1773
void PutDebugLieMonomial(char * name, int a);
1774
void PutDebugLieMonomialTable(int newmon);
1775
void PutDebugLieSum(char * name, uint a);
1776
void PutDebugLieTerm(char * name, uint a);
1777
void PutDebugU(char * name, uint i);
1778
#if defined(D_PUT_RELATIONS)
1779
void PutDebugRelations(void);
1780
#endif
1781
void PutDebugScalarSum(char * name, uint a);
1782
void PutDebugString(char * strname, char * str);
1783
#endif
1784
#if defined(MEMORY)
1785
void AddLieSumNs(uint a, int minus_or_plus,
1786
              int *pn_lt, int *pn_int, int *pn_st, int *pn_sf);
1787
void AddScalarSumNs(uint a, int minus_or_plus, int *pn_int, int *pn_st, int *pn_sf);
1788
void PutIntegerBalance(char * fname, int dn);
1789
void PutNodeBalance(char * type, char * fname, int dn);
1790
#endif
1791

1792
/*_6_0          Main and top level functions============================*/
1793

1794
#if !defined(TEST_FUNCTION)
1795
/*=main======================================
1796
*/
1797
int main(int narg, char ** fin)
1798
{
1799
  Initialization();
1800
  GetInput(narg, fin[1]);
1801
  if(RelationN)
1802
  {
1803
    if(InitialRelationsPut)
1804
      PutRelations(H_IN_RELATIONS);
1805
    GenerateRelations();
1806
    if(NonZeroCoefficientsPut)
1807
      PutCoefficientTable();
1808
  }
1809
  if(RelationN)
1810
  {
1811
    if(ReducedRelationsPut)
1812
      PutRelations(H_REDUCED_RELATIONS);
1813
  }
1814
  else /* Free algebra */
1815
    ConstructFreeAlgebraBasis();
1816
  PutBasis();
1817
  if(HilbertSeriesPut)
1818
    PutDimensions();
1819
  if(CommutatorsPut)
1820
    PutCommutators();
1821
#if defined(DEBUG)
1822
  PutDebugU("Top Debug", Debug);
1823
#endif
1824
  if(StatisticsPut)
1825
  {
1826
    TIME_OFF;
1827
    PutStatistics();
1828
  }
1829
#if defined(GAP)
1830
  if(!IsParametric && !IncompletedRelations && !IncompletedBasis)
1831
  {
1832
/*    if(GAPOutputCommutators || GAPOutputBasis || GAPOutputRelations) */
1833
/*    {                                                                */
1834
/*      fclose(SessionFile);                                           */
1835
/*#if defined(SPP_2000)                                                */
1836
/*      SessionFile = OpenFile("fplsa4.gap", "w");                     */
1837
/*#else                                                                */
1838
/*      SessionFile = OpenFile("fplsa4.gap", "wt");                    */
1839
/*#endif                                                               */
1840
/*    }                                                                */
1841
    if(GAPOutputCommutators)
1842
      PutCommutatorsGAP();
1843
    if(GAPOutputBasis)
1844
      PutBasisGAP();
1845
    if(GAPOutputRelations)
1846
      PutRelationsGAP();
1847
  }
1848
#endif
1849
  exit(0);
1850
}
1851
#endif
1852
/*=ConstructFreeAlgebraBasis==========================================
1853
 Make all regular monomials up to LimitingWeight
1854
*/
1855
void ConstructFreeAlgebraBasis(void)
1856
{
1857
  int i = 0, j, moni, monj;
1858
  while(YES)
1859
  {
1860
    moni = LIE_MONOMIAL_POSITION(i);
1861
    if(LIE_MONOMIAL_IS_NOT_SQUARE(moni)) /* ?? Not so for non-standard */
1862
    {
1863
      j = 0;
1864
      while(j < i)
1865
      {
1866
        monj = LIE_MONOMIAL_POSITION(j);
1867
        if(LIE_MONOMIAL_IS_NOT_SQUARE(monj))
1868
          if(LIE_MONOMIAL_IS_GENERATOR(moni) ||
1869
             j >= LIE_MONOMIAL_RIGHT_ORDER(moni))
1870
          {
1871
            if(LIE_MONOMIAL_WEIGHT(moni) + LIE_MONOMIAL_WEIGHT(0) >
1872
               LimitingWeight) /* Out of weight for all consequent i & j */
1873
              goto incompleted;
1874
            if(LIE_MONOMIAL_WEIGHT(moni) + LIE_MONOMIAL_WEIGHT(monj) >
1875
               LimitingWeight) /* Out of weight for all consequent j */
1876
              goto next_i;
1877
            AddPairToLieMonomial(moni, monj);
1878
          }
1879
        j++;
1880
      }
1881
      if(LIE_MONOMIAL_IS_ODD(moni))
1882
      {                           /* Add square */
1883
        if(LIE_MONOMIAL_WEIGHT(moni) + LIE_MONOMIAL_WEIGHT(0) >
1884
           LimitingWeight) /* Out of weight for all consequent i & j */
1885
          goto incompleted;
1886
        if(2*LIE_MONOMIAL_WEIGHT(moni) > LimitingWeight)
1887
          goto next_i;         /* Out of weight for all consequent j */
1888
        AddPairToLieMonomial(moni, moni);
1889
      }
1890
    }
1891
    next_i:
1892
    if(++i >= LieMonomialN)
1893
      return;            /* One generator case */
1894
  }
1895
  incompleted:
1896
  IncompletedBasis = YES;
1897
}
1898
/*=FindNewPositionInRelation======================================
1899
 Find position of first relation with leading monomial order > lmo
1900
 among 0, 1,..., RelationN - 1
1901
*/
1902
int FindNewPositionInRelation(int lmo)
1903
{
1904
  int left = 0;
1905
  if(RelationN)                                /* Binary search */
1906
  {                           /* `right' must be of signed type */
1907
    int m, right = RelationN-1;
1908
    do
1909
    {
1910
      m = (left + right)/2;
1911
      if(lmo < LIE_TERM_MONOMIAL_ORDER(RELATION_LIE_SUM(m)))
1912
        right = --m;
1913
      else
1914
        left = ++m;
1915
    }while(left <= right);
1916
  }
1917
  return left;
1918
}
1919
/*=GenerateRelations=======================================================
1920
 Generate and process new relations
1921
*/
1922
void GenerateRelations(void)
1923
{
1924
  int i, k, l, mon, mona,
1925
      gen;    /* LieMonomial table position of differentiating generator */
1926
  uint a, lim_weight_i;
1927
  i = 0;
1928
  while(i < RelationN)                           /* Differentiation loop */
1929
    if(RELATION_MIN_GENERATOR(i) < GeneratorN)
1930
      if(LIE_MONOMIAL_IS_BASIS(gen = RELATION_MIN_GENERATOR(i)))
1931
      {
1932
        /* Program assures the ban of differentiation OF leading generators
1933
           in the process of new relation adding by setting negation of the
1934
           first IF predicate */
1935
        a = RELATION_LIE_SUM(i);
1936
        mona = LIE_TERM_MONOMIAL(a);   /* Irregular triple criterion */
1937
        if(LIE_MONOMIAL_IS_SQUARE(mona) ||
1938
           LIE_MONOMIAL_ORDER(gen) < LIE_MONOMIAL_RIGHT_ORDER(mona))
1939
        {
1940
IN_GENERATE_RELATIONS  /*------------------------------------------------*/
1941
          if(LIE_MONOMIAL_WEIGHT(gen) +                 /* Out of weight */
1942
             LIE_MONOMIAL_WEIGHT(LIE_TERM_MONOMIAL(a)) > LimitingWeight)
1943
          {
1944
            RELATION_MIN_GENERATOR(i++) = GeneratorN;
1945
            continue;     /* There might be lower weight next generators */
1946
          }
1947
          RELATION_MIN_GENERATOR(i)++;       /* For next differentiation */
1948
          if((a = (*PairSumMonomial)((*LieSumCopy)(a), gen)) != NIL)
1949
          {
1950
            add_new_relation:
1951
            if(RelationN == RelationSize)
1952
              Error(E_RELATION_SIZE);
1953
            gen = LIE_TERM_MONOMIAL(a);
1954
            l = FindNewPositionInRelation(k = LIE_MONOMIAL_ORDER(gen));
1955
#if defined(SPACE_STATISTICS)
1956
            if(RelationN >= MaxNRelation)
1957
              MaxNRelation = RelationN + 1;
1958
#endif
1959
            (*NormalizeRelation)(a);
1960
OUT_GENERATE_RELATIONS /*------------------------------------------------*/
1961
            LIE_MONOMIAL_INDEX(gen) = ~l;    /* Set position of relation */
1962

1963
            /* Shift positions of higher  relations in LieMonomial */
1964

1965
            while(++k < LieMonomialN)
1966
              if(LIE_MONOMIAL_IS_LEADING_BY_ORDER(k))
1967
                --LIE_MONOMIAL_INDEX_BY_ORDER(k);
1968

1969
            /* Make room for new relation */
1970

1971
            for(k = RelationN; k > l; k--)
1972
              Relation[k] = Relation[k-1];
1973

1974
            if(LIE_MONOMIAL_IS_GENERATOR(gen))    /* Ban differentiating */
1975
              RELATION_MIN_GENERATOR(l) = GeneratorN;  /* lead. generat. */
1976
            else
1977
            {
1978
              RELATION_MIN_GENERATOR(l) = 0;
1979
              if(l <= i)                       /* Shift min. diff. index */
1980
                i = l;
1981
            }
1982
            RELATION_LIE_SUM(l) = a;                 /* Set new relation */
1983
            if(LIE_MONOMIAL_WEIGHT(gen) + 1 > LimitingWeight)
1984
              RELATION_MIN_GENERATOR(l) = GeneratorN;
1985
            if(l == RelationN++)
1986
              RELATION_TO_BE_SUBSTITUTED(l) = NO;
1987
            else
1988
            {                           /* New relation inside the table */
1989
              RELATION_TO_BE_SUBSTITUTED(l) = YES;
1990
              l = ReduceRelations(l);
1991
              if(l <= i)
1992
                i = l;
1993
            }
1994
	    /* #if defined(RELATION_N_TO_SCREEN)
1995
            TIME_OFF;
1996
            printf("\n%10d", RelationN);
1997
            TIME_ON;
1998
	    #endif*/
1999
OUT_PUT_LIE_MONOMIAL /*--------------------------------------------------*/
2000
OUT_PUT_RELATIONS /*-----------------------------------------------------*/
2001
          }
2002
        }
2003
        else                   /* Any next generator >= right of leading */
2004
          RELATION_MIN_GENERATOR(i++) = GeneratorN;
2005
      }
2006
      else                  /* Skip differentiation BY leading generator */
2007
        RELATION_MIN_GENERATOR(i)++;
2008
    else
2009
      i++;                    /* Skip completely differentiated relation */
2010
  IncompletedBasis =                       /* Limiting weight is reached */
2011
  IncompletedRelations =
2012
    (LIE_MONOMIAL_WEIGHT(LIE_TERM_MONOMIAL(RELATION_LIE_SUM(RelationN-1)))
2013
     >= LimitingWeight);
2014

2015
/*??#if 0 vvvvvvvvvvvvvvvvv Off checking vvvvvvvvvvvvvvvvvvvvvvvvvvvvv*/
2016
  /* Check regular pairs */
2017

2018
  k = 0;
2019
  while(k < LieMonomialN)
2020
  {
2021
    gen = LIE_MONOMIAL_POSITION(k);
2022
    if(LIE_MONOMIAL_IS_BASIS(gen))
2023
    {
2024
#if 0 /*?? Experiment with individual basis elements vvvvvvvvvvvvvvvv */
2025
      if(LIE_MONOMIAL_IS_COMMUTATOR(gen))
2026
      {
2027
                             /* Old pairs */
2028
        a = NewJacobiRelation(gen);
2029
        if(a != NIL)
2030
/*??*/{
2031
/*??*/PutDebugLieSum("\n***New Jacobi Relation from Old Basis", a);
2032
          goto add_new_relation;
2033
/*??*/}
2034
      }
2035
#endif /*??  Experiment ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ */
2036
      if(LIE_MONOMIAL_WEIGHT(gen) + LIE_MONOMIAL_WEIGHT(0)
2037
         > LimitingWeight)
2038
      {
2039
        IncompletedBasis = YES;
2040
        goto loops_out;
2041
      }
2042
      if(LIE_MONOMIAL_IS_NOT_SQUARE(gen)) /* ?? non-standard square */
2043
      {
2044
        lim_weight_i = LimitingWeight - LIE_MONOMIAL_WEIGHT(gen);
2045
        i = 0;
2046
        do
2047
        {
2048
          mon = LIE_MONOMIAL_POSITION(i);
2049
          if(LIE_MONOMIAL_IS_BASIS(mon) &&
2050
             LIE_MONOMIAL_IS_NOT_SQUARE(mon) &&
2051
             (i != k || LIE_MONOMIAL_IS_ODD(mon)) &&
2052
             (LIE_MONOMIAL_IS_GENERATOR(gen) ||
2053
              i >= LIE_MONOMIAL_RIGHT_ORDER(gen)))
2054
          {
2055
            if(LIE_MONOMIAL_WEIGHT(mon) > lim_weight_i)
2056
              break; /* Stop considering next right monomials */
2057
            mon = AddPairToLieMonomial(gen, mon);
2058
            if(LieMonomialIsNew)
2059
            {                              /* New pairs */
2060
#if 0
2061
/*??*/PutDebugLieMonomial("\n***New Lie Monomial", mon);
2062
#endif
2063
              a = NewJacobiRelation(mon);
2064
              if(a != NIL)
2065
#if 0
2066
/*??*/{
2067
/*??*/PutDebugLieSum("\n***New Jacobi Relation", a);
2068
#endif
2069
                goto add_new_relation;
2070
#if 0
2071
/*??*/}
2072
#endif
2073
            }
2074
          }
2075
        }while(++i <= k);
2076
      }
2077
    }
2078
    ++k;
2079
  }
2080
  loops_out: ;
2081
/*??#endif ^^^^^^^^^^^^^^^^^^^^ Off checking ^^^^^^^^^^^^^^^^^^^^*/
2082
}
2083
/*=NewJacobiRelation===================================================
2084
  Construct independent Jacobi relation containing leading commutator L
2085
*/
2086
uint NewJacobiRelation(int l)
2087
{
2088
  uint a, b;
2089
  int x, y, z;
2090
IN_NEW_JACOBI_RELATION /*--------------------------------------------*/
2091
  /* Try left pair in l = [[x,y],z] to make relation:  */
2092
  /*                             p(x)p(y)              */
2093
  /* [[x,y],z] - [x,[y,z]] + (-1)        [y,[x,z]] = 0 */
2094

2095
  x = LIE_MONOMIAL_LEFT(l);
2096
  if(LIE_MONOMIAL_IS_COMMUTATOR(x))
2097
  {
2098
    z = LIE_MONOMIAL_RIGHT(l);
2099
    y = LIE_MONOMIAL_RIGHT(x);
2100
    x = LIE_MONOMIAL_LEFT(x);
2101

2102
    /* 1st of triple */
2103

2104
    a = (*LieTermFromMonomial)(l);
2105

2106
    /* 2nd of triple */
2107

2108
    if((b = (*PairMonomialMonomial)(z, y)) != NIL)
2109
    {
2110
      if(LIE_MONOMIAL_IS_ODD(y) && LIE_MONOMIAL_IS_ODD(z))
2111
        b = (*PairSumMonomial)(b, x);
2112
      else
2113
        b = (*PairMonomialSum)(x, b);
2114
      a = LieSumAddition(a, b);
2115
    }
2116

2117
    /* 3d of triple */
2118

2119
    if(LIE_MONOMIAL_ORDER(x) > LIE_MONOMIAL_ORDER(z))
2120
    {
2121
      if((b = (*PairMonomialMonomial)(x, z)) != NIL)
2122
      {
2123
        if(LIE_MONOMIAL_IS_ODD(x) && LIE_MONOMIAL_IS_ODD(y))
2124
        {
2125
          b = (*PairSumMonomial)(b, y);
2126
          if(LIE_MONOMIAL_IS_EVEN(z))
2127
            (*LieSumMinus)(b);
2128
        }
2129
        else
2130
          b = (*PairMonomialSum)(y, b);
2131
        a = LieSumAddition(a, b);
2132
      }
2133
    }
2134
    else
2135
    {
2136
      if((b = (*PairMonomialMonomial)(z, x)) != NIL)
2137
      {
2138
        if(LIE_MONOMIAL_IS_ODD(z) &&
2139
           LIE_MONOMIAL_PARITY(x) != LIE_MONOMIAL_PARITY(y))
2140
        {
2141
          b = (*PairMonomialSum)(y, b);
2142
          if(LIE_MONOMIAL_IS_EVEN(x))
2143
            (*LieSumMinus)(b);
2144
        }
2145
        else
2146
          b = (*PairSumMonomial)(b, y);
2147
        a = LieSumAddition(a, b);
2148
      }
2149
    }
2150

2151
    if(a != NIL)
2152
      goto out;
2153
  }
2154

2155
  /* Try right pair in l = [x,[y,z]] to make relation: */
2156
  /*                             p(x)p(y)              */
2157
  /* [x,[y,z]] - [[x,y],z] - (-1)        [y,[x,z]] = 0 */
2158

2159
  y = LIE_MONOMIAL_RIGHT(l);
2160
  if(LIE_MONOMIAL_IS_COMMUTATOR(y))
2161
  {
2162
    x = LIE_MONOMIAL_LEFT(l);
2163
    z = LIE_MONOMIAL_RIGHT(y);
2164
    y = LIE_MONOMIAL_LEFT(y);
2165

2166
    /* 1st of triple */
2167

2168
    a = (*LieTermFromMonomial)(l);
2169

2170
    /* 2nd of triple */
2171

2172
    if((b = (*PairMonomialMonomial)(x, y)) != NIL)
2173
    {
2174
      b = (*PairSumMonomial)(b, z);
2175
      (*LieSumMinus)(b);
2176
      a = LieSumAddition(a, b);
2177
    }
2178

2179
    /* 3d of triple */
2180

2181
    if((b = (*PairMonomialMonomial)(x, z)) != NIL)
2182
    {
2183
      b = (*PairMonomialSum)(y, b);
2184
      if(LIE_MONOMIAL_IS_EVEN(x) || LIE_MONOMIAL_IS_EVEN(y))
2185
          (*LieSumMinus)(b);
2186
      a = LieSumAddition(a, b);
2187
    }
2188

2189
    goto out;
2190
  }
2191
  a = NIL;
2192
  out:
2193
OUT_NEW_JACOBI_RELATION /*-------------------------------------------*/
2194
  return a;
2195
}
2196
/*=ReduceRelations=====================================================
2197
  Reduce the system of relations starting from Ith one. For further
2198
  differentiations returns lowest new positon (or starting one int).
2199
*/
2200
int ReduceRelations(int i)
2201
{
2202
  int i_min, j, lordj, lordl, min_gen, lmoni, k, l, m;
2203
  uint ai, aj;
2204
  i_min = i;
2205
  do           /* While relations with new leading monomialsls arise */
2206
    if(RELATION_TO_BE_SUBSTITUTED(i))
2207
    {
2208
IN_REDUCE_RELATIONS  /*----------------------------------------------*/
2209
      new_i:
2210
      ai = RELATION_LIE_SUM(i);
2211
      lmoni = LIE_TERM_MONOMIAL(ai);
2212
      j = i + 1;
2213
      while(j < RelationN)
2214
      {
2215
        aj = RELATION_LIE_SUM(j);
2216
        lordj = LIE_TERM_MONOMIAL_ORDER(aj);
2217
        aj = (*SubstituteRelationInRelation)(ai, aj);
2218
        test_substitution_result:
2219
        if(SubstitutionIsDone)
2220
        {
2221
          if(aj == NIL)                        /* Killed relation */
2222
          {
2223
            --RelationN;
2224
            k = lordj;
2225
            l = LIE_MONOMIAL_POSITION(k);
2226
            LIE_MONOMIAL_INDEX(l) = 0;            /* To ban usage */
2227
            while(++k < LieMonomialN)   /* Shift int's of relations */
2228
            {
2229
              l = LIE_MONOMIAL_POSITION(k);
2230
              if(LIE_MONOMIAL_IS_LEADING(l))       /* LieMonomial */
2231
                ++LIE_MONOMIAL_INDEX(l);
2232
            }
2233
            for(k = j; k < RelationN; k++) /* Remove gap shifting */
2234
              Relation[k] = Relation[k+1]; /* down top relations  */
2235
            continue;
2236
          }
2237
          else          /* Non-killing substitution has been done */
2238
          {
2239
            (*NormalizeRelation)(aj);
2240
            lordl = LIE_TERM_MONOMIAL_ORDER(aj);
2241
            if(lordl < lordj)        /* Change of leading ordinal */
2242
            {
2243
              l = 0;
2244
              k = j - 1;         /* Binary search of new position */
2245
              while(l <= k)
2246
              {
2247
                m = (l + k)/2;
2248
                if(lordl < LIE_TERM_MONOMIAL_ORDER(RELATION_LIE_SUM(m)))
2249
                  k = --m;
2250
                else
2251
                  l = ++m;
2252
              }
2253
              if(l &&
2254
                 LIE_TERM_MONOMIAL_ORDER(RELATION_LIE_SUM(l-1)) == lordl)
2255
              {             /* Substitute once more to avoid collision */
2256
                aj = (*SubstituteRelationInRelation)
2257
                                           (RELATION_LIE_SUM(l-1), aj);
2258
                goto test_substitution_result;
2259
              }
2260
              /* Set index of dropped relation in LieMonomial */
2261
              LIE_MONOMIAL_INDEX_BY_ORDER(lordl) = ~l;
2262
              /* Set zero to ban using old leading monomial
2263
                 of dropped relation */
2264
              LIE_MONOMIAL_INDEX_BY_ORDER(lordj) = 0;
2265
              min_gen = RELATION_MIN_GENERATOR(j);
2266
              /* Shift upper relations and their indices */
2267
              k = (j+1 == RelationN) ? LieMonomialN :
2268
                  LIE_TERM_MONOMIAL_ORDER(RELATION_LIE_SUM(j+1));
2269
              while(--k > lordl)
2270
                if(LIE_MONOMIAL_IS_LEADING_BY_ORDER(k))
2271
                  --LIE_MONOMIAL_INDEX_BY_ORDER(k); /* Means ++ */
2272
              for(k = j; k > l; k--)
2273
                Relation[k] = Relation[k-1];
2274
              RELATION_MIN_GENERATOR(l) =
2275
                LIE_MONOMIAL_IS_GENERATOR_BY_ORDER(lordl) ?
2276
                GeneratorN : /* Don't differentiate leading generator */
2277
                min_gen;   /* Avoiding redifferentiation (or set 0 ??) */
2278
              RELATION_TO_BE_SUBSTITUTED(l) = (byte)(l < RelationN-1);
2279
              RELATION_LIE_SUM(l) = aj;
2280
              if(l <= i)
2281
              {         /* New substituted relation with lesser ordinal */
2282
                i = l;
2283
                if(i < i_min)
2284
                  i_min = i;
2285
                goto new_i;
2286
              }
2287
            }
2288
            else                  /* No change of leading ordinal */
2289
              RELATION_LIE_SUM(j) = aj;
2290
          }
2291
        }
2292
        j++;
2293
      }
2294
      /* Remove consequences of leading monomial of substituted relation
2295
         from LieMonomial table */
2296
      lordj = LieMonomialN-1;
2297
      m = LIE_MONOMIAL_WEIGHT(lmoni);
2298
      while(LIE_MONOMIAL_WEIGHT_BY_ORDER(lordj) > (uint)m)
2299
      {
2300
        l = LIE_MONOMIAL_POSITION(lordj);
2301
        if(IsMonomialInMonomial(lmoni, l))
2302
        {
2303
          if(l < LieMonomialFreePosition)   /* Set possibly lowest */
2304
            LieMonomialFreePosition = l;    /* free position */
2305
          LIE_MONOMIAL_IS_OCCUPIED(l) = NO; /* Mark free position */
2306
          LieMonomialN--;
2307
          lordl = k = lordj;
2308
          while(k < LieMonomialN)
2309
          {
2310
            l = LIE_MONOMIAL_POSITION(++lordl); /* Shift positions */
2311
            LIE_MONOMIAL_POSITION(k++) = l;     /* of upper orders */
2312
            --LIE_MONOMIAL_ORDER(l); /* Decrease orders of upper monomials */
2313
          }
2314
        }
2315
        lordj--;
2316
      }
2317
      RELATION_TO_BE_SUBSTITUTED(i) = NO;
2318
OUT_REDUCE_RELATIONS /*----------------------------------------------*/
2319
    }
2320
  while(++i < RelationN);
2321
  return i_min;
2322
}
2323

2324
/*_6_1          Pairing functions=======================================*/
2325

2326
/*=AddPairToLieMonomial=================================================
2327
 Find position in LieMonomial table for regular pair [i,j].
2328
 LieMonomialIsNew is global boolean signal:
2329
 LieMonomialIsNew == YES if pair has to be added in table,
2330
 if so, add the pair to the table,
2331
 LieMonomialIsNew == NO if pair exists already in table.
2332
 Return position for [i,j]
2333
*/
2334
int AddPairToLieMonomial(int i, int j)
2335
{
2336
  uint wt = LIE_MONOMIAL_WEIGHT(i) + LIE_MONOMIAL_WEIGHT(j);
2337
  int ijo /* left */, r /* right */, m /* middle */, ijp;
2338
IN_ADD_PAIR_TO_LIE_MONOMIAL  /*------------------------------------------*/
2339
  ijo = 0;
2340
  r = LieMonomialN - 1;
2341
  do
2342
  {
2343
    m = (ijo + r)/2;
2344
    ijp = LIE_MONOMIAL_POSITION(m);
2345

2346
    /* Compare wrt weights */
2347

2348
    if(wt > LIE_MONOMIAL_WEIGHT(ijp))
2349
      goto shift_left;
2350
    if(wt < LIE_MONOMIAL_WEIGHT(ijp))
2351
      goto shift_right;
2352

2353
    /* Equal weights: compare lexicographically */
2354

2355
    if(LIE_MONOMIAL_ORDER(i) > LIE_MONOMIAL_LEFT_ORDER(ijp))
2356
      goto shift_left;
2357
    if(LIE_MONOMIAL_ORDER(i) < LIE_MONOMIAL_LEFT_ORDER(ijp))
2358
      goto shift_right;
2359
    if(LIE_MONOMIAL_ORDER(j) > LIE_MONOMIAL_RIGHT_ORDER(ijp))
2360
      goto shift_left;
2361
    if(LIE_MONOMIAL_ORDER(j) < LIE_MONOMIAL_RIGHT_ORDER(ijp))
2362
      goto shift_right;
2363
    LieMonomialIsNew = NO;
2364
OUT_ADD_PAIR_TO_LIE_MONOMIAL_OLD  /*-------------------------------------*/
2365
    return ijp;
2366
    shift_left:
2367
    ijo = ++m;
2368
    continue;
2369
    shift_right:
2370
    r = --m;
2371
  }while(ijo <= r);
2372

2373
  /* Add new monomial to table */
2374

2375
  LieMonomialIsNew = YES;
2376
  if(LieMonomialN >= LieMonomialSize)
2377
  {
2378
    TIME_OFF;
2379
    PutStatistics();                          /* No room for new element */
2380
    Error(E_LIE_MONOMIAL_SIZE);
2381
  }
2382
  m = r = LieMonomialN++;
2383
#if defined(SPACE_STATISTICS)
2384
  if(LieMonomialN > LieMonomialMaxN)
2385
    LieMonomialMaxN = LieMonomialN;
2386
#endif
2387
  while(m > ijo)
2388
  {
2389
    ijp = LIE_MONOMIAL_POSITION(--r); /* Shift positions of upper orders */
2390
    LIE_MONOMIAL_POSITION(m--) = ijp;
2391
    ++LIE_MONOMIAL_ORDER(ijp);      /* Increase orders of upper elements */
2392
  }
2393
  while(LIE_MONOMIAL_IS_OCCUPIED(LieMonomialFreePosition))
2394
    LieMonomialFreePosition++;                   /* Search free position */
2395
  ijp = LieMonomialFreePosition++;
2396
  LIE_MONOMIAL_ORDER(ijp) = ijo;
2397
  LIE_MONOMIAL_POSITION(ijo) = ijp;  /* Parity is 1bit field: + is mod 2 */
2398
  LIE_MONOMIAL_PARITY(ijp) = LIE_MONOMIAL_PARITY(i) + LIE_MONOMIAL_PARITY(j);
2399
  LIE_MONOMIAL_LEFT(ijp) = i;
2400
  LIE_MONOMIAL_RIGHT(ijp) = j;
2401
  LIE_MONOMIAL_WEIGHT(ijp) = wt;
2402
  LIE_MONOMIAL_INDEX(ijp) = 0;              /* Set type of basis element */
2403
OUT_ADD_PAIR_TO_LIE_MONOMIAL_NEW  /*-------------------------------------*/
2404
  return ijp;
2405
}
2406
/*=MakeRelationRHSInteger============================================
2407
 Make r.h.s. of i-th relation (Integer regime)
2408
 Relation is in normalized form (no denominators, no content)
2409
*/
2410
uint MakeRelationRHSInteger(int i)
2411
{
2412
  uint c;
2413
  if((c = LIE_TERM_R(RELATION_LIE_SUM(i))) != NIL)
2414
  {
2415
    BIGINT n, cn;
2416
#if !defined(RATIONAL_FIELD)
2417
    BIGINT ln = LIE_TERM_NUMERATOR_INTEGER(RELATION_LIE_SUM(i));
2418
#endif
2419
    uint a, ea;
2420
IN_MAKE_RELATION_RHS  /*-------------------------------------------*/
2421
    /* Copy r.h.s setting negations for numerators */
2422
    a = ea = NodeLTNew();
2423
    LIE_TERM_MONOMIAL(ea) = LIE_TERM_MONOMIAL(c);
2424
    n = LIE_TERM_NUMERATOR_INTEGER(c);
2425
    INTEGER_HEAP_COPY(cn, n, i);
2426
    INTEGER_MINUS(cn);
2427
    LIE_TERM_NUMERATOR_INTEGER(ea) = cn;
2428
    if((n = LIE_TERM_DENOMINATOR_INTEGER(c)) != NULL)
2429
    {
2430
      INTEGER_HEAP_COPY(cn, n, i);
2431
      LIE_TERM_DENOMINATOR_INTEGER(ea) = cn;
2432
    }
2433
    else
2434
      LIE_TERM_DENOMINATOR_INTEGER(ea) = NULL;
2435
    while((c = LIE_TERM_R(c)) != NIL)
2436
    {
2437
      LIE_TERM_R(ea) = NodeLTNew();
2438
      ea = LIE_TERM_R(ea);
2439
      LIE_TERM_MONOMIAL(ea) = LIE_TERM_MONOMIAL(c);
2440
      n = LIE_TERM_NUMERATOR_INTEGER(c);
2441
      INTEGER_HEAP_COPY(cn, n, i);
2442
      INTEGER_MINUS(cn);
2443
      LIE_TERM_NUMERATOR_INTEGER(ea)= cn;
2444
      if((n = LIE_TERM_DENOMINATOR_INTEGER(c)) != NULL)
2445
      {
2446
        INTEGER_HEAP_COPY(cn, n, i);
2447
        LIE_TERM_DENOMINATOR_INTEGER(ea) = cn;
2448
      }
2449
      else
2450
        LIE_TERM_DENOMINATOR_INTEGER(ea) = NULL;
2451
    }
2452
#if !defined(RATIONAL_FIELD)
2453
    /* Divide by leading coefficient */
2454
    if(INTEGER_IS_NOT_UNIT(ln))
2455
    {
2456
      INTEGER_STACK_COPY(cn, ln, i);
2457
      LieSumDivInteger(a, cn);
2458
    }
2459
#endif
2460
OUT_MAKE_RELATION_RHS /*-------------------------------------------*/
2461
    return a;
2462
  }
2463
  return NIL;
2464
}
2465
/*=MakeRelationRHSParametric============================================
2466
 Make r.h.s. of i-th relation (Parametric regime)
2467
 Relation is in normalized form (no denominators, no content)
2468
*/
2469
uint MakeRelationRHSParametric(int i)
2470
{
2471
  uint a;
2472
IN_MAKE_RELATION_RHS  /*----------------------------------------------*/
2473
  if((a = LieSumCopyParametric(LIE_TERM_R(RELATION_LIE_SUM(i)))) != NIL)
2474
  {
2475
    uint lc;
2476

2477
    /* Negation */
2478

2479
    LieSumMinusParametric(a);
2480

2481
    /* Divide by leading coefficient */
2482

2483
    lc = LIE_TERM_NUMERATOR_SCALAR_SUM(RELATION_LIE_SUM(i));
2484
    if(SCALAR_SUM_IS_NOT_UNIT(lc))
2485
    {
2486
      lc = ScalarSumCopy(lc);
2487
      LieSumDivScalarSum(a, lc);
2488
    }
2489
  }
2490
OUT_MAKE_RELATION_RHS /*----------------------------------------------*/
2491
  return a;
2492
}
2493
/*=PairMonomialMonomialInteger==============================
2494
 Make regular expression from two monomials (Integer regime)
2495
 Caller ensures ORDER(i) >= ORDER(j)
2496
*/
2497
uint PairMonomialMonomialInteger(int i, int j)
2498
{
2499
  uint a;
2500
  int k;
2501
IN_PAIR_MONOMIAL_MONOMIAL  /*-----------------------------*/
2502
  if(LIE_MONOMIAL_IS_SQUARE(j))
2503
  {                          /* [i,[j,j]] = 2 [[i,j],j] */
2504
    j = LIE_MONOMIAL_LEFT(j);
2505
    a = PairMonomialMonomialInteger(i, j);
2506
    a = PairSumMonomialInteger(a, j);
2507
    if(a != NIL)
2508
    {
2509
      LIMB two[2] = {1, 2};
2510
      LieSumMultInteger(a, two);
2511
    }
2512
  }
2513
  else if(LIE_MONOMIAL_IS_SQUARE(i))
2514
  {
2515
    LIMB two[2] = {1, 2};
2516
    i = LIE_MONOMIAL_LEFT(i);
2517
    if(i == j)
2518
      a = NIL;                         /* [[i,i],i] = 0 */
2519
    else
2520
    {
2521
      if(LIE_MONOMIAL_ORDER(i) < LIE_MONOMIAL_ORDER(j))
2522
        a = PairMonomialMonomialInteger(j, i);
2523
                           /* [[i,i],j] = - 2 [[j,i],i] */
2524
      else
2525
      {
2526
        a = PairMonomialMonomialInteger(i, j);
2527
        if(LIE_MONOMIAL_IS_EVEN(j))
2528
          goto last_pairing; /* [[i,i],j] = 2 [[i,j],i] */
2529
      }       /* IS_ODD(j) -> [[i,i],j] = - 2 [[i,j],i] */
2530
      INTEGER_SET_MINUS(two);                /* 2 -> -2 */
2531
      last_pairing:
2532
      a = PairSumMonomialInteger(a, i);
2533
      if(a != NIL)
2534
        LieSumMultInteger(a, two);
2535
    }
2536
  }
2537
  else if(LIE_MONOMIAL_IS_COMMUTATOR(i) &&  /* Irregular triple */
2538
          LIE_MONOMIAL_ORDER(j) < LIE_MONOMIAL_RIGHT_ORDER(i))
2539
  {
2540
    uint b;              /* i > k > j  =>  [[i,k],j]] =	*/
2541
    k = LIE_MONOMIAL_RIGHT(i);
2542
    i = LIE_MONOMIAL_LEFT(i);
2543
    a = PairMonomialMonomialInteger(i, j);
2544
    a = PairSumMonomialInteger(a, k);    /* + [[i,j],k] */
2545
    if(LIE_MONOMIAL_IS_ODD(j) && LIE_MONOMIAL_IS_ODD(k))
2546
    {
2547
      uint c = a;                          /* - [[i,j],k] */
2548
      while(c != NIL)
2549
      {
2550
        LIE_TERM_MINUS_INTEGER(c);
2551
        c = LIE_TERM_R(c);
2552
      }
2553
    }
2554
    b = PairMonomialMonomialInteger(k, j);
2555
    b = PairSumMonomialInteger(b, i);    /* + [[k,j],i] */
2556
    if(LIE_MONOMIAL_IS_EVEN(i) ||
2557
       LIE_MONOMIAL_PARITY(j) == LIE_MONOMIAL_PARITY(k))
2558
    {
2559
      uint c = b;                          /* - [[k,j],i] */
2560
      while(c != NIL)
2561
      {
2562
        LIE_TERM_MINUS_INTEGER(c);
2563
        c = LIE_TERM_R(c);
2564
      }
2565
    }
2566
    a = LieSumAddition(a, b);
2567
  }
2568
  else if(i == j && LIE_MONOMIAL_IS_EVEN(i))
2569
    a = NIL;                    /* [i,i] = 0 for even i */
2570
  else
2571
  {                                     /* Regular pair */
2572
    k = AddPairToLieMonomial(i, j);
2573
    if(LIE_MONOMIAL_IS_LEADING(k))
2574
      a = MakeRelationRHSInteger(LIE_MONOMIAL_I_RELATION(k));
2575
    else
2576
    {
2577
      BIGINT n;
2578
      a = NodeLTNew();
2579
      LIE_TERM_MONOMIAL(a) = k;
2580
      INTEGER_HEAP_NEW(n, 2);
2581
      n[0] = n[1] = 1;
2582
      LIE_TERM_NUMERATOR_INTEGER(a) = n;
2583
      LIE_TERM_DENOMINATOR_INTEGER(a) = NULL;
2584
    }
2585
  }
2586
OUT_PAIR_MONOMIAL_MONOMIAL  /*----------------------------*/
2587
  return a;
2588
}
2589
/*=PairMonomialMonomialParametric==============================
2590
 Make regular expression from two monomials (Parametric regime)
2591
 Caller ensures i >= j by Shirshov
2592
*/
2593
uint PairMonomialMonomialParametric(int i, int j)
2594
{
2595
  uint a;
2596
  int k;
2597
IN_PAIR_MONOMIAL_MONOMIAL  /*--------------------------------*/
2598
  if(LIE_MONOMIAL_IS_SQUARE(j))
2599
  {                               /* [i,[j,j]] = 2 [[i,j],j] */
2600
    j = LIE_MONOMIAL_LEFT(j);
2601
    a = PairMonomialMonomialParametric(i, j);
2602
    a = PairSumMonomialParametric(a, j);
2603
    if(a != NIL)
2604
    {
2605
      uint two;
2606
      BIGINT n2;
2607
      INTEGER_HEAP_NEW(n2, 2);
2608
      n2[0] = 1;
2609
      n2[1] = 2;
2610
      two = NodeSTNew();
2611
      SCALAR_TERM_MONOMIAL(two) = NIL;
2612
      SCALAR_TERM_NUMERATOR(two) = n2;
2613
      LieSumMultScalarSum(a, two);
2614
    }
2615
  }
2616
  else if(LIE_MONOMIAL_IS_SQUARE(i))
2617
  {
2618
    BIGINT n2;
2619
    i = LIE_MONOMIAL_LEFT(i);
2620
    if(i == j)
2621
      a = NIL;                              /* [[i,i],i] = 0 */
2622
    else
2623
    {
2624
      INTEGER_HEAP_NEW(n2, 2);
2625
      n2[0] = 1;
2626
      n2[1] = 2;
2627
      if(LIE_MONOMIAL_ORDER(i) < LIE_MONOMIAL_ORDER(j))
2628
        a = PairMonomialMonomialParametric(j, i);
2629
                                /* [[i,i],j] = - 2 [[j,i],i] */
2630
      else
2631
      {
2632
        a = PairMonomialMonomialParametric(i, j);
2633
        if(LIE_MONOMIAL_IS_EVEN(j))
2634
          goto last_pairing;      /* [[i,i],j] = 2 [[i,j],i] */
2635
      }            /* IS_ODD(j) -> [[i,i],j] = - 2 [[i,j],i] */
2636
      INTEGER_SET_MINUS(n2);                      /* 2 -> -2 */
2637
      last_pairing:
2638
      a = PairSumMonomialParametric(a, i);
2639
      if(a != NIL)
2640
      {
2641
        uint two = NodeSTNew();
2642
        SCALAR_TERM_MONOMIAL(two) = NIL;
2643
        SCALAR_TERM_NUMERATOR(two) = n2;
2644
        LieSumMultScalarSum(a, two);
2645
      }
2646
      else
2647
        INTEGER_KILL(n2);
2648
    }
2649
  }
2650
  else if(LIE_MONOMIAL_IS_COMMUTATOR(i) &&  /* Irregular triple */
2651
          LIE_MONOMIAL_ORDER(j) < LIE_MONOMIAL_RIGHT_ORDER(i))
2652
  {
2653
    uint b;                     /* i > k > j  =>  [[i,k],j]] = */
2654
    k = LIE_MONOMIAL_RIGHT(i);
2655
    i = LIE_MONOMIAL_LEFT(i);
2656
    a = PairMonomialMonomialParametric(i, j);
2657
    a = PairSumMonomialParametric(a, k);      /* + [[i,j],k] */
2658
    if(LIE_MONOMIAL_IS_ODD(j) && LIE_MONOMIAL_IS_ODD(k))
2659
      LieSumMinusParametric(a);               /* - [[i,j],k] */
2660
    b = PairMonomialMonomialParametric(k, j);
2661
    b = PairSumMonomialParametric(b, i);      /* + [[k,j],i] */
2662
    if(LIE_MONOMIAL_IS_EVEN(i) ||
2663
       LIE_MONOMIAL_PARITY(j) == LIE_MONOMIAL_PARITY(k))
2664
      LieSumMinusParametric(b);               /* - [[k,j],i] */
2665
    a = LieSumAddition(a, b);
2666
  }
2667
  else if(i == j && LIE_MONOMIAL_IS_EVEN(i))
2668
    a = NIL;                         /* [i,i] = 0 for even i */
2669
  else
2670
  {                                          /* Regular pair */
2671
    k = AddPairToLieMonomial(i, j);
2672
    if(LIE_MONOMIAL_IS_LEADING(k))
2673
      a = MakeRelationRHSParametric(LIE_MONOMIAL_I_RELATION(k));
2674
    else
2675
    {
2676
      BIGINT n;
2677
      uint c;
2678
      a = NodeLTNew();
2679
      LIE_TERM_MONOMIAL(a) = k;
2680
      INTEGER_HEAP_NEW(n, 2);
2681
      n[0] = n[1] = 1;
2682
      c = NodeSTNew();
2683
      SCALAR_TERM_MONOMIAL(c) = NIL;
2684
      SCALAR_TERM_NUMERATOR(c) = n;
2685
      LIE_TERM_NUMERATOR_SCALAR_SUM(a) = c;
2686
      LIE_TERM_DENOMINATOR_SCALAR_SUM(a) = NIL;
2687
    }
2688
  }
2689
OUT_PAIR_MONOMIAL_MONOMIAL  /*--------------------------------*/
2690
  return a;
2691
}
2692
/*=PairMonomialSumInteger==========================================
2693

2694
 Make commutator of the form [mon, Lie_sum] (Integer regime)
2695
*/
2696
uint PairMonomialSumInteger(int mon, uint a)
2697
{
2698
  uint b, s;
2699
  BIGINT nb, db;                        /* Sum has definite parity */
2700
  int monb, change_sign = (LIE_MONOMIAL_IS_EVEN(mon) ||
2701
                      LIE_MONOMIAL_IS_EVEN(LIE_TERM_MONOMIAL(a)));
2702
IN_PAIR_MONOMIAL_SUM  /*----------------------------------------*/
2703
  s = NIL;
2704
  while(a != NIL)
2705
  {
2706
    b = a;
2707
    a = LIE_TERM_R(a);
2708
    monb = LIE_TERM_MONOMIAL(b);     /* Take full info from `b' */
2709
    nb = LIE_TERM_NUMERATOR_INTEGER(b);
2710
    db = LIE_TERM_DENOMINATOR_INTEGER(b);
2711
    NODE_LT_KILL(b);
2712
    if(mon != monb || LIE_MONOMIAL_IS_ODD(mon))
2713
    {                                       /* [mon, monb] != 0 */
2714
      if(LIE_MONOMIAL_ORDER(mon) < LIE_MONOMIAL_ORDER(monb))
2715
      {                                       /* Swap monomials */
2716
        if(change_sign)
2717
          INTEGER_MINUS(nb);
2718
        b = PairMonomialMonomialInteger(monb, mon);
2719
      }
2720
      else
2721
        b = PairMonomialMonomialInteger(mon, monb);
2722
      if(INTEGER_IS_NOT_UNIT(nb))
2723
        LieSumMultInteger(b, nb);
2724
      if(db != NULL)
2725
        LieSumDivInteger(b, db);
2726
      s = LieSumAddition(s, b);
2727
    }
2728
    INTEGER_KILL(nb);
2729
    if(db != NULL)
2730
      INTEGER_KILL(db);
2731
  }
2732
OUT_PAIR_MONOMIAL_SUM  /*---------------------------------------*/
2733
  return s;
2734
}
2735
/*=PairMonomialSumParametric======================================
2736
 Make commutator of the form [mon, Lie_sum] (Parametric regime)
2737
*/
2738
uint PairMonomialSumParametric(int mon, uint a)
2739
{
2740
  uint b, s, nb, db;                    /* Sum has definite parity */
2741
  int monb, change_sign = (LIE_MONOMIAL_IS_EVEN(mon) ||
2742
                      LIE_MONOMIAL_IS_EVEN(LIE_TERM_MONOMIAL(a)));
2743
IN_PAIR_MONOMIAL_SUM   /*---------------------------------------*/
2744
  s = NIL;
2745
  while(a != NIL)
2746
  {
2747
    b = a;
2748
    a = LIE_TERM_R(a);
2749
    monb = LIE_TERM_MONOMIAL(b);     /* Take full info from `b' */
2750
    nb = LIE_TERM_NUMERATOR_SCALAR_SUM(b);
2751
    db = LIE_TERM_DENOMINATOR_SCALAR_SUM(b);
2752
    NODE_LT_KILL(b);
2753
    if(mon != monb || LIE_MONOMIAL_IS_ODD(mon))
2754
    {                                       /* [mon, monb] != 0 */
2755
      if(LIE_MONOMIAL_ORDER(mon) < LIE_MONOMIAL_ORDER(monb))
2756
      {                                       /* Swap monomials */
2757
        if(change_sign)
2758
          ScalarSumMinus(nb);
2759
        b = PairMonomialMonomialParametric(monb, mon);
2760
      }
2761
      else
2762
        b = PairMonomialMonomialParametric(mon, monb);
2763
      if(SCALAR_SUM_IS_NOT_UNIT(nb))
2764
        LieSumMultScalarSum(b, nb);
2765
      else
2766
        ScalarSumKill(nb);
2767
      if(db != NIL)
2768
        LieSumDivScalarSum(b, db);
2769
      s = LieSumAddition(s, b);
2770
    }
2771
    else
2772
    {
2773
      ScalarSumKill(nb);
2774
      ScalarSumKill(db);
2775
    }
2776
  }
2777
OUT_PAIR_MONOMIAL_SUM  /*---------------------------------------*/
2778
  return s;
2779
}
2780
/*=PairSumMonomialInteger==========================================
2781

2782
 Make commutator of the form [Lie_sum, mon] (Integer regime)
2783
*/
2784
uint PairSumMonomialInteger(uint a, int mon)
2785
{
2786
  uint b, s;
2787
  BIGINT nb, db;                        /* Sum has definite parity */
2788
  int monb, change_sign = (LIE_MONOMIAL_IS_EVEN(mon) ||
2789
                      LIE_MONOMIAL_IS_EVEN(LIE_TERM_MONOMIAL(a)));
2790
IN_PAIR_SUM_MONOMIAL   /*---------------------------------------*/
2791
  s = NIL;
2792
  while(a != NIL)
2793
  {
2794
    b = a;
2795
    a = LIE_TERM_R(a);
2796
    monb = LIE_TERM_MONOMIAL(b);     /* Take full info from `b' */
2797
    nb = LIE_TERM_NUMERATOR_INTEGER(b);
2798
    db = LIE_TERM_DENOMINATOR_INTEGER(b);
2799
    NODE_LT_KILL(b);
2800
    if(mon != monb || LIE_MONOMIAL_IS_ODD(mon))
2801
    {                                       /* [monb, mon] != 0 */
2802
      if(LIE_MONOMIAL_ORDER(monb) < LIE_MONOMIAL_ORDER(mon))
2803
      {                                       /* Swap monomials */
2804
        if(change_sign)
2805
          INTEGER_MINUS(nb);
2806
        b = PairMonomialMonomialInteger(mon, monb);
2807
      }
2808
      else
2809
        b = PairMonomialMonomialInteger(monb, mon);
2810
      if(INTEGER_IS_NOT_UNIT(nb))
2811
        LieSumMultInteger(b, nb);
2812
      if(db != NULL)
2813
        LieSumDivInteger(b, db);
2814
      s = LieSumAddition(s, b);
2815
    }
2816
    INTEGER_KILL(nb);
2817
    if(db != NULL)
2818
      INTEGER_KILL(db);
2819
  }
2820
OUT_PAIR_SUM_MONOMIAL  /*---------------------------------------*/
2821
  return s;
2822
}
2823
/*=PairSumMonomialParametric======================================
2824
 Make commutator of the form [Lie_sum, mon] (Parametric regime)
2825
*/
2826
uint PairSumMonomialParametric(uint a, int mon)
2827
{
2828
  uint b, s, nb, db;                    /* Sum has definite parity */
2829
  int monb, change_sign = (LIE_MONOMIAL_IS_EVEN(mon) ||
2830
                      LIE_MONOMIAL_IS_EVEN(LIE_TERM_MONOMIAL(a)));
2831
IN_PAIR_SUM_MONOMIAL   /*---------------------------------------*/
2832
  s = NIL;
2833
  while(a != NIL)
2834
  {
2835
    b = a;
2836
    a = LIE_TERM_R(a);
2837
    monb = LIE_TERM_MONOMIAL(b);     /* Take full info from `b' */
2838
    nb = LIE_TERM_NUMERATOR_SCALAR_SUM(b);
2839
    db = LIE_TERM_DENOMINATOR_SCALAR_SUM(b);
2840
    NODE_LT_KILL(b);
2841
    if(mon != monb || LIE_MONOMIAL_IS_ODD(mon))
2842
    {                                       /* [monb, mon] != 0 */
2843
      if(LIE_MONOMIAL_ORDER(monb) < LIE_MONOMIAL_ORDER(mon))
2844
      {                                       /* Swap monomials */
2845
        if(change_sign)
2846
          ScalarSumMinus(nb);
2847
        b = PairMonomialMonomialParametric(mon, monb);
2848
      }
2849
      else
2850
        b = PairMonomialMonomialParametric(monb, mon);
2851
      if(SCALAR_SUM_IS_NOT_UNIT(nb))
2852
        LieSumMultScalarSum(b, nb);
2853
      else
2854
        ScalarSumKill(nb);
2855
      if(db != NIL)
2856
        LieSumDivScalarSum(b, db);
2857
      s = LieSumAddition(s, b);
2858
    }
2859
  }
2860
OUT_PAIR_SUM_MONOMIAL  /*---------------------------------------*/
2861
  return s;
2862
}
2863
/*=PairSumSumInteger======================================
2864
 Commutator of the form [Lie_sum,Lie_sum] (Integer regime)
2865
*/
2866
uint PairSumSumInteger(uint a, uint b)
2867
{
2868
IN_PAIR_SUM_SUM  /*-------------------------------------*/
2869
  if(a == NIL)
2870
    LieSumKillInteger(b);
2871
  else if(b == NIL)
2872
  {
2873
    LieSumKillInteger(a);
2874
    a = b;
2875
  }
2876
  else
2877
  {
2878
    BIGINT num, den;
2879
    uint c, d, s;
2880
    s = NIL;
2881
    do
2882
    {
2883
      c = a;
2884
      a = LIE_TERM_R(c);
2885
      d = (a != NIL) ? LieSumCopyInteger(b) : b;
2886
      d = PairMonomialSumInteger(LIE_TERM_MONOMIAL(c), d);
2887
      num = LIE_TERM_NUMERATOR_INTEGER(c);
2888
      den = LIE_TERM_DENOMINATOR_INTEGER(c);
2889
      NODE_LT_KILL(c);
2890
      if(INTEGER_IS_NOT_UNIT(num))
2891
        LieSumMultInteger(d, num);
2892
      INTEGER_KILL(num);
2893
      if(den != NULL)
2894
      {
2895
        LieSumDivInteger(d, den);
2896
        INTEGER_KILL(den);
2897
      }
2898
      s = LieSumAddition(s, d);
2899
    }while(a != NIL);
2900
    a = s;
2901
  }
2902
OUT_PAIR_SUM_SUM /*-------------------------------------*/
2903
  return a;
2904
}
2905
/*=PairSumSumParametric======================================
2906
 Commutator of the form [Lie_sum,Lie_sum] (Parametric regime)
2907
*/
2908
uint PairSumSumParametric(uint a, uint b)
2909
{
2910
IN_PAIR_SUM_SUM  /*----------------------------------------*/
2911
  if(a == NIL)
2912
    LieSumKillParametric(b);
2913
  else if(b == NIL)
2914
  {
2915
    LieSumKillParametric(a);
2916
    a = b;
2917
  }
2918
  else
2919
  {
2920
    uint num, den, c, d, s;
2921
    s = NIL;
2922
    do
2923
    {
2924
      c = a;
2925
      a = LIE_TERM_R(c);
2926
      d = (a != NIL) ? LieSumCopyParametric(b) : b;
2927
      d = PairMonomialSumParametric(LIE_TERM_MONOMIAL(c), d);
2928
      num = LIE_TERM_NUMERATOR_SCALAR_SUM(c);
2929
      den = LIE_TERM_DENOMINATOR_SCALAR_SUM(c);
2930
      NODE_LT_KILL(c);
2931
      if(SCALAR_SUM_IS_NOT_UNIT(num))
2932
        LieSumMultScalarSum(d, num);
2933
      else
2934
        ScalarSumKill(num);
2935
      if(den != NIL)
2936
        LieSumDivScalarSum(d, den);
2937
      s = LieSumAddition(s, d);
2938
    }while(a != NIL);
2939
    a = s;
2940
  }
2941
OUT_PAIR_SUM_SUM /*----------------------------------------*/
2942
  return a;
2943
}
2944

2945
/*_6_2          Substitution (replacing) functions======================*/
2946

2947
/*=IsMonomialInMonomial==========================================
2948

2949
 Check whether `mon' contains `submon'
2950
*/
2951
int IsMonomialInMonomial(int submon, int mon)
2952
{
2953
  if(LIE_MONOMIAL_ORDER(submon) > LIE_MONOMIAL_ORDER(mon))
2954
    return NO;
2955
  if(submon == mon)
2956
    return YES;
2957
  if(LIE_MONOMIAL_IS_GENERATOR(mon))
2958
    return NO;
2959
  return IsMonomialInMonomial(submon, LIE_MONOMIAL_LEFT(mon)) ||
2960
         IsMonomialInMonomial(submon, LIE_MONOMIAL_RIGHT(mon));
2961
}
2962
/*=SubstituteRelationInRelationInteger================================
2963
 R is donor and unchanged, A is acceptor and changed. Integer regime
2964
*/
2965
uint SubstituteRelationInRelationInteger(uint r, uint a)
2966
{
2967
  uint b, bl, bf, rhs;
2968
  BIGINT nb;
2969
#if defined(RATIONAL_FIELD)
2970
  BIGINT db;
2971
#endif
2972
  int lmon, monb, lord;
2973
IN_SUBSTITUTE_RELATION_IN_RELATION /*-------------------------------*/
2974
  lmon = LIE_TERM_MONOMIAL(r);
2975
  lord = LIE_MONOMIAL_ORDER(lmon);
2976
  SubstitutionIsDone = NO;
2977
  bl = NIL;
2978
  bf = b = a;
2979
  do
2980
  {
2981
    monb = LIE_TERM_MONOMIAL(b);
2982
    if(LIE_MONOMIAL_ORDER(monb) < lord)
2983
    {
2984
      if(SubstitutionIsDone)
2985
      {
2986
        a = LieSumAddition(a, bf);
2987
        LieSumKillInteger(rhs);
2988
      }
2989
      goto out;
2990
    }
2991
    if(IsMonomialInMonomial(lmon, monb))
2992
    {
2993
      if(SubstitutionIsDone == NO)        /* First substituent term */
2994
      {                                /* Make right hand side of R */
2995
        rhs = LieSumCopyIntegerNegative(LIE_TERM_R(r));
2996
#if !defined(RATIONAL_FIELD)
2997
        if(rhs != NIL)
2998
        {
2999
          nb = LIE_TERM_NUMERATOR_INTEGER(r);
3000
          if(INTEGER_IS_NOT_UNIT(nb))
3001
          {
3002
            BIGINT den;
3003
            int i;                   /* Divide by leading coefficient */
3004
            INTEGER_STACK_COPY(den, nb, i);
3005
            LieSumDivInteger(rhs, den);
3006
          }
3007
        }
3008
#endif
3009
        SubstitutionIsDone = YES;
3010
        a = NIL;
3011
      }
3012
      nb = LIE_TERM_NUMERATOR_INTEGER(b);
3013
      if((r = SubstituteRHSInMonomialInteger(monb, lmon, rhs)) != NIL)
3014
      {
3015
#if defined(RATIONAL_FIELD)                 /* Field R case compiling */
3016
        db = LIE_TERM_DENOMINATOR_INTEGER(b);
3017
        if(INTEGER_IS_UNIT(nb))
3018
        {
3019
          if(db != NULL)
3020
          {
3021
            LieSumDivInteger(r, db);
3022
            INTEGER_KILL(db);
3023
          }
3024
        }
3025
        else
3026
          if(db != NULL)
3027
          {
3028
            LieSumMultRationalInteger(r, nb, db);
3029
            INTEGER_KILL(db);
3030
          }
3031
          else
3032
            LieSumMultInteger(r, nb);
3033
#else                                         /* Ring Z case compiling */
3034
        if(INTEGER_IS_NOT_UNIT(nb))
3035
          LieSumMultInteger(r, nb);
3036
#endif
3037
        a = LieSumAddition(a, r);
3038
      }
3039
      INTEGER_KILL(nb);
3040
      if(bl != NIL)
3041
      {                /* There is substitution-free sublist before */
3042
        LIE_TERM_R(bl) = NIL;
3043
        a = LieSumAddition(a, bf);
3044
      }
3045
      bl = b;
3046
      bf = b = LIE_TERM_R(b);
3047
      NODE_LT_KILL(bl);
3048
      bl = NIL;
3049
    }
3050
    else
3051
    {                                /* Skip substitution-free term */
3052
      bl = b;
3053
      b = LIE_TERM_R(b);
3054
    }
3055
  }while(b != NIL);
3056
  if(SubstitutionIsDone)
3057
  {                                /* Append substitution-free tail */
3058
    if(bl != NIL)
3059
      a = LieSumAddition(a, bf);
3060
    LieSumKillInteger(rhs);
3061
  }
3062
  out:
3063
OUT_SUBSTITUTE_RELATION_IN_RELATION /*------------------------------*/
3064
  return a;
3065
}
3066
/*=SubstituteRelationInRelationParametric================================
3067
 R is donor and unchanged, A is acceptor and changed. Parametric regime
3068
*/
3069
uint SubstituteRelationInRelationParametric(uint r, uint a)
3070
{
3071
  uint b, bl, bf, rhs, pb;
3072
  int lmon, monb, lord;
3073
IN_SUBSTITUTE_RELATION_IN_RELATION /*----------------------------------*/
3074
  lmon = LIE_TERM_MONOMIAL(r);
3075
  lord = LIE_MONOMIAL_ORDER(lmon);
3076
  SubstitutionIsDone = NO;
3077
  bl = NIL;
3078
  bf = b = a;
3079
  do
3080
  {
3081
    monb = LIE_TERM_MONOMIAL(b);
3082
    if(LIE_MONOMIAL_ORDER(monb) < lord)
3083
    {
3084
      if(SubstitutionIsDone)
3085
      {
3086
        a = LieSumAddition(a, bf);
3087
        LieSumKillParametric(rhs);
3088
      }
3089
      goto out;
3090
    }
3091
    if(IsMonomialInMonomial(lmon, monb))
3092
    {
3093
      if(SubstitutionIsDone == NO)           /* First substituent term */
3094
      {                                   /* Make right hand side of R */
3095
        if((rhs = LieSumCopyParametric(LIE_TERM_R(r))) != NIL)
3096
        {
3097
          pb = LIE_TERM_NUMERATOR_SCALAR_SUM(r);
3098
          if(SCALAR_SUM_IS_NOT_UNIT(pb))   /* Divide by leading coeff. */
3099
            LieSumDivScalarSum(rhs, ScalarSumCopy(pb));
3100
          LieSumMinusParametric(rhs);                      /* Negation */
3101
        }
3102
        SubstitutionIsDone = YES;
3103
        a = NIL;
3104
      }
3105
      pb = LIE_TERM_NUMERATOR_SCALAR_SUM(b);
3106
      if((r = SubstituteRHSInMonomialParametric(monb, lmon, rhs)) != NIL)
3107
      {
3108
        if(SCALAR_SUM_IS_NOT_UNIT(pb))
3109
          LieSumMultScalarSum(r, pb);
3110
        else
3111
          ScalarSumKill(pb);
3112
        a = LieSumAddition(a, r);
3113
      }
3114
      if(bl != NIL)
3115
      {                   /* There is substitution-free sublist before */
3116
        LIE_TERM_R(bl) = NIL;
3117
        a = LieSumAddition(a, bf);
3118
      }
3119
      bl = b;
3120
      bf = b = LIE_TERM_R(b);
3121
      NODE_LT_KILL(bl);
3122
      bl = NIL;
3123
    }
3124
    else
3125
    {                                   /* Skip substitution-free term */
3126
      bl = b;
3127
      b = LIE_TERM_R(b);
3128
    }
3129
  }while(b != NIL);
3130
  if(SubstitutionIsDone)
3131
  {                                   /* Append substitution-free tail */
3132
    if(bl != NIL)
3133
      a = LieSumAddition(a, bf);
3134
    LieSumKillParametric(rhs);
3135
  }
3136
  out:
3137
OUT_SUBSTITUTE_RELATION_IN_RELATION /*---------------------------------*/
3138
  return a;
3139
}
3140
/*=SubstituteRHSInMonomialInteger=======================================
3141
 Insert right hand side `r' of relation with leading monomial `lmonr'
3142
 in monomial `mon'.
3143
 Returned NOTHING means "no substitution", NIL means 0.
3144
 Function saves input `r'. Integer regime.
3145
*/
3146
uint SubstituteRHSInMonomialInteger(int mon, int lmonr, uint r)
3147
{
3148
  /* Single monomial matching case */
3149

3150
  if(mon == lmonr)
3151
    return LieSumCopyInteger(r);
3152

3153
  /* Possible substitution(s) in submonomial(s) */
3154

3155
  if(LIE_MONOMIAL_ORDER(mon) > LIE_MONOMIAL_ORDER(lmonr)
3156
     && LIE_MONOMIAL_IS_COMMUTATOR(mon))
3157
  {
3158
    uint res;
3159
    int monl = LIE_MONOMIAL_LEFT(mon);
3160
    mon = LIE_MONOMIAL_RIGHT(mon);
3161
    res = SubstituteRHSInMonomialInteger(monl, lmonr, r);
3162
    if(res == NIL)
3163
      return NIL;                                     /*  [0, x] -> 0 */
3164
    {
3165
      uint resr = SubstituteRHSInMonomialInteger(mon, lmonr, r);
3166
      if(res == NOTHING)
3167
      {
3168
        if(resr == NOTHING)
3169
          return NOTHING;    /* No substitutions in both submonomials */
3170
        if(resr == NIL)
3171
          return NIL;                                  /* [x, 0] -> 0 */
3172
        return PairMonomialSumInteger(monl, resr); /* -> [monl, resr] */
3173
      }
3174
      if(resr == NOTHING)
3175
        return PairSumMonomialInteger(res, mon);     /* -> [res, mon] */
3176
      if(resr == NIL)
3177
      {
3178
        LieSumKillInteger(res);
3179
        return NIL;
3180
      }
3181
      return PairSumSumInteger(res, resr);          /* -> [res, resr] */
3182
    }
3183
  }
3184
  return NOTHING;
3185
}
3186
/*=SubstituteRHSInMonomialParametric======================================
3187
 Insert right hand side `r' of relation with leading monomial `lmonr'
3188
 in monomial `mon'.
3189
 Returned NOTHING means "no substitution", NIL means 0.
3190
 Function saves input `r'. Parametric regime.
3191
*/
3192
uint SubstituteRHSInMonomialParametric(int mon, int lmonr, uint r)
3193
{
3194
  /* Single monomial matching case */
3195

3196
  if(mon == lmonr)
3197
    return LieSumCopyParametric(r);
3198

3199
  /* Possible substitution(s) in submonomial(s) */
3200

3201
  if(LIE_MONOMIAL_ORDER(mon) > LIE_MONOMIAL_ORDER(lmonr)
3202
     && LIE_MONOMIAL_IS_COMMUTATOR(mon))
3203
  {
3204
    uint res;
3205
    int monl = LIE_MONOMIAL_LEFT(mon);
3206
    mon = LIE_MONOMIAL_RIGHT(mon);
3207
    res = SubstituteRHSInMonomialParametric(monl, lmonr, r);
3208
    if(res == NIL)
3209
      return NIL;                                        /*  [0, x] -> 0 */
3210
    {
3211
      uint resr = SubstituteRHSInMonomialParametric(mon, lmonr, r);
3212
      if(res == NOTHING)
3213
      {
3214
        if(resr == NOTHING)
3215
          return NOTHING;       /* No substitutions in both submonomials */
3216
        if(resr == NIL)
3217
          return NIL;                                     /* [x, 0] -> 0 */
3218
        return PairMonomialSumParametric(monl, resr); /* -> [monl, resr] */
3219
      }
3220
      if(resr == NOTHING)
3221
        return PairSumMonomialParametric(res, mon);     /* -> [res, mon] */
3222
      if(resr == NIL)
3223
      {
3224
        LieSumKillParametric(res);
3225
        return NIL;
3226
      }
3227
      return PairSumSumParametric(res, resr);          /* -> [res, resr] */
3228
    }
3229
  }
3230
  return NOTHING;
3231
}
3232

3233
/*_6_3		Lie and scalar algebra functions========================*/
3234

3235
/*=LieLikeTermsCollectionInteger==========================================
3236
 For Lie terms `a' and `b' sum rational integers  `na/da' and `nb/db'
3237
 destructing input terms, set nonzero result in `a', return YES for
3238
 nonzero result, otherwise kill `a' and return NO;
3239
 `da', `db'= NIL means 1.
3240
*/
3241
int LieLikeTermsCollectionInteger(uint a, uint b)
3242
{
3243
  BIGINT na, da, nb, db;
3244
  nb = LIE_TERM_NUMERATOR_INTEGER(b);
3245
  db = LIE_TERM_DENOMINATOR_INTEGER(b);
3246
  NODE_LT_KILL(b);
3247
  na = LIE_TERM_NUMERATOR_INTEGER(a);
3248
  da = LIE_TERM_DENOMINATOR_INTEGER(a);
3249
  if(da != NULL) if(db != NULL)                 /* `da' != 1, `db' != 1 */
3250
  {
3251
    BIGINT g, h;
3252
    int i;
3253
    INTEGER_STACK_COPY(g, da, i);
3254
    INTEGER_STACK_COPY(h, db, i);
3255
    if((g = IntegerGCD(g, h)) != NULL)           /* g = GCD(da, db) > 1 */
3256
    {
3257
      BIGINT k, m, daa;
3258
      INTEGER_STACK_COPY(k, g, i);                 /*  k = GCD(da, db)' */
3259
      INTEGER_STACK_NEW(m, 2+INTEGER_N_LIMBS(da)-INTEGER_N_LIMBS(k));
3260
      INTEGER_STACK_COPY_1(daa, da, i);
3261
      INTEGER_KILL(da);
3262
      IntegerQuotient(m, daa, k);               /*  m = da/GCD(da, db)' */
3263
      INTEGER_STACK_NEW(h, 1+INTEGER_N_LIMBS(nb)+INTEGER_N_LIMBS(m));
3264
      IntegerProduct(h, nb, m);             /*  h = nb*da'/GCD(da, db)' */
3265
      INTEGER_KILL(nb);
3266
      INTEGER_STACK_COPY_1(k, db, i);                       /*  k = db' */
3267
      INTEGER_STACK_COPY(da, g, i);                /* da = GCD(da, db)' */
3268
      INTEGER_STACK_NEW(nb, 2+INTEGER_N_LIMBS(k)-INTEGER_N_LIMBS(da));
3269
      IntegerQuotient(nb, k, da);              /* nb = db'/GCD(da, db)' */
3270
      INTEGER_STACK_NEW(k, 1+INTEGER_N_LIMBS(na)+INTEGER_N_LIMBS(nb));
3271
      IntegerProduct(k, na, nb);            /*  k = na*db'/GCD(da, db)' */
3272
      INTEGER_KILL(na);
3273
      INTEGER_STACK_NEW(na, 3+MAX(INTEGER_N_LIMBS(h),INTEGER_N_LIMBS(k)));
3274
      IntegerSum(na, h, k);                               /* na = h + k */
3275
      if(INTEGER_N_LIMBS(na) != 0)
3276
      {
3277
        INTEGER_STACK_COPY(h, na, i);                      /* Numerator */
3278
        if((h = IntegerGCD(h, g)) != NULL)
3279
        {
3280
          INTEGER_STACK_COPY(g, h, i);
3281
          INTEGER_HEAP_NEW(k, 2+INTEGER_N_LIMBS(na)-INTEGER_N_LIMBS(g));
3282
          IntegerQuotient(k, na, g);
3283
          LIE_TERM_NUMERATOR_INTEGER(a) = k;
3284
          INTEGER_STACK_NEW(k, 2+INTEGER_N_LIMBS(db)-INTEGER_N_LIMBS(h));
3285
          INTEGER_STACK_COPY_1(daa, db, i);
3286
          INTEGER_KILL(db);
3287
          IntegerQuotient(k, daa, h);
3288
          INTEGER_HEAP_NEW(db, 1+INTEGER_N_LIMBS(m)+INTEGER_N_LIMBS(k));
3289
          IntegerProduct(db, m, k);
3290
          if(INTEGER_IS_UNIT(db))
3291
          {
3292
            INTEGER_KILL(db);
3293
            db = NULL;     /* Standard convention for unit denominators */
3294
          }
3295
          LIE_TERM_DENOMINATOR_INTEGER(a) = db;
3296
        }
3297
        else
3298
        {
3299
          INTEGER_HEAP_COPY(h, na, i);
3300
          LIE_TERM_NUMERATOR_INTEGER(a) = h;
3301
          INTEGER_HEAP_NEW(k, 1+INTEGER_N_LIMBS(m)+INTEGER_N_LIMBS(db));
3302
          IntegerProduct(k, m, db);
3303
          INTEGER_KILL(db);
3304
          if(INTEGER_IS_UNIT(k))
3305
          {
3306
            INTEGER_KILL(k);
3307
            k = NULL;      /* Standard convention for unit denominators */
3308
          }
3309
          LIE_TERM_DENOMINATOR_INTEGER(a) = k;
3310
        }
3311
        goto non_zero;
3312
      }
3313
      else
3314
      {
3315
        INTEGER_KILL(db);
3316
        goto zero;
3317
      }
3318
    }
3319
    else                                       /* Mutually prime da, db */
3320
    {
3321
      INTEGER_STACK_NEW(g, 1+INTEGER_N_LIMBS(nb)+INTEGER_N_LIMBS(da));
3322
      IntegerProduct(g, nb, da);                           /* g = nb*da */
3323
      INTEGER_KILL(nb);
3324
      INTEGER_STACK_NEW(nb, 1+INTEGER_N_LIMBS(na)+INTEGER_N_LIMBS(db));
3325
      IntegerProduct(nb, na, db);                         /* nb = na*db */
3326
      INTEGER_KILL(na);
3327
      INTEGER_HEAP_NEW(na, 2+MAX(INTEGER_N_LIMBS(nb),INTEGER_N_LIMBS(g)));
3328
      IntegerSum(na, nb, g);                      /* na = nb*da + na*db */
3329
      if(INTEGER_N_LIMBS(na) != 0)
3330
      {
3331
        LIE_TERM_NUMERATOR_INTEGER(a) = na;
3332
        INTEGER_HEAP_NEW(nb, 1+INTEGER_N_LIMBS(da)+INTEGER_N_LIMBS(db));
3333
        IntegerProduct(nb, da, db);                       /* nb = da*db */
3334
        LIE_TERM_DENOMINATOR_INTEGER(a) = nb;
3335
        INTEGER_KILL(da);
3336
        INTEGER_KILL(db);
3337
        goto non_zero;
3338
      }
3339
      else
3340
      {
3341
        INTEGER_KILL(na);
3342
        INTEGER_KILL(da);
3343
        INTEGER_KILL(db);
3344
        goto zero;
3345
      }
3346
    }
3347
  }
3348
  else                                           /* `da' != 1, `db' = 1 */
3349
  {
3350
    INTEGER_STACK_NEW(db, 1+INTEGER_N_LIMBS(nb)+INTEGER_N_LIMBS(da));
3351
    IntegerProduct(db, nb, da);
3352
    INTEGER_KILL(nb);
3353
    INTEGER_HEAP_NEW(nb, 2+MAX(INTEGER_N_LIMBS(db),INTEGER_N_LIMBS(na)));
3354
    IntegerSum(nb, db, na);
3355
    INTEGER_KILL(na);
3356
    LIE_TERM_NUMERATOR_INTEGER(a) = nb;
3357
    goto non_zero;
3358
  }
3359
  else if(db != NULL)                            /* `da' = 1, `db' != 1 */
3360
  {
3361
    INTEGER_STACK_NEW(da, 1+INTEGER_N_LIMBS(na)+INTEGER_N_LIMBS(db));
3362
    IntegerProduct(da, na, db);
3363
    INTEGER_KILL(na);
3364
    INTEGER_HEAP_NEW(na, 2+MAX(INTEGER_N_LIMBS(da),INTEGER_N_LIMBS(nb)));
3365
    IntegerSum(na, da, nb);
3366
    INTEGER_KILL(nb);
3367
    LIE_TERM_NUMERATOR_INTEGER(a) = na;
3368
    LIE_TERM_DENOMINATOR_INTEGER(a) = db;
3369
    goto non_zero;
3370
  }
3371
  else                                               /* `da' = `db' = 1 */
3372
  {
3373
    INTEGER_HEAP_NEW(da, 2+MAX(INTEGER_N_LIMBS(na),INTEGER_N_LIMBS(nb)));
3374
    IntegerSum(da, na, nb);
3375
    INTEGER_KILL(na);
3376
    INTEGER_KILL(nb);
3377
    if(INTEGER_N_LIMBS(da) != 0)
3378
    {
3379
      LIE_TERM_NUMERATOR_INTEGER(a) = da;
3380
      goto non_zero;
3381
    }
3382
    else
3383
    {
3384
      INTEGER_KILL(da);
3385
      goto zero;
3386
    }
3387
  }
3388
  non_zero:
3389
  return YES;
3390
  zero:
3391
  NODE_LT_KILL(a);                                   /* `na' + `nb' = 0 */
3392
  return NO;
3393
}
3394
/*=LieLikeTermsCollectionParametric=======================================
3395
 For Lie terms `a' and `b' sum rational functions  `na/da' and `nb/db'
3396
 destructing input terms, set nonzero result in `a', return YES for
3397
 nonzero result, otherwise kill `a' and return NO;
3398
 `da', `db'= NIL means 1.
3399
*/
3400
int LieLikeTermsCollectionParametric(uint a, uint b)
3401
{
3402
  uint na, da, nb, db;
3403
  nb = LIE_TERM_NUMERATOR_SCALAR_SUM(b);
3404
  db = LIE_TERM_DENOMINATOR_SCALAR_SUM(b);
3405
  NODE_LT_KILL(b);
3406
  na = LIE_TERM_NUMERATOR_SCALAR_SUM(a);
3407
  da = LIE_TERM_DENOMINATOR_SCALAR_SUM(a);
3408
  if(da != NIL) if(db != NIL)                /* `da' != 1 and `db' != 1 */
3409
  {
3410
    uint g;
3411
    if((g = PolyGCD(da, db)) != NIL)            /* g = GCD(da, db) != 1 */
3412
    {
3413
      da = PolyQuotient(da, g);                /*  da' = da/GCD(da, db) */
3414
                                                       /*  nb' = nb*da' */
3415
      nb = ScalarSumMultiplication(nb, ScalarSumCopy(da));
3416
                                            /*  na' = na*db/GCD(da, db) */
3417
      na = ScalarSumMultiplication(na, PolyQuotient(ScalarSumCopy(db), g));
3418
      na = ScalarSumAddition(na, nb);               /* na'' = na' + nb' */
3419
      if(na != NIL)
3420
      {
3421
        if((nb = PolyGCD(na, g)) != NIL)
3422
        {                                      /* Set na''/GCD(na'', g) */
3423
          LIE_TERM_NUMERATOR_SCALAR_SUM(a) = PolyQuotient(na, nb);
3424
          db = PolyQuotient(db, nb);           /* db' = db/GCD(na'', g) */
3425
          ScalarSumKill(nb);                       /* Kill GCD(na'', g) */
3426
        }
3427
        else
3428
          LIE_TERM_NUMERATOR_SCALAR_SUM(a) = na;
3429
        ScalarSumKill(g);                           /* Kill GCD(da, db) */
3430
        da = ScalarSumMultiplication(da, db);
3431
        if(SCALAR_SUM_IS_UNIT(da))
3432
        {
3433
          ScalarSumKill(da);
3434
          da = NIL;
3435
        }
3436
        LIE_TERM_DENOMINATOR_SCALAR_SUM(a) = da;
3437
        goto non_zero;
3438
      }
3439
      ScalarSumKill(g);             /* Nontrivial g at na == NIL branch */
3440
    }
3441
    else                                       /* Mutually prime da, db */
3442
    {                                          /* na' = na*db' + nb*da' */
3443
      na = ScalarSumAddition(ScalarSumMultiplication(na, ScalarSumCopy(db)),
3444
                             ScalarSumMultiplication(nb, ScalarSumCopy(da)));
3445
      if(na != NIL)
3446
      {
3447
        LIE_TERM_NUMERATOR_SCALAR_SUM(a) = na;
3448
        LIE_TERM_DENOMINATOR_SCALAR_SUM(a) = ScalarSumMultiplication(da, db);
3449
        goto non_zero;
3450
      }
3451
    }
3452
    ScalarSumKill(da);                              /* na == NIL branch */
3453
    ScalarSumKill(db);
3454
    goto zero;
3455
  }
3456
  else                   /* `da' != 1 and `db' = 1 --> (na + nb*da')/da */
3457
  {
3458
    LIE_TERM_NUMERATOR_SCALAR_SUM(a) =
3459
      ScalarSumAddition(na, ScalarSumMultiplication(nb, ScalarSumCopy(da)));
3460
    goto non_zero;
3461
  }
3462
  else if(db != NIL)     /* `da' = 1 and `db' != 1 --> (nb + na*db')/db */
3463
  {
3464
    LIE_TERM_NUMERATOR_SCALAR_SUM(a) =
3465
      ScalarSumAddition(nb, ScalarSumMultiplication(na, ScalarSumCopy(db)));
3466
    LIE_TERM_DENOMINATOR_SCALAR_SUM(a) = db;
3467
    goto non_zero;
3468
  }
3469
  else if((na = ScalarSumAddition(na, nb)) != NIL)
3470
  {                           /* `da' = `db' = 1 --> (na + nb)/1 (!= 0) */
3471
    LIE_TERM_NUMERATOR_SCALAR_SUM(a) = na;
3472
    goto non_zero;
3473
  }
3474
  zero:
3475
  NODE_LT_KILL(a);  /* `na' + `nb' = 0 */
3476
  return NO;
3477
  non_zero:
3478
  return YES;
3479
}
3480
/*=LieSumAddition=============================================
3481
 Sum of two Lie expressions
3482
*/
3483
uint LieSumAddition(uint a, uint b)
3484
{
3485
  uint sum = NIL, last, wa, wb;
3486
IN_LIE_SUM_ADDITION /*---------------------------------------*/
3487
  while(YES)
3488
  {
3489
    next_pair:
3490
    if(b == NIL)
3491
    {                   /* List b is ended, append rest of a */
3492
      if(sum == NIL)
3493
        sum = a;
3494
      else
3495
        LIE_TERM_R(last) = a;
3496
      break;
3497
    }
3498
    if(a == NIL)
3499
    {                   /* List a is ended, append rest of b */
3500
      if(sum == NIL)
3501
        sum = b;
3502
      else
3503
        LIE_TERM_R(last) = b;
3504
      break;
3505
    }
3506

3507
    /* Compare algebra terms */
3508

3509
    if(LIE_TERM_MONOMIAL_ORDER(a) > LIE_TERM_MONOMIAL_ORDER(b))
3510
      goto order_12;
3511
    if(LIE_TERM_MONOMIAL_ORDER(a) < LIE_TERM_MONOMIAL_ORDER(b))
3512
      goto order_21;
3513

3514
    /* Reduce like algebra terms */
3515

3516
    wa = a;
3517
    wb = b;
3518
    a = LIE_TERM_R(a);
3519
    b = LIE_TERM_R(b);
3520

3521
        /* Sum rational coefficients */
3522

3523
    if((*LieLikeTermsCollection)(wa, wb))
3524
      goto append_term;
3525
    else
3526
      goto next_pair;
3527

3528
    order_12:
3529
    wa = a;
3530
    a = LIE_TERM_R(a);
3531
    goto append_term;
3532

3533
    order_21:
3534
    wa = b;
3535
    b = LIE_TERM_R(b);
3536

3537
    append_term:
3538
    if(sum == NIL)
3539
      sum = wa;
3540
    else
3541
      LIE_TERM_R(last) = wa;
3542
    last = wa;
3543
  }
3544
OUT_LIE_SUM_ADDITION /*--------------------------------------*/
3545
  return sum;
3546
}
3547
/*=LieSumDivInteger=======================================================
3548
 Divide Lie sum by integer (of unknown nature) on spot in Integer regime
3549
 Integer `den' is spoiled
3550
*/
3551
void LieSumDivInteger(uint lsum, BIGINT den)
3552
{
3553
  if(lsum != NIL)
3554
  {
3555
    BIGINT d, da, dao;
3556
    int i, n;
3557
    uint a;
3558
IN_LIE_SUM_DIV_INTEGER  /*----------------------------------------------*/
3559
    n = INTEGER_N_LIMBS(den);
3560
    INTEGER_STACK_NEW(d, 1+n);          /* Space for copies input `den' */
3561
    do
3562
    {
3563
      a = lsum;
3564
      lsum = LIE_TERM_R(lsum);
3565
      if(lsum != NIL)
3566
      {
3567
        i = n;
3568
        do
3569
          d[i] = den[i];
3570
        while(i--);
3571
      }
3572
      else
3573
        d = den;
3574
      IntegerCancellation(LIE_TERM_NUMERATOR_INTEGER(a), d);
3575
      if(INTEGER_IS_NOT_UNIT(d))
3576
      {
3577
        if((dao = LIE_TERM_DENOMINATOR_INTEGER(a)) != NULL)
3578
        {                           /* Nontrivial old denominator `dao' */
3579
          INTEGER_HEAP_NEW(da, 1+INTEGER_N_LIMBS(d)+INTEGER_N_LIMBS(dao));
3580
          IntegerProduct(da, d, dao);
3581
          INTEGER_KILL(dao);
3582
        }
3583
        else
3584
        {
3585
          INTEGER_HEAP_COPY(da, d, i); /* Composite statement */
3586
        }
3587
        LIE_TERM_DENOMINATOR_INTEGER(a) = da;
3588
      }
3589
    }while(lsum != NIL);
3590
OUT_LIE_SUM_DIV_INTEGER  /*---------------------------------------------*/
3591
  }
3592
}
3593
/*=LieSumDivScalarSum======================================
3594
 Divide Lie sum by scalar sum on spot in Parametric regime
3595
 `den' is killed
3596
*/
3597
void LieSumDivScalarSum(uint lsum, uint den)
3598
{
3599
  if(lsum == NIL)
3600
    ScalarSumKill(den);
3601
  else
3602
  {
3603
    uint n, d, a;
3604
IN_LIE_SUM_DIV_SCALAR_SUM /*-----------------------------*/
3605
    do
3606
    {
3607
      a = lsum;
3608
      lsum = LIE_TERM_R(lsum);
3609
      d = (lsum != NIL) ? ScalarSumCopy(den) : den;
3610
      n = LIE_TERM_NUMERATOR_SCALAR_SUM(a);
3611
      ScalarSumCancellation(&n, &d);
3612
      LIE_TERM_NUMERATOR_SCALAR_SUM(a) = n;
3613
      if(SCALAR_SUM_IS_NOT_UNIT(d))
3614
      {
3615
        if((n = LIE_TERM_DENOMINATOR_SCALAR_SUM(a)) != NIL)
3616
          d = ScalarSumMultiplication(d, n);   /* Absorb */
3617
        LIE_TERM_DENOMINATOR_SCALAR_SUM(a) = d;
3618
      }
3619
      else
3620
        ScalarSumKill(d);                   /* Kill unit */
3621
    }while(lsum != NIL);
3622
OUT_LIE_SUM_DIV_SCALAR_SUM /*----------------------------*/
3623
  }
3624
}
3625
/*=LieSumMinusInteger====================
3626
 Change signs in Lie sum (Integer regime)
3627
*/
3628
void LieSumMinusInteger(uint a)
3629
{
3630
  while(a != NIL)
3631
  {
3632
    LIE_TERM_MINUS_INTEGER(a);
3633
    a = LIE_TERM_R(a);
3634
  }
3635
}
3636

3637
/*=LieSumMinusParametric====================
3638
 Change signs in Lie sum (Parametric regime)
3639
*/
3640
void LieSumMinusParametric(uint a)
3641
{
3642
  uint b;
3643
  while(a != NIL)
3644
  {
3645
    b = LIE_TERM_NUMERATOR_SCALAR_SUM(a);
3646
    do
3647
      SCALAR_TERM_MINUS(b);
3648
    while((b = SCALAR_TERM_R(b)) != NIL);
3649
    a = LIE_TERM_R(a);
3650
  }
3651
}
3652
/*=LieSumMultInteger=======================================================
3653
 Multiply Lie sum by integer (of unknown nature) on spot in Integer regime
3654
 Integer `num' is spoiled
3655
*/
3656
void LieSumMultInteger(uint lsum, BIGINT num)
3657
{
3658
  if(lsum != NIL)
3659
  {
3660
    BIGINT nw, nao, da;
3661
    int i, n;
3662
    uint a;
3663
IN_LIE_SUM_MULT_INTEGER  /*----------------------------------------------*/
3664
    n = INTEGER_N_LIMBS(num);
3665
    INTEGER_STACK_NEW(nw, 1+n);       /* Space for copies of input `num' */
3666
    do
3667
    {
3668
      a = lsum;
3669
      lsum = LIE_TERM_R(lsum);
3670
      nao = LIE_TERM_NUMERATOR_INTEGER(a);        /* Old numerator `nao' */
3671
      if((da = LIE_TERM_DENOMINATOR_INTEGER(a)) != NULL)
3672
      {                                   /* Nontrivial denominator `da' */
3673
        if(lsum != NIL)
3674
        {                                            /* Copy if not last */
3675
          i = n;
3676
          do
3677
            nw[i] = num[i];
3678
          while(i--);
3679
        }
3680
        else
3681
          nw = num;
3682
        IntegerCancellation(nw, da);
3683
        if(INTEGER_IS_UNIT(da))
3684
        {                                 /* Trivialize unit denominator */
3685
          INTEGER_KILL(da);
3686
          LIE_TERM_DENOMINATOR_INTEGER(a) = NULL;
3687
        }
3688
        if(INTEGER_IS_NOT_UNIT(nw))
3689
        {
3690
          INTEGER_HEAP_NEW(da, 1+INTEGER_N_LIMBS(nw)+INTEGER_N_LIMBS(nao));
3691
          IntegerProduct(da, nw, nao);
3692
          goto stick_new;
3693
        }
3694
      }
3695
      else
3696
      {
3697
        INTEGER_HEAP_NEW(da, 1+INTEGER_N_LIMBS(num)+INTEGER_N_LIMBS(nao));
3698
        IntegerProduct(da, num, nao);
3699
        stick_new:
3700
        INTEGER_KILL(nao);
3701
        LIE_TERM_NUMERATOR_INTEGER(a) = da;
3702
      }
3703
    }while(lsum != NIL);
3704
OUT_LIE_SUM_MULT_INTEGER /*----------------------------------------------*/
3705
  }
3706
}
3707
#if defined(RATIONAL_FIELD)
3708
/*=LieSumMultRationalInteger=============================================
3709
 num and den are non-NULL integers of unknown nature
3710
*/
3711
void LieSumMultRationalInteger(int a, BIGINT num, BIGINT den)
3712
{
3713
  BIGINT  numc, denc, numa, dena, w;
3714
  int i, nn = INTEGER_N_LIMBS(num), nd = INTEGER_N_LIMBS(den);
3715
  INTEGER_STACK_NEW(numc, 1+nn);
3716
  INTEGER_STACK_NEW(denc, 1+nd);
3717
  while(a != NIL)
3718
  {
3719
    for(i = 0; i <= nn; i++)                   /* Copy input numerator */
3720
      numc[i] = num[i];
3721
    if((dena = LIE_TERM_DENOMINATOR_INTEGER(a)) != NULL)
3722
    {                                                         /* n1/d2 */
3723
      IntegerCancellation(numc, dena);
3724
      if(INTEGER_IS_UNIT(dena))
3725
      {
3726
        INTEGER_KILL(dena);
3727
        dena = NULL;
3728
      }
3729
    }
3730
    numa = LIE_TERM_NUMERATOR_INTEGER(a);
3731
    for(i = 0; i <= nd; i++)               /* Copy input denominator */
3732
      denc[i] = den[i];
3733
    IntegerCancellation(numa, denc);                        /* n2/d1 */
3734
    INTEGER_HEAP_NEW(w, 1+INTEGER_N_LIMBS(numc)+INTEGER_N_LIMBS(numa));
3735
    IntegerProduct(w, numc, numa);                            /* n1*n2 */
3736
    INTEGER_KILL(numa);
3737
    LIE_TERM_NUMERATOR_INTEGER(a) = w;
3738
    if(INTEGER_IS_UNIT(denc))
3739
       if(dena == NULL)
3740
         w = NULL;                                              /* 1*1 */
3741
       else
3742
       {                            /* Copy to avoid garbage tail in w */
3743
         INTEGER_HEAP_COPY(w, dena, i);                        /* 1*d2 */
3744
         INTEGER_KILL(dena);
3745
       }
3746
    else if(dena == NULL)
3747
    {
3748
      INTEGER_HEAP_COPY(w, denc, i);                           /* d1*1 */
3749
    }
3750
    else
3751
    {
3752
      INTEGER_HEAP_NEW(w, 1+INTEGER_N_LIMBS(denc)+INTEGER_N_LIMBS(dena));
3753
      IntegerProduct(w, denc, dena);                          /* d1*d2 */
3754
      INTEGER_KILL(dena);
3755
    }
3756
    LIE_TERM_DENOMINATOR_INTEGER(a) = w;
3757
    a = LIE_TERM_R(a);
3758
  }
3759
}
3760
#endif
3761
/*=LieSumMultScalarSum===============================================
3762
 Multiply Lie sum by scalar sum on spot in Parametric regime
3763
 `num' is killed
3764
*/
3765
void LieSumMultScalarSum(uint lsum, uint num)
3766
{
3767
  if(lsum == NIL)
3768
    ScalarSumKill(num);
3769
  else
3770
  {
3771
    uint n, d, a;
3772
IN_LIE_SUM_MULT_SCALAR_SUM /*--------------------------------------*/
3773
    do
3774
    {
3775
      a = lsum;
3776
      lsum = LIE_TERM_R(lsum);
3777
      n = (lsum != NIL) ? ScalarSumCopy(num) : num;
3778
      if((d = LIE_TERM_DENOMINATOR_SCALAR_SUM(a)) != NIL)
3779
      {
3780
        ScalarSumCancellation(&n, &d);
3781
        if(SCALAR_SUM_IS_UNIT(d))
3782
        {
3783
          ScalarSumKill(d);                           /* Kill unit */
3784
          d = NIL;
3785
        }
3786
        LIE_TERM_DENOMINATOR_SCALAR_SUM(a) = d;
3787
      }
3788
      LIE_TERM_NUMERATOR_SCALAR_SUM(a) =
3789
        ScalarSumMultiplication(LIE_TERM_NUMERATOR_SCALAR_SUM(a), n);
3790
    }while(lsum != NIL);
3791
OUT_LIE_SUM_MULT_SCALAR_SUM /*-------------------------------------*/
3792
  }
3793
}
3794
/*=NormalizeRelationInteger================================================
3795
 Normalize sign, remove GCD of integer numerators,
3796
 remove denominators for non-NIL relation
3797
*/
3798
void NormalizeRelationInteger(uint a)
3799
{
3800
  uint b;
3801
  BIGINT n2, n1 = LIE_TERM_NUMERATOR_INTEGER(a);
3802
IN_NORMALIZE_RELATION   /*-----------------------------------------------*/
3803
  /* Normalize sign */
3804

3805
  if(INTEGER_IS_NEGATIVE(n1))
3806
  {
3807
    INTEGER_SET_PLUS(n1);
3808
    b = LIE_TERM_R(a);
3809
    while(b != NIL)
3810
    {
3811
      INTEGER_MINUS(LIE_TERM_NUMERATOR_INTEGER(b));
3812
      b = LIE_TERM_R(b);
3813
    }
3814
  }
3815
#if defined(RATIONAL_FIELD)         /* Field R case compiling */
3816
  n2 = LIE_TERM_DENOMINATOR_INTEGER(a);
3817
  if(INTEGER_IS_UNIT(n1))  /* Either 1 (nothing to do or 1/n2 */
3818
  {
3819
    if(n2 != NULL)        /* Leading coefficient in form 1/n2 */
3820
    {
3821
      LIE_TERM_DENOMINATOR_INTEGER(a) = NULL;
3822
      LieSumMultInteger(LIE_TERM_R(a), n2);
3823
      INTEGER_KILL(n2);              /* Free spoiled array n2 */
3824
    }
3825
  }
3826
  else           /* Leading coefficient is either n1 or n1/n2 */
3827
  {
3828
    if(n2 != NULL)
3829
    {
3830
      LIE_TERM_DENOMINATOR_INTEGER(a) = NULL;
3831
      LieSumMultRationalInteger(LIE_TERM_R(a), n2, n1);
3832
      INTEGER_KILL(n2);              /* Free spoiled array n2 */
3833
    }
3834
    else                    /* Leading coefficient in form n1 */
3835
      LieSumDivInteger(LIE_TERM_R(a), n1);
3836
    n1[0] = n1[1] = 1;    /* Set big number unit in old array */
3837
  }
3838
#else                                /* Ring Z case compiling */
3839
  {
3840
    BIGINT gcd;
3841
    int i;
3842

3843
    /* Remove GCD of numerators */
3844

3845
    if(INTEGER_IS_UNIT(n1))
3846
      goto kill_denominators;
3847
    INTEGER_STACK_COPY(gcd, n1, i);
3848
    b = LIE_TERM_R(a);
3849
    while(b != NIL)
3850
    {
3851
      n1 = LIE_TERM_NUMERATOR_INTEGER(b);
3852
      if(INTEGER_IS_UNIT_ABS(n1))
3853
        goto kill_denominators;
3854
      INTEGER_HEAP_COPY(n2, n1, i);                /* Working heap integer */
3855
      gcd = IntegerGCD(gcd, n2);
3856
      INTEGER_KILL(n2);                               /* Free heap integer */
3857
      if(gcd == NULL)
3858
        goto kill_denominators;
3859
      b = LIE_TERM_R(b);
3860
    }
3861
    LieSumDivInteger(a, gcd);
3862

3863
    /* Remove denominators */
3864

3865
    kill_denominators:
3866
    b = a;
3867
    do
3868
      if(LIE_TERM_DENOMINATOR_INTEGER(b) != NULL)
3869
      {
3870
        BIGINT n3, n4, lcm;
3871

3872
        /* Make first LCM */
3873

3874
        n1 = LIE_TERM_DENOMINATOR_INTEGER(b);
3875
        INTEGER_HEAP_COPY(lcm, n1, i);
3876
        while((b = LIE_TERM_R(b)) != NIL)
3877
          if((n1 = LIE_TERM_DENOMINATOR_INTEGER(b)) != NULL)
3878
          {
3879
            /* Make copy of previous LCM */
3880

3881
            INTEGER_HEAP_COPY(n3, lcm, i);
3882

3883
            /* Make 2 copies of current denominator */
3884

3885
            INTEGER_HEAP_COPY_DOUBLE_1(n2, n4, n1, i);
3886

3887
            /* GCD of LCM and current denominator (stored in `n3') */
3888

3889
            gcd = IntegerGCD(n3, n4);
3890
            INTEGER_KILL(n4);
3891

3892
            /* Divide current denominator by GCD */
3893

3894
            if(gcd != NULL)
3895
            {
3896
              INTEGER_HEAP_NEW(n1, 2+INTEGER_N_LIMBS(n2)-INTEGER_N_LIMBS(gcd));
3897
              IntegerQuotient(n1, n2, gcd);
3898
              INTEGER_KILL(n2);
3899
            }
3900
            else
3901
              n1 = n2;
3902
            INTEGER_KILL(n3);
3903

3904
            /* New LCM */
3905

3906
            n2 = lcm;
3907
            INTEGER_HEAP_NEW(lcm, 1+INTEGER_N_LIMBS(n1)+INTEGER_N_LIMBS(n2));
3908
            IntegerProduct(lcm, n1, n2);
3909
            INTEGER_KILL(n2);
3910
            INTEGER_KILL(n1);
3911
          }
3912

3913
        /* Kill denominators */
3914

3915
        LieSumMultInteger(a, lcm);
3916
        INTEGER_KILL(lcm);
3917
        break;
3918
      }
3919
    while((b = LIE_TERM_R(b)) != NIL);
3920
  }
3921
#endif
3922
OUT_NORMALIZE_RELATION   /*----------------------------------------------*/
3923
}
3924
/*=NormalizeRelationParametric===========================================
3925
 Normalize sign, remove GCD of polynomial numerators, remove denominators
3926
 for non-NIL relation, set in table common factor and leading coefficient
3927
*/
3928
void NormalizeRelationParametric(uint a)
3929
{
3930
  uint b, c = LIE_TERM_NUMERATOR_SCALAR_SUM(a), d, e;
3931
IN_NORMALIZE_RELATION   /*---------------------------------------------*/
3932

3933
  /* Normalize sign */
3934

3935
  if(INTEGER_IS_NEGATIVE(SCALAR_TERM_NUMERATOR(c)))
3936
    LieSumMinusParametric(a);
3937

3938
  /* Remove GCD of numerators */
3939

3940
  if(SCALAR_SUM_IS_UNIT(c))
3941
    goto kill_denominators;
3942
  b = LIE_TERM_R(a);
3943
  c = ScalarSumCopy(c);
3944
  while(b != NIL)
3945
  {
3946
    d = LIE_TERM_NUMERATOR_SCALAR_SUM(b);
3947
    if(SCALAR_SUM_IS_UNIT_ABS(d))
3948
    {
3949
      ScalarSumKill(c);
3950
      goto kill_denominators;
3951
    }
3952
    e = c;
3953
    c = PolyGCD(e, d);
3954
    ScalarSumKill(e);                     /* Kill old GCD */
3955
    if(c == NIL)
3956
      goto kill_denominators;
3957
    b = LIE_TERM_R(b);
3958
  }
3959
  if(NonZeroCoefficientsPut)
3960
    InCoeffTable(ScalarSumCopy(c));
3961
  LieSumDivScalarSum(a, c);
3962

3963
  /* Remove denominators */
3964

3965
  kill_denominators:
3966
  b = a;
3967
  do
3968
    if(LIE_TERM_DENOMINATOR_SCALAR_SUM(b) != NIL)
3969
    {
3970

3971
      /* Make first LCM */
3972

3973
      c = ScalarSumCopy(LIE_TERM_DENOMINATOR_SCALAR_SUM(b));
3974
      while((b = LIE_TERM_R(b)) != NIL)
3975
        if((d = LIE_TERM_DENOMINATOR_SCALAR_SUM(b)) != NIL)
3976
        {
3977
          /* GCD of LCM and current denominator */
3978

3979
          e = PolyGCD(c, d);
3980

3981
          /* Divide current denominator by GCD */
3982

3983
          d = ScalarSumCopy(d);
3984
          if(e != NIL)
3985
          {
3986
            d = PolyQuotient(d, e);
3987
            ScalarSumKill(e);
3988
          }
3989

3990
          /* New LCM */
3991

3992
          c = ScalarSumMultiplication(c, d);
3993
        }
3994

3995
      /* Kill denominators */
3996

3997
      LieSumMultScalarSum(a, c);
3998
      if(NonZeroCoefficientsPut)
3999
        InCoeffTable(ScalarSumCopy(LIE_TERM_NUMERATOR_SCALAR_SUM(a)));
4000
      break;
4001
    }
4002
  while((b = LIE_TERM_R(b)) != NIL);
4003
OUT_NORMALIZE_RELATION   /*--------------------------------------------*/
4004
}
4005
/*=ScalarMonomialMultiplication============================================
4006
*/
4007
uint ScalarMonomialMultiplication(int *pchange_sign, uint ma, uint mb)
4008
{
4009
  uint mc, wa, wb, last;
4010
  *pchange_sign = NO;
4011
  mc = NIL;
4012
  while(YES)
4013
  {
4014
    next_pair:
4015
    if(mb == NIL)
4016
    {                             /* List mb is ended, append rest of ma */
4017
      if(mc == NIL)
4018
        mc = ma;
4019
      else
4020
        SCALAR_FACTOR_R(last) = ma;
4021
      break;
4022
    }
4023
    if(ma == NIL)
4024
    {                             /* List ma is ended, append rest of mb */
4025
      if(mc == NIL)
4026
        mc = mb;
4027
      else
4028
        SCALAR_FACTOR_R(last) = mb;
4029
      break;
4030
    }
4031

4032
    /* Compare scalar factors */
4033

4034
    if(SCALAR_FACTOR_PARAMETER(ma) > SCALAR_FACTOR_PARAMETER(mb))
4035
      goto order_12;
4036
    if(SCALAR_FACTOR_PARAMETER(ma) < SCALAR_FACTOR_PARAMETER(mb))
4037
      goto order_21;
4038

4039
    /* Reduce like factors */
4040

4041
    wa = ma;
4042
    wb = mb;
4043
    ma = SCALAR_FACTOR_R(ma);
4044
    mb = SCALAR_FACTOR_R(mb);
4045
    if(SCALAR_FACTOR_IS_I_NUMBER(wa))       /* Imaginary unit i*i --> -1 */
4046
    {
4047
      NODE_SF_KILL(wa);
4048
      NODE_SF_KILL(wb);
4049
      if(*pchange_sign)
4050
        *pchange_sign = NO;               /* Convey change of sign to up */
4051
      else
4052
        *pchange_sign = YES;
4053
      goto next_pair;
4054
    }
4055
    SCALAR_FACTOR_DEGREE(wa) += SCALAR_FACTOR_DEGREE(wb); /* Sum degrees */
4056
    NODE_SF_KILL(wb);
4057
    goto append_term;
4058

4059
    order_12:
4060
    wa = ma;
4061
    ma = SCALAR_FACTOR_R(ma);
4062
    goto append_term;
4063

4064
    order_21:
4065
    wa = mb;
4066
    mb = SCALAR_FACTOR_R(mb);
4067

4068
    append_term:
4069
    if(mc == NIL)
4070
      mc = wa;
4071
    else
4072
      SCALAR_FACTOR_R(last) = wa;
4073
    last = wa;
4074
  }
4075
  return mc;
4076
}
4077
/*=ScalarSumAddition=====================================================
4078
 Sum of two scalar (polynomial) expressions
4079
*/
4080
uint ScalarSumAddition(uint a, uint b)
4081
{
4082
  uint sum = NIL, last, wa, wb, ma, mb;
4083
  BIGINT na, nb, nc;
4084
  while(YES)
4085
  {
4086
    next_pair:
4087
    if(b == NIL)
4088
    {                 /* List b is ended, append rest of a */
4089
      if(sum == NIL)
4090
        sum = a;
4091
      else
4092
        SCALAR_TERM_R(last) = a;
4093
      break;
4094
    }
4095
    if(a == NIL)
4096
    {                 /* List a is ended, append rest of b */
4097
      if(sum == NIL)
4098
        sum = b;
4099
      else
4100
        SCALAR_TERM_R(last) = b;
4101
      break;
4102
    }
4103

4104
    /* Compare scalar terms */
4105

4106
    ma = SCALAR_TERM_MONOMIAL(a);
4107
    mb = SCALAR_TERM_MONOMIAL(b);
4108
    while(YES)
4109
    {
4110
      if(ma == NIL)
4111
      {
4112
        if(mb != NIL)
4113
          goto order_21;   /* a-monomial is contained in b-monomial */
4114
        break;             /* a-monomial == b-monomial  */
4115
      }                    /* (including both are NILs) */
4116
      if(mb == NIL)
4117
        goto order_12;     /* a-monomial contains b-monomial */
4118
      if(SCALAR_FACTOR_WORD(ma) > SCALAR_FACTOR_WORD(mb))
4119
        goto order_12;
4120
      if(SCALAR_FACTOR_WORD(ma) < SCALAR_FACTOR_WORD(mb))
4121
        goto order_21;
4122
      ma = SCALAR_FACTOR_R(ma);  /* Skip equal factors in monomials */
4123
      mb = SCALAR_FACTOR_R(mb);
4124
    }
4125

4126
    /* Reduce like scalar terms */
4127

4128
    wa = a;
4129
    wb = b;
4130
    a = SCALAR_TERM_R(a);
4131
    b = SCALAR_TERM_R(b);
4132

4133
        /* Sum integer coefficients */
4134

4135
    na = SCALAR_TERM_NUMERATOR(wa);
4136
    nb = SCALAR_TERM_NUMERATOR(wb);
4137
    INTEGER_HEAP_NEW(nc, 2+MAX(INTEGER_N_LIMBS(na),INTEGER_N_LIMBS(nb)));
4138
    IntegerSum(nc, na, nb);
4139
    INTEGER_KILL(na);
4140
    INTEGER_KILL(nb);
4141

4142
        /* Kill head of wb and its monomial */
4143

4144
    mb = SCALAR_TERM_MONOMIAL(wb);
4145
    NODE_ST_KILL(wb);
4146
    while(mb != NIL)
4147
    {
4148
      ma = mb;
4149
      mb = SCALAR_FACTOR_R(mb);
4150
      NODE_SF_KILL(ma);
4151
    }
4152

4153
        /* Nonzero collection */
4154

4155
    if(INTEGER_N_LIMBS(nc) != 0)
4156
    {
4157
      SCALAR_TERM_NUMERATOR(wa) = nc;
4158
      goto append_term;
4159
    }
4160

4161
        /* Zero collection: kill nc and wa */
4162

4163
    INTEGER_KILL(nc);
4164
    ma = SCALAR_TERM_MONOMIAL(wa);
4165
    NODE_ST_KILL(wa);
4166
    while(ma != NIL)
4167
    {
4168
      mb = ma;
4169
      ma = SCALAR_FACTOR_R(ma);
4170
      NODE_SF_KILL(mb);
4171
    }
4172
    goto next_pair;
4173

4174
    order_12:
4175
    wa = a;
4176
    a = SCALAR_TERM_R(a);
4177
    goto append_term;
4178

4179
    order_21:
4180
    wa = b;
4181
    b = SCALAR_TERM_R(b);
4182

4183
    append_term:
4184
    if(sum == NIL)
4185
      sum = wa;
4186
    else
4187
      SCALAR_TERM_R(last) = wa;
4188
    last = wa;
4189
  }
4190
  return sum;
4191
}
4192
/*=ScalarSumCancellation===================
4193
*/
4194
void ScalarSumCancellation(uint *pnum, uint *pden)
4195
{
4196
  uint g;
4197
IN_SCALAR_SUM_CANCELLATION /*------------*/
4198
  if((g = PolyGCD(*pnum, *pden)) != NIL)
4199
  {
4200
    *pnum = PolyQuotient(*pnum, g);
4201
    *pden = PolyQuotient(*pden, g);
4202
    ScalarSumKill(g);
4203
  }
4204
OUT_SCALAR_SUM_CANCELLATION /*-----------*/
4205
}
4206
/*=ScalarSumMinus===========================
4207
 Change sign of scalar sum in Parametric regime
4208
*/
4209
void ScalarSumMinus(uint a)
4210
{
4211
  while(a != NIL)
4212
  {
4213
    SCALAR_TERM_MINUS(a);
4214
    a = SCALAR_TERM_R(a);
4215
  }
4216
}
4217
/*=ScalarSumMultiplication===========================================
4218
 Expanded product of two positive nonzero general scalar expressions,
4219
 caller ensures A != NIL and B != NIL.
4220
*/
4221
uint ScalarSumMultiplication(uint a, uint b)
4222
{
4223
  uint s, aw, bcur, bw, ac, bc;
4224
  s = NIL;
4225
  while(a != NIL)
4226
  {
4227
    aw = a;
4228
    a = SCALAR_TERM_R(a);
4229
    bcur = b;
4230
    while(bcur != NIL)
4231
    {
4232
      bw = bcur;
4233
      bcur = SCALAR_TERM_R(bcur);
4234
      if(a == NIL)
4235
      {
4236
        bc = bw;
4237
        SCALAR_TERM_R(bc) = NIL;
4238
      }
4239
      else
4240
        bc = ScalarTermCopy(bw);
4241
      if(bcur == NIL)
4242
      {
4243
        ac = aw;
4244
        SCALAR_TERM_R(ac) = NIL;
4245
      }
4246
      else
4247
        ac = ScalarTermCopy(aw);
4248
      ScalarTermMultiplication(ac, bc);
4249
      s = ScalarSumAddition(s, ac);
4250
    }
4251
  }
4252
  return s;
4253
}
4254
/*=ScalarTermMultiplication===============================================
4255
 Product of two scalar terms on place of A, B deleted
4256
*/
4257
void ScalarTermMultiplication(uint a, uint b)
4258
{
4259
  BIGINT na, nb, nc;
4260
  uint ma, mb, mc, last, aa;
4261

4262
  /* Multiply integer coefficients */
4263

4264
  na = SCALAR_TERM_NUMERATOR(a);
4265
  nb = SCALAR_TERM_NUMERATOR(b);
4266
  INTEGER_HEAP_NEW(nc, 1+INTEGER_N_LIMBS(na)+INTEGER_N_LIMBS(nb));
4267
  IntegerProduct(nc, na, nb);
4268
  INTEGER_KILL(na);
4269
  INTEGER_KILL(nb);
4270
  SCALAR_TERM_NUMERATOR(a) = nc;
4271

4272
  /* Multiply monomials */
4273

4274
  ma = SCALAR_TERM_MONOMIAL(a);
4275
  mb = SCALAR_TERM_MONOMIAL(b);
4276
  NODE_ST_KILL(b);
4277
  mc = NIL;
4278
  while(YES)
4279
  {
4280
    next_pair:
4281
    if(mb == NIL)
4282
    {                 /* List mb is ended, append rest of ma */
4283
      if(mc == NIL)
4284
        mc = ma;
4285
      else
4286
        SCALAR_FACTOR_R(last) = ma;
4287
      break;
4288
    }
4289
    if(ma == NIL)
4290
    {                 /* List ma is ended, append rest of mb */
4291
      if(mc == NIL)
4292
        mc = mb;
4293
      else
4294
        SCALAR_FACTOR_R(last) = mb;
4295
      break;
4296
    }
4297

4298
    /* Compare scalar factors */
4299

4300
    if(SCALAR_FACTOR_PARAMETER(ma) > SCALAR_FACTOR_PARAMETER(mb))
4301
      goto order_12;
4302
    if(SCALAR_FACTOR_PARAMETER(ma) < SCALAR_FACTOR_PARAMETER(mb))
4303
      goto order_21;
4304

4305
    /* Reduce like factors */
4306

4307
    aa = ma;
4308
    b = mb;                    /* uint-uint mixion */
4309
    ma = SCALAR_FACTOR_R(ma);
4310
    mb = SCALAR_FACTOR_R(mb);
4311
    if(SCALAR_FACTOR_IS_I_NUMBER(aa)) /* Imaginary unit i*i --> -1 */
4312
    {
4313
      NODE_SF_KILL(aa);
4314
      NODE_SF_KILL(b);
4315
      INTEGER_MINUS(nc);
4316
      goto next_pair;
4317
    }
4318
    SCALAR_FACTOR_DEGREE(aa) += SCALAR_FACTOR_DEGREE(b); /* Sum degrees */
4319
    NODE_SF_KILL(b);
4320
    goto append_term;
4321

4322
    order_12:
4323
    aa = ma;
4324
    ma = SCALAR_FACTOR_R(ma);
4325
    goto append_term;
4326

4327
    order_21:
4328
    aa = mb;
4329
    mb = SCALAR_FACTOR_R(mb);
4330

4331
    append_term:
4332
    if(mc == NIL)
4333
      mc = aa;
4334
    else
4335
      SCALAR_FACTOR_R(last) = aa;
4336
    last = aa;
4337
  }
4338
  SCALAR_TERM_MONOMIAL(a) = mc;
4339
}
4340

4341
/*_6_4          Scalar polynomial algebraic functions===================*/
4342

4343
/*=ContentOfScalarSum=========================================
4344
 Returns relative (or full if initial CONT == NIL) single term
4345
 content of scalar sum. NIL corresponds to 1.
4346
 CONT is destroyed, A remains.
4347
*/
4348
uint ContentOfScalarSum(uint cont, uint a)
4349
{
4350
  if(cont == NIL)
4351
  {
4352
    cont = ScalarTermCopy(a);
4353
    INTEGER_SET_PLUS(SCALAR_TERM_NUMERATOR(cont));
4354
    if((a = SCALAR_TERM_R(a)) == NIL)
4355
      goto out_cont;
4356
  }
4357
  while((cont = PolyTermGCD(cont, a)) != NIL
4358
        && (a = SCALAR_TERM_R(a)) != NIL)
4359
    ;
4360
  out_cont:
4361
  return cont;
4362
}
4363
/*=InCoeffParamTable===============================================
4364
 Set in CoeffParamTable parameters of scalar term `cont' killing it
4365
*/
4366
void InCoeffParamTable(uint cont)
4367
{
4368
  uint a = SCALAR_TERM_MONOMIAL(cont);
4369
  INTEGER_KILL(SCALAR_TERM_NUMERATOR(cont));
4370
  NODE_ST_KILL(cont);
4371

4372
  if(a != NIL)
4373
  {
4374
    if(SCALAR_FACTOR_IS_I_NUMBER(a))
4375
    {
4376
      NODE_SF_KILL(a);
4377
      return;
4378
    }
4379
    if(CoeffParamTable == NULL)
4380
      CoeffParamTable = (int*)NewArray(ParameterN, sizeof(int),
4381
                                             E_A_COEFF_PARA_TABLE);
4382
    do
4383
    {
4384
      cont = a;
4385
      a = SCALAR_FACTOR_R(a);
4386
      CoeffParamTable[SCALAR_FACTOR_PARAMETER(cont)] = YES;
4387
      NODE_SF_KILL(cont);
4388
    }while(a != NIL);
4389
  }
4390
}
4391
/*=InCoeffSumTable========================================================
4392
 Insert parametric content-free SUM in table or delete if already exists
4393
*/
4394
void InCoeffSumTable(uint sum)
4395
{
4396
  if(SCALAR_FACTOR_IS_I_NUMBER(SCALAR_TERM_MONOMIAL(sum)))
4397
    ScalarSumKill(sum);                  /* Kill complex number a*i + b */
4398
  else
4399
  {
4400
    int i;
4401
    uint gcd, quocoe, quosum;
4402
    for(i = 0; i < CoeffSumTableN; i++)
4403
      if(PolynomialsAreEqual(sum, CoeffSumTable[i]))
4404
      {
4405
        ScalarSumKill(sum);
4406
        return;
4407
      }
4408
      else
4409
      {
4410
        gcd = PolyGCD(sum, CoeffSumTable[i]);
4411
        if(gcd != NIL)
4412
        {
4413
          quocoe = PolyQuotient(CoeffSumTable[i], gcd);
4414
          quosum = PolyQuotient(sum, gcd);
4415
          --CoeffSumTableN; /* Remove gap in ith position */
4416
          while(i < CoeffSumTableN)
4417
          {
4418
            CoeffSumTable[i] = CoeffSumTable[i+1];
4419
            ++i;
4420
          }
4421
          InCoeffSumTable(gcd);
4422
          if(SCALAR_TERM_R(quocoe) == NIL) /* Either sum or 1 certainly */
4423
          {
4424
            INTEGER_KILL(SCALAR_TERM_NUMERATOR(quocoe));      /* Kill 1 */
4425
            NODE_ST_KILL(quocoe);
4426
          }
4427
          else
4428
            InCoeffSumTable(quocoe);
4429
          if(SCALAR_TERM_R(quosum) == NIL) /* Either sum or 1 certainly */
4430
          {
4431
            INTEGER_KILL(SCALAR_TERM_NUMERATOR(quosum));      /* Kill 1 */
4432
            NODE_ST_KILL(quosum);
4433
          }
4434
          else
4435
            InCoeffSumTable(quosum);
4436
          return;
4437
        }
4438
      }
4439
    if(CoeffSumTableN >= CoeffSumTableSize)
4440
      Error(E_COEFF_SUM_TABLE_SIZE);
4441
    if(CoeffSumTable == NULL)
4442
      CoeffSumTable = (uint *)NewArray(CoeffSumTableSize, sizeof(uint),
4443
                                               E_A_COEFF_SUM_TABLE);
4444
    CoeffSumTable[CoeffSumTableN++] = sum;
4445
  }
4446
}
4447
/*=InCoeffTable===========================================
4448
 Set in tables components of non-NIL parametric polynomial
4449
*/
4450
void InCoeffTable(uint coe)
4451
{
4452
  if(SCALAR_TERM_R(coe) != NIL)
4453
  {
4454
    uint cont;
4455
    if((cont = ContentOfScalarSum(NIL, coe)) != NIL)
4456
    {
4457
      coe = PolyQuotient(coe, cont);
4458
      InCoeffParamTable(cont);
4459
    }
4460
    InCoeffSumTable(coe);
4461
  }
4462
  else
4463
    InCoeffParamTable(coe);
4464
}
4465
/*=PolyCoeffAtMainParameter===========================================
4466
 Polynomial coefficient with normalized sign at the current degree of
4467
 the main parameter. *PA initially points to the start of list, at the
4468
 end of work it points to tail of list. NIL corresponds to 1.
4469
 Initial polynomial remains.
4470
*/
4471
uint PolyCoeffAtMainParameter(uint *pa, int mp)
4472
{
4473
  uint a;
4474
  int isnegative = INTEGER_IS_NEGATIVE(SCALAR_TERM_NUMERATOR(*pa));
4475
  if(POLY_MAIN_PARAMETER(*pa) < mp)
4476
  {                                                    /* Free term */
4477
    a = ScalarSumCopy(*pa);
4478
    if(isnegative)                                /* Normalize sign */
4479
    {
4480
      *pa = a;
4481
      do
4482
        SCALAR_TERM_MINUS(*pa);
4483
      while((*pa = SCALAR_TERM_R(*pa)) != NIL);
4484
    }
4485
    else
4486
      *pa = NIL;
4487
  }
4488
  else
4489
  {
4490
    uint b;
4491
    uint mf;
4492
    int mppow = SCALAR_TERM_MAIN_DEGREE(*pa);
4493
    a = b = ScalarTermCopy(*pa);
4494
    if(isnegative)
4495
      SCALAR_TERM_MINUS(a);
4496
    mf = SCALAR_TERM_MONOMIAL(a);      /* Strike out main parameter */
4497
    SCALAR_TERM_MONOMIAL(a) = SCALAR_FACTOR_R(mf);
4498
    NODE_SF_KILL(mf);
4499
    while((*pa = SCALAR_TERM_R(*pa)) != NIL
4500
          && POLY_MAIN_PARAMETER(*pa) == mp
4501
          && SCALAR_TERM_MAIN_DEGREE(*pa) == mppow)
4502
    {
4503
      SCALAR_TERM_R(b) = ScalarTermCopy(*pa);
4504
      b = SCALAR_TERM_R(b);
4505
      if(isnegative)
4506
      {
4507
        SCALAR_TERM_MINUS(b);
4508
      }
4509
      mf = SCALAR_TERM_MONOMIAL(b);    /* Strike out main parameter */
4510
      SCALAR_TERM_MONOMIAL(b) = SCALAR_FACTOR_R(mf);
4511
      NODE_SF_KILL(mf);
4512
    }
4513
  }
4514
  if(SCALAR_SUM_IS_UNIT(a))
4515
  {
4516
    INTEGER_KILL(SCALAR_TERM_NUMERATOR(a));
4517
    NODE_ST_KILL(a);
4518
    a = NIL;
4519
  }
4520
  return a;
4521
}
4522
/*=PolyContent=============================================
4523
 Polynomial content of polynomial w.r.t. main parameter MP.
4524
 A remains unchanged.
4525
*/
4526
uint PolyContent(uint a, int mp)
4527
{
4528
  uint b;
4529
IN_POLY_CONTENT /*---------------------------------------*/
4530
  if((b = PolyCoeffAtMainParameter(&a, mp)) != NIL)
4531
  {
4532
    uint c, d;
4533
    while(a != NIL)
4534
    {
4535
      if((c = PolyCoeffAtMainParameter(&a, mp)) == NIL)
4536
      {
4537
        ScalarSumKill(b);
4538
        b = NIL;
4539
        break;
4540
      }
4541
      d = b;
4542
      if((b = PolyGCD(b, c)) == NIL)
4543
      {
4544
        ScalarSumKill(d);
4545
        ScalarSumKill(c);
4546
        break;
4547
      }
4548
    }
4549
  }
4550
OUT_POLY_CONTENT /*--------------------------------------*/
4551
  return b;
4552
}
4553
/*=PolyGCD==============================================================
4554
 Returns Greatest Common Divisor of two multivariate polynomials in
4555
 the form GCD(PP(A), PP(B)) * GCD(CONT(A), CONT(B)).
4556
 A, B unchanged.
4557
 Returned NIL means trivial GCD = 1
4558
*/
4559
uint PolyGCD(uint a, uint b)
4560
{
4561
  uint c;
4562
IN_POLY_GCD /*--------------------------------------------------------*/
4563
  if(SCALAR_TERM_R(a) == NIL || SCALAR_TERM_R(b) == NIL)
4564
  {	              /* At least one of the polynomials is not a sum */
4565
    if(SCALAR_TERM_R(a) != NIL)
4566
    {                                    /* Set A to be a single term */
4567
      c = a;
4568
      a = b;
4569
      b = c;
4570
    }
4571
    c = ScalarSumCopy(a);
4572
    INTEGER_SET_PLUS(SCALAR_TERM_NUMERATOR(c));
4573
    b = ContentOfScalarSum(c, b);
4574
  }
4575
  else                                 /* Both are polynomials really */
4576
  {
4577
    uint conta, contb;
4578
    int mp, mpb;                                     /* Main parameters */
4579
    mp = SCALAR_FACTOR_PARAMETER(SCALAR_TERM_MONOMIAL(a));
4580
    mpb = SCALAR_FACTOR_PARAMETER(SCALAR_TERM_MONOMIAL(b));
4581
    if(mpb > mp ||
4582
       (mpb == mp &&
4583
        SCALAR_TERM_MAIN_DEGREE(b) > SCALAR_TERM_MAIN_DEGREE(a)))
4584
    {                           /* Parameters go in DECREASING order! */
4585
      c = a;                                      /* Swap polynomials */
4586
      a = b;
4587
      b = c;
4588
      mp = mpb;
4589
    }
4590
    a = ScalarSumCopy(a);
4591
    b = ScalarSumCopy(b);
4592
    contb = PolyContent(b, mp);
4593
    if((conta = PolyContent(a, mp)) != NIL)
4594
    {                     /* Make primitive parts and GCD of contents */
4595
      if(contb != NIL)
4596
      {
4597
        c = PolyGCD(conta, contb);
4598
        b = PolyQuotient(b, contb);                 /* Primitive part */
4599
        ScalarSumKill(contb);
4600
      }
4601
      else
4602
        c = NIL;
4603
      a = PolyQuotient(a, conta);                   /* Primitive part */
4604
      ScalarSumKill(conta);
4605
    }
4606
    else
4607
    {
4608
      if(contb != NIL)
4609
      {
4610
        b = PolyQuotient(b, contb);                 /* Primitive part */
4611
        ScalarSumKill(contb);
4612
      }
4613
      c = NIL;
4614
    }
4615
    while((conta = PolyPseudoRemainder(a, ScalarSumCopy(b), mp)) != NIL)
4616
    {
4617
      if(SCALAR_TERM_MONOMIAL(conta) == NIL || /* Pure number */
4618
         SCALAR_FACTOR_PARAMETER(SCALAR_TERM_MONOMIAL(conta)) != mp)
4619
      {                 /* Zero degree with respect to main parameter */
4620
        ScalarSumKill(b);
4621
        ScalarSumKill(conta);
4622
        b = c;          /* char is content ?? */
4623
        goto out;
4624
      }
4625
      a = b;
4626
      if((contb = ContentOfScalarSum(NIL, conta)) != NIL)
4627
      {                                               /* Term content */
4628
        conta = PolyQuotient(conta, contb);
4629
            ScalarSumKill(contb);
4630
      }
4631
      if((contb = PolyContent(conta, mp)) != NIL)
4632
      {                                         /* Polynomial content */
4633
        b = PolyQuotient(conta, contb);             /* Primitive part */
4634
        ScalarSumKill(contb);
4635
      }
4636
      else
4637
            b = conta;
4638
    }
4639
    if(c != NIL)
4640
      b = ScalarSumMultiplication(b, c);
4641
    if(INTEGER_IS_NEGATIVE(SCALAR_TERM_NUMERATOR(b)))
4642
    {                                      /* Standardize sign of GCD */
4643
      c = b;
4644
      do
4645
        SCALAR_TERM_MINUS(c);
4646
      while((c = SCALAR_TERM_R(c)) != NIL);
4647
    }
4648
    if(SCALAR_SUM_IS_UNIT(b))
4649
    {                                      /* Standardize trivial GCD */
4650
      INTEGER_KILL(SCALAR_TERM_NUMERATOR(b));
4651
      NODE_ST_KILL(b);
4652
      b = NIL;
4653
    }
4654
  }
4655
  out:
4656
OUT_POLY_GCD /*-------------------------------------------------------*/
4657
  return b;
4658
}
4659
/*=PolyMainParameterTerm================================================
4660
 Take sublist of terms, containing main parameter MP of given degree
4661
 MPDEG, *PA points to the next term after end of A.
4662
 This function is applied in succession starting from top degree.
4663
 Initial expression *PA is destructed.
4664
*/
4665
uint PolyMainParameterTerm(uint *pa, int mp, int mpdeg)
4666
{
4667
  uint a;
4668
  if(mpdeg)
4669
  {
4670
    unsigned short w; /* Word combining degree and index of parameter (MPDEG,MP) */
4671
    w = mpdeg;
4672
#if defined(SPP_2000)
4673
    *((byte*)&w) = mp;
4674
#else
4675
    *((byte*)&w+1) = mp;
4676
#endif
4677
    if(SCALAR_TERM_MONOMIAL(*pa) != NIL &&
4678
       SCALAR_TERM_MAIN_PARAMETER_WORD(*pa) == w)
4679
    {                                         /* There is such degree */
4680
      uint b;
4681
      a = *pa;
4682
      while(YES)
4683
      {
4684
        b = *pa;                            /* Remember previous term */
4685
        *pa = SCALAR_TERM_R(*pa);
4686
        if(*pa == NIL)
4687
          break;                   /* Whole expression is homogeneous */
4688
        if(SCALAR_TERM_MONOMIAL(*pa) == NIL ||
4689
           SCALAR_TERM_MAIN_PARAMETER_WORD(*pa) != w)
4690
        {                         /* End of homogeneous part is found */
4691
          SCALAR_TERM_R(b) = NIL;               /* Set end of sublist */
4692
              break;
4693
        }
4694
      }
4695
    }
4696
    else                                            /* No such degree */
4697
      a = NIL;
4698
  }
4699
  else
4700
  {                                                      /* Free term */
4701
    a = *pa;
4702
    *pa = NIL;
4703
  }
4704
  return a;
4705
}
4706
/*=PolynomialsAreEqual====================================
4707
*/
4708
int PolynomialsAreEqual(uint a, uint b)
4709
{
4710
  uint ma, mb;
4711
  BIGINT na, nb;
4712
  while(YES)
4713
  {
4714
    /* Compare monomials */
4715

4716
    ma = SCALAR_TERM_MONOMIAL(a);
4717
    mb = SCALAR_TERM_MONOMIAL(b);
4718
    while(YES)
4719
    {
4720
      if(ma == NIL)
4721
        if(mb == NIL)
4722
          break;
4723
            else
4724
          goto no;
4725
      else if(mb == NIL)
4726
            goto no;
4727
      if(SCALAR_FACTOR_WORD(ma) != SCALAR_FACTOR_WORD(mb))
4728
            goto no;
4729
      ma = SCALAR_FACTOR_R(ma);
4730
      mb = SCALAR_FACTOR_R(mb);
4731
    }
4732
    /* Compare numerators */
4733

4734
    na = SCALAR_TERM_NUMERATOR(a);
4735
    nb = SCALAR_TERM_NUMERATOR(b);
4736
    if(na[0] != nb[0])
4737
      goto no;
4738
    ma = INTEGER_N_LIMBS(na);
4739
    do
4740
      if(na[ma] != nb[ma])
4741
        goto no;
4742
    while(ma-- > 0);
4743

4744
    a = SCALAR_TERM_R(a);
4745
    b = SCALAR_TERM_R(b);
4746
    if(a == NIL)
4747
      if(b == NIL)
4748
        return YES;
4749
      else
4750
        goto no;
4751
        else if(b == NIL)
4752
        goto no;
4753
  }
4754
  no:
4755
  return NO;
4756
}
4757
/*=PolyPseudoRemainder==================================================
4758
 Returns pseudo-remainder of two polynomials. MP is main parameter.
4759
 main_degree(A) >= main_degree(B). A, B destructed.
4760
*/
4761
uint PolyPseudoRemainder(uint a, uint b, int mp)
4762
{
4763
IN_POLY_PSEUDO_REMAINDER /*-------------------------------------------*/
4764
  if(SCALAR_TERM_MAIN_PARAMETER(b) != mp)
4765
  {                         /* B doesn't contain MP => return 0 (NIL) */
4766
    ScalarSumKill(a);
4767
    ScalarSumKill(b);
4768
    a = NIL;
4769
  }
4770
  else
4771
  {
4772
    uint *u, *v, vn, c, w;
4773
    int m, n, j, k;
4774
    m = SCALAR_TERM_MAIN_DEGREE(a);
4775
    n = SCALAR_TERM_MAIN_DEGREE(b);
4776
    POLY_ARRAY_STACK_NEW(u, m+1);
4777
    POLY_ARRAY_STACK_NEW(v, n);
4778
    for(j = m; j >= 0; j--)                     /*          j         */
4779
      u[j] = PolyMainParameterTerm(&a, mp, j);  /* u[j] = mp  u  etc. */
4780
    vn = PolyMainParameterTerm(&b, mp, n);      /*             j      */
4781
    for(j = n - 1; j >= 0; j--)
4782
      v[j] = PolyMainParameterTerm(&b, mp, j);
4783
    for(k = m - n; k >= 0; k--)
4784
    {
4785
      j = n + k - 1;
4786
      while(j >= k)                             /*    n+j             */
4787
      {                                         /*  mp   (u  = v  u ) */
4788
        if(u[j] != NIL)                         /*         j    n  j  */
4789
          u[j] = ScalarSumMultiplication(ScalarSumCopy(vn), u[j]);
4790
        if(u[n+k] != NIL)
4791
          if(v[j-k] != NIL)
4792
          {
4793
            a = ScalarSumMultiplication(ScalarSumCopy(v[j-k]),
4794
                                        ScalarSumCopy(u[n+k]));
4795
            b = a;
4796
            do
4797
              SCALAR_TERM_MINUS(b);
4798
            while((b = SCALAR_TERM_R(b)) != NIL);     /*     n+j          */
4799
              u[j] = ScalarSumAddition(u[j], a);      /* - mp   v    u    */
4800
          }                                           /*         j-k  n+k */
4801
        if(u[j] != NIL)
4802
        {
4803
          c = u[j];                  /* Drop degree of main parameter */
4804
          do
4805
            if((SCALAR_TERM_MAIN_DEGREE(c) -= n) == 0)
4806
            {                            /* Strike out main parameter */
4807
              w = SCALAR_TERM_MONOMIAL(c);
4808
              SCALAR_TERM_MONOMIAL(c) = SCALAR_FACTOR_R(w);
4809
              NODE_SF_KILL(w);
4810
            }
4811
          while((c = SCALAR_TERM_R(c)) != NIL);
4812
        }
4813
        j--;
4814
      }
4815
      if(u[n+k] != NIL)
4816
        ScalarSumKill(u[n+k]);
4817
      while(j >= 0)
4818
      {
4819
        if(u[j] != NIL)
4820
        {
4821
          u[j] = ScalarSumMultiplication(ScalarSumCopy(vn), u[j]);
4822
          c = u[j];                  /* Drop degree of main parameter */
4823
          do
4824
            if((SCALAR_TERM_MAIN_DEGREE(c) -= n) == 0)
4825
            {                            /* Strike out main parameter */
4826
              w = SCALAR_TERM_MONOMIAL(c);
4827
              SCALAR_TERM_MONOMIAL(c) = SCALAR_FACTOR_R(w);
4828
              NODE_SF_KILL(w);
4829
            }
4830
          while((c = SCALAR_TERM_R(c)) != NIL);
4831
        }
4832
        j--;
4833
      }
4834
    }
4835
    ScalarSumKill(vn);
4836
    for(j = n - 1; j >= 0; j--)
4837
      if(v[j] != NIL)
4838
        ScalarSumKill(v[j]);
4839
    j = n - 1;
4840
    while(j >= 0 && u[j] == NIL)
4841
      j--;                          /* Search first nonzero term u[j] */
4842
    if(j >= 0)
4843
    {                   /* Concatenate pseudoremainder from array u[] */
4844
      a = u[j--];
4845
      b = a;
4846
      while(SCALAR_TERM_R(b) != NIL)
4847
        b = SCALAR_TERM_R(b);
4848
      while(j >= 0)
4849
      {
4850
        if(u[j] != NIL)
4851
            {
4852
              SCALAR_TERM_R(b) = u[j];
4853
          while(SCALAR_TERM_R(b) != NIL)
4854
            b = SCALAR_TERM_R(b);
4855
        }
4856
        j--;
4857
      }
4858
    }
4859
    else                                        /* All u[j] are zeros */
4860
      a = NIL;
4861
  }
4862
OUT_POLY_PSEUDO_REMAINDER /*------------------------------------------*/
4863
  return a;
4864
}
4865
/*=PolyTermGCD==========================================================
4866
 GCD of two single (non-NIL) terms, A is destroyed, B remains,
4867
 caller ensures A is positive, returned NIL corresponds to 1
4868
*/
4869
uint PolyTermGCD(uint a, uint b)
4870
{
4871
  BIGINT na, naa, nb, nbb;
4872
  int i;
4873
  uint ma, maa;
4874

4875
  /* Do integer coefficients */
4876

4877
  na = SCALAR_TERM_NUMERATOR(a);
4878
  nb = SCALAR_TERM_NUMERATOR(b);
4879
  naa = na;                               /* Anyway it will be killed */
4880
  INTEGER_STACK_COPY(nbb, nb, i);
4881
  if((naa = IntegerGCD(naa, nbb)) != NULL)   /* naa = GCD(na, nb) > 1 */
4882
  {
4883
    INTEGER_HEAP_COPY(nb, naa, i);
4884
    SCALAR_TERM_NUMERATOR(a) = nb;
4885
  }
4886
  INTEGER_KILL(na);
4887

4888
  /* Do parametric monomials (parameters go in DECREASING order) */
4889

4890
  maa = NIL;
4891
  if((ma = SCALAR_TERM_MONOMIAL(a)) != NIL)
4892
  {
4893
    uint maw, mb, mal;
4894
    mb = SCALAR_TERM_MONOMIAL(b);
4895
    while(YES)
4896
    {
4897
      if(mb == NIL)
4898
      {               /* MB is ended - kill tail of MA and break loop */
4899
        while(ma != NIL)
4900
        {
4901
          maw = ma;
4902
          ma = SCALAR_FACTOR_R(ma);
4903
          NODE_SF_KILL(maw);
4904
        }
4905
        if(maa != NIL)
4906
          SCALAR_FACTOR_R(mal) = NIL;
4907
        break;
4908
      }
4909
      if(SCALAR_FACTOR_PARAMETER(ma) > SCALAR_FACTOR_PARAMETER(mb))
4910
      {
4911
        maw = ma;                        /* No match for MA - kill it */
4912
        ma = SCALAR_FACTOR_R(ma);
4913
        NODE_SF_KILL(maw);
4914
        if(ma == NIL)
4915
        {
4916
          if(maa != NIL)
4917
            SCALAR_FACTOR_R(mal) = NIL;
4918
          break;
4919
        }
4920
      }
4921
      else if(SCALAR_FACTOR_PARAMETER(ma) < SCALAR_FACTOR_PARAMETER(mb))
4922
        mb = SCALAR_FACTOR_R(mb);       /* No match for MB - shift it */
4923
      else
4924
      {                                 /* Match - set minimum degree */
4925
        if(SCALAR_FACTOR_DEGREE(mb) < SCALAR_FACTOR_DEGREE(ma))
4926
          SCALAR_FACTOR_DEGREE(ma) = SCALAR_FACTOR_DEGREE(mb);
4927
        if(maa == NIL)
4928
          maa = ma;
4929
        else                                    /* Append to last MAA */
4930
          SCALAR_FACTOR_R(mal) = ma;
4931
        mal = ma;
4932
        ma = SCALAR_FACTOR_R(ma);
4933
        if(ma == NIL)
4934
          break;
4935
      }
4936
    }
4937
  }
4938
  SCALAR_TERM_MONOMIAL(a) = maa;          /* Set constructed monomial */
4939
  if(naa == NULL)
4940
  {
4941
    if(maa == NIL)
4942
    {                                                  /* Trivial GCD */
4943
      NODE_ST_KILL(a);
4944
      a = NIL;
4945
    }
4946
    else                         /* Make standard integer coefficient */
4947
    {
4948
      INTEGER_HEAP_NEW(na, 2);
4949
      na[0] = na[1] = 1;
4950
      SCALAR_TERM_NUMERATOR(a) = na;
4951
    }
4952
  }
4953
  return a;
4954
}
4955
/*=PolyTermQuotient===================================================
4956
 Exact division of term A by term B: A = char*B on place of A, B remains.
4957
 Parameters go in decreasing order.
4958
*/
4959
void PolyTermQuotient(uint a, uint b)
4960
{
4961
  BIGINT na, nb, naa, nbb, nc;
4962
  int i;
4963
  uint mb;
4964

4965
  /* Divide integer numerator */
4966

4967
  na = SCALAR_TERM_NUMERATOR(a);
4968
  nb = SCALAR_TERM_NUMERATOR(b);
4969
  INTEGER_STACK_COPY(nbb, nb, i);
4970
  INTEGER_HEAP_NEW(nc, 2+INTEGER_N_LIMBS(na)-INTEGER_N_LIMBS(nbb));
4971
  INTEGER_STACK_COPY_1(naa, na, i);
4972
  INTEGER_KILL(na);
4973
  IntegerQuotient(nc, naa, nbb);
4974
  SCALAR_TERM_NUMERATOR(a) = nc;
4975

4976
  /* Divide parametric monomial */
4977

4978
  if((mb = SCALAR_TERM_MONOMIAL(b)) != NIL)
4979
  {
4980
    uint ma, maa, mae, maw;
4981
    ma = SCALAR_TERM_MONOMIAL(a);
4982
    maa = NIL;
4983
    do
4984
    {
4985
      while(SCALAR_FACTOR_PARAMETER(ma) > SCALAR_FACTOR_PARAMETER(mb))
4986
      {
4987
        if(maa == NIL)
4988
          maa = ma;
4989
        else
4990
          SCALAR_FACTOR_R(mae) = ma;
4991
        mae = ma;
4992
        ma = SCALAR_FACTOR_R(ma);
4993
      }
4994
      if((SCALAR_FACTOR_DEGREE(ma) -= SCALAR_FACTOR_DEGREE(mb)) != 0)
4995
      {
4996
        if(maa == NIL)
4997
          maa = ma;
4998
        else
4999
          SCALAR_FACTOR_R(mae) = ma;
5000
        mae = ma;
5001
        ma = SCALAR_FACTOR_R(ma);
5002
      }
5003
      else
5004
      {
5005
        maw = ma;
5006
        ma = SCALAR_FACTOR_R(ma);
5007
        NODE_SF_KILL(maw);
5008
      }
5009
    }while((mb = SCALAR_FACTOR_R(mb)) != NIL);
5010
    if(maa == NIL)                      /* Append tail of numerator */
5011
      maa = ma;
5012
    else
5013
      SCALAR_FACTOR_R(mae) = ma;
5014
    SCALAR_TERM_MONOMIAL(a) = maa;
5015
  }
5016
}
5017
/*=PolyQuotient====================================================
5018
 Exact division of polynomial A by polynomial B: A = char*B, return char.
5019
 Caller ensures A, B != NIL, B is positive.
5020
 A is destructed, B remains unchanged.
5021
*/
5022
uint PolyQuotient(uint a, uint b)
5023
{
5024
  uint c;
5025
IN_POLY_QUOTIENT /*----------------------------------------------*/
5026
  if(SCALAR_TERM_R(b) == NIL)       /* Division by single term B */
5027
  {
5028
    c = a;
5029
    if(SCALAR_SUM_IS_NOT_UNIT(b))             /* Nontrivial term */
5030
      do
5031
        PolyTermQuotient(a, b);
5032
      while((a = SCALAR_TERM_R(a)) != NIL);
5033
  }
5034
  else                               /* Division by polynomial B */
5035
  {
5036
    uint aw, bw, cw;
5037
    BIGINT n;
5038
    bw = SCALAR_TERM_R(b);
5039
    c = NIL;
5040
    do
5041
    {
5042
      aw = a;
5043
      a = SCALAR_TERM_R(a);
5044
      SCALAR_TERM_R(aw) = NIL;
5045
      PolyTermQuotient(aw, b);
5046
      cw = ScalarTermCopy(aw);
5047
      n = SCALAR_TERM_NUMERATOR(aw);
5048
      INTEGER_MINUS(n);
5049
      aw = ScalarSumMultiplication(aw, ScalarSumCopy(bw));
5050
      a = ScalarSumAddition(a, aw);            /* Remainder of A */
5051
      c = ScalarSumAddition(c, cw);                /* Quotient char */
5052
    }while(a != NIL);
5053
  }
5054
OUT_POLY_QUOTIENT /*---------------------------------------------*/
5055
  return c;
5056
}
5057

5058
/*_6_5          Big number functions====================================*/
5059

5060
/*=BigNMinusBigN================================================
5061
 Subtract two big numbers on the place of first one: `a' -= `b',
5062
 caller provides `a' > `b', returns new size of `a'
5063
*/
5064
int BigNMinusBigN(BIGINT a, int na, BIGINT b, int nb)
5065
{
5066
  uint lw;
5067
  LIMB k = 1;
5068
  int i = 0;
5069
  while(i < nb)         /* Common part */
5070
  {
5071
    lw = MAX_LIMB + (uint)k + (uint)a[i] - (uint)b[i];
5072
    k = (lw > MAX_LIMB);
5073
    a[i++] = (LIMB)lw;
5074
  }
5075
  while(i < na)
5076
  {
5077
    lw = MAX_LIMB + (uint)k + (uint)a[i];
5078
    k = (lw > MAX_LIMB);
5079
    a[i++] = (LIMB)lw;
5080
  }
5081
  while(--i >= 0)
5082
    if(a[i] != 0)
5083
      break;
5084
  return (++i);
5085
}
5086
/*=BigNShiftLeft==============================================
5087
 Add on spot 0 <= `cnt' < BITS_PER_LIMB lowest zero bits to
5088
 `bign' of size `n', return the bits shifted out from the most
5089
 significant LIMB digit
5090
*/
5091
LIMB BigNShiftLeft(BIGINT bign, int n, int cnt)
5092
{
5093
  if(cnt)
5094
  {
5095
    int cocnt = BITS_PER_LIMB - cnt;
5096
    LIMB low_limb,
5097
         high_limb = bign[--n],
5098
         pushed_out = high_limb >> cocnt;
5099
    while(--n >= 0)
5100
    {
5101
      low_limb = bign[n];
5102
      bign[n+1] = (high_limb << cnt) | (low_limb >> cocnt);
5103
      high_limb = low_limb;
5104
    }
5105
    bign[n+1] = high_limb << cnt;
5106
    return pushed_out;
5107
  }
5108
  return 0;
5109
}
5110
/*=BigNShiftRight==========================================
5111
 Remove on spot 0 <= `cnt' < BITS_PER_LIMB lowest bits from
5112
 `bign' of size `n', return size of the result
5113
*/
5114
int BigNShiftRight(BIGINT bign, int n, int cnt)
5115
{
5116
  if(cnt)
5117
  {
5118
    BIGINT bigni;
5119
    int high_limb, low_limb, i, cocnt = BITS_PER_LIMB - cnt;
5120
    low_limb = *bign;
5121
    bigni = bign;
5122
    bigni++;
5123
    for(i = n-1; i > 0; i--)
5124
    {
5125
      high_limb = *(bigni++);
5126
      *(bign++) = (low_limb >> cnt) | (high_limb << cocnt);
5127
      low_limb = high_limb;
5128
    }
5129
    low_limb >>= cnt;
5130
    if(low_limb != 0)
5131
      *bign = low_limb;
5132
    else
5133
      n--;
5134
#if 0
5135
    LIMB high_limb, low_limb;
5136
    int i, cocnt = BITS_PER_LIMB - cnt;
5137
    low_limb = bign[0];
5138
    for(i = 1; i < n; i++)
5139
    {
5140
      high_limb = bign[i];
5141
      bign[i-1] = (low_limb >> cnt) | (high_limb << cocnt);
5142
      low_limb = high_limb;
5143
    }
5144
    low_limb >>= cnt;
5145
    if(low_limb != 0)
5146
      bign[i-1] = low_limb;
5147
    else
5148
      n--;
5149
#endif
5150
  }
5151
  return n;
5152
}
5153
/*=CountLeadingZeroBitsInLimb=========================
5154
 Count number of leading zero bits in LIMB word
5155
*/
5156
int CountLeadingZeroBitsInLimb(LIMB w)
5157
{
5158
  if(w >= 0x100u) /* [0,  7] */
5159
    if(w >= 0x1000u)    /* [0, 3] */
5160
      if(w >= 0x4000u)          /* [0, 1] */
5161
        if(w >= 0x8000u)
5162
          return 0;
5163
        else
5164
          return 1;
5165
      else                      /* [2, 3] */
5166
        if(w >= 0x2000u)
5167
          return 2;
5168
        else
5169
          return 3;
5170
    else                /* [4, 7] */
5171
      if(w >= 0x400u)           /* [4, 5] */
5172
        if(w >= 0x800u)
5173
          return 4;
5174
        else
5175
          return 5;
5176
      else                      /* [6, 7] */
5177
        if(w >= 0x200u)
5178
          return 6;
5179
        else
5180
          return 7;
5181
  else            /* [8, 16] */
5182
    if(w >= 0x10u)      /* [ 8, 11] */
5183
      if(w >= 0x40u)            /* [ 8,  9] */
5184
        if(w >= 0x80u)
5185
          return 8;
5186
        else
5187
          return 9;
5188
      else                      /* [10, 11] */
5189
        if(w >= 0x20u)
5190
          return 10;
5191
        else
5192
          return 11;
5193
    else                /* [12, 16] */
5194
      if(w >= 0x4u)             /* [12, 13] */
5195
        if(w >= 0x8u)
5196
          return 12;
5197
        else
5198
          return 13;
5199
      else                      /* [14, 16] */
5200
        if(w >= 0x2u)
5201
          return 14;
5202
        else                            /* [15, 16] */
5203
          if(w)
5204
            return 15;
5205
          else
5206
            return 16;
5207
}
5208
/*=IntegerCancellation========================================
5209
 Results are placed in `num' and `den' arrays
5210
*/
5211
void IntegerCancellation(BIGINT num, BIGINT den)
5212
{
5213
  BIGINT n, d, g;
5214
  int i;
5215
IN_INTEGER_CANCELLATION  /*----------------------*/
5216
  INTEGER_STACK_COPY_1(n, num, i);
5217
  INTEGER_STACK_COPY_1(d, den, i);
5218
  if((g = IntegerGCD(num, den)) != NULL)
5219
  {
5220
    BIGINT gg;
5221
    INTEGER_STACK_COPY(gg, g, i);  /* `g' in `num' */
5222

5223
    /* Cancel `den' */
5224

5225
    IntegerQuotient(den, d, g);
5226

5227
    /* Cancel `num' */
5228

5229
    IntegerQuotient(num, n, gg);
5230
  }
5231
  else    /* Lozh' vzad */
5232
  {
5233
    i = INTEGER_N_LIMBS(n);
5234
    do
5235
      num[i] = n[i];
5236
    while(i--);
5237
    i = d[0];  /* Denominators and GCDs are positive always */
5238
    do
5239
      den[i] = d[i];
5240
    while(i--);
5241
  }
5242
OUT_INTEGER_CANCELLATION /*----------------------*/
5243
}
5244
/*=IntegerGCD=========================================================
5245
 Binary algorithm is used,
5246
 Returns pointer to array of greatest common divisor
5247
 or NULL interpreted as 1 by caller,
5248
 the function spoils both arrays `u' and `v',
5249
 result is placed in `u' array
5250
*/
5251
BIGINT IntegerGCD(BIGINT u, BIGINT v)
5252
{
5253
  int i, nu, nv, bcnt, w_bcnt;
5254
  BIGINT u0;
5255
  LIMB carry_digit;
5256
IN_INTEGER_GCD  /*--------------------------------------------------*/
5257
  nu = INTEGER_N_LIMBS(u);
5258
  nv = INTEGER_N_LIMBS(v);
5259
  u0 = ++u;       /* Skip size information limbs and memorize begin */
5260
  ++v;
5261
  i = 0;                             /* Shift down uint to make it odd */
5262
  while(*u == 0)
5263
  {                                              /* Skip zero limbs */
5264
    ++i;
5265
    ++u;
5266
  }
5267
  COUNT_LEADING_ZERO_BITS_IN_LIMB(bcnt, *u & -*u);
5268
  bcnt = BITS_PER_LIMB - 1 - bcnt;
5269
  nu = BigNShiftRight(u, nu - i, bcnt);
5270
  bcnt += i * BITS_PER_LIMB;
5271
  w_bcnt = bcnt;
5272
  i = 0;                             /* Shift down void to make it odd */
5273
  while(*v == 0)
5274
  {                                              /* Skip zero limbs */
5275
    ++i;
5276
    ++v;
5277
  }
5278
  COUNT_LEADING_ZERO_BITS_IN_LIMB(bcnt, *v & -*v);
5279
  bcnt = BITS_PER_LIMB - 1 - bcnt;
5280
  nv = BigNShiftRight(v, nv - i, bcnt);
5281
  bcnt += i * BITS_PER_LIMB;
5282
  if(bcnt < w_bcnt)
5283
    w_bcnt = bcnt;                  /* Number of common 2 factors.  */
5284
  while(YES)
5285
  {
5286
    if(nu > nv)
5287
      goto u_greater_v;
5288
    if(nu < nv)
5289
      goto v_greater_u;
5290
    i = nu;
5291
    while(--i >= 0)
5292
    {
5293
      if(u[i] > v[i])
5294
        goto u_greater_v;
5295
      if(v[i] > u[i])
5296
        goto v_greater_u;
5297
    }
5298
    break;   /* If uint and void have become equal, we have found the GCD */
5299
    u_greater_v:  /* Replace uint by (uint - void) >> cnt making uint odd again */
5300
    nu = BigNMinusBigN(u, nu, v, nv);
5301
    while(*u == 0)
5302
    {
5303
      --nu;
5304
      ++u;
5305
    }
5306
    COUNT_LEADING_ZERO_BITS_IN_LIMB(bcnt, *u & -*u);
5307
    bcnt = BITS_PER_LIMB - 1 - bcnt;
5308
    nu = BigNShiftRight(u, nu, bcnt);
5309
    continue;
5310
    v_greater_u:  /* Replace void by (void - uint) >> cnt making void odd again */
5311
    nv = BigNMinusBigN(v, nv, u, nu);
5312
    while(*v == 0)
5313
    {
5314
      --nv;
5315
      ++v;
5316
    }
5317
    COUNT_LEADING_ZERO_BITS_IN_LIMB(bcnt, *v & -*v);
5318
    bcnt = BITS_PER_LIMB - 1 - bcnt;
5319
    nv = BigNShiftRight(v, nv, bcnt);
5320
  }
5321
  /* GCD(U_IN, V_IN) now is uint * 2**W_BCNT.  */
5322
  carry_digit = BigNShiftLeft(u, nu, w_bcnt % BITS_PER_LIMB);
5323
  i = w_bcnt / BITS_PER_LIMB;
5324
  u -= i;
5325
  i += nu;
5326
  if(carry_digit != 0)
5327
  {
5328
    if(u > u0)
5329
    {
5330
      u0 = u--;   /* Shift to left by 1 limb to make room for carry */
5331
      for(nu = 0; nu < i; nu++)
5332
        u[nu] = u0[nu];
5333
    }
5334
    u[i++] = carry_digit;
5335
  }
5336
  if(i == 1 && u[0] == 1)
5337
    return NULL;
5338
  --u;
5339
  u[0] = i;                                    /* PLUS == 0 assumed */
5340
OUT_INTEGER_GCD /*--------------------------------------------------*/
5341
  return u;
5342
}
5343
/*=IntegerProduct======================================
5344
 Traditional multiplication of two signed non-zero
5345
 big numbers uint and void, result in W, W[] != uint[] or void[]
5346
*/
5347
void IntegerProduct(BIGINT w, BIGINT u, BIGINT v)
5348
{
5349
  LIMB carry;
5350
  uint luw;
5351
  BIGINT w0;
5352
  int set_minus, i, j, n, m;
5353
IN_INTEGER_PRODUCT  /*-------------------------------*/
5354
  n = INTEGER_N_LIMBS(u);
5355
  m = INTEGER_N_LIMBS(v);
5356
  set_minus = (INTEGER_SIGN(u) != INTEGER_SIGN(v));
5357
  u++;
5358
  v++;
5359
  w0 = w;
5360
  w++;
5361
  i = j = 0;
5362
  do
5363
    w[i] = 0;
5364
  while(++i < n);
5365
  do
5366
  {
5367
    i = carry = 0;
5368
    do
5369
    {
5370
      luw = (uint)u[i]*(uint)v[j] + (uint)w[i+j] + (uint)carry;
5371
      w[i+j] = (LIMB)luw;
5372
      carry = (LIMB)(luw/BASE_LIMB);
5373
    }while(++i < n);
5374
    w[j+n] = carry;
5375
  }while(++j < m);
5376
  n += m - (carry == 0);
5377
#if defined(INTEGER_MAX_SIZE)
5378
  if(n > IntegerMaxSize)
5379
    IntegerMaxSize = n;
5380
#endif
5381
  w0[0] = n;
5382
  if(set_minus)
5383
    INTEGER_SET_MINUS(w0);
5384
OUT_INTEGER_PRODUCT /*-------------------------------*/
5385
}
5386
/*=IntegerQuotient=====================================================
5387
 Exact division of big numbers:
5388
 Quotient in char[*PM - N + 1 or *PM - N stored in *PM] = A[M] / B[N],
5389
 char != A, char != B.
5390
 Function is spoiling input A and B.
5391
 Array for A should have 1 additional LIMB at the top
5392
 for increasing A at normalizing B.
5393
*/
5394
void IntegerQuotient(BIGINT c, BIGINT a, BIGINT b)
5395
{
5396
  uint lw;
5397
  LIMB q;
5398
  int i, n, set_minus = (INTEGER_SIGN(a) != INTEGER_SIGN(b));
5399
#if defined(D_CHECK_EXACTNESS_OF_DIVISION)
5400
  int nr;
5401
#endif
5402
  BIGINT pm = c;
5403
IN_INTEGER_QUOTIENT  /*----------------------------------------------*/
5404
  *pm = INTEGER_N_LIMBS(a);
5405
  n = INTEGER_N_LIMBS(b);
5406
  a++;
5407
  b++;
5408
  c++;
5409
  if(n == 1)
5410
  {                                      /* Division by short number */
5411
    i = *pm - 1;
5412
    q = a[i] % *b;                                /* Carried residue */
5413
    if((c[i] = a[i] / *b) == 0)
5414
      --*pm;
5415
    while(i)
5416
    {
5417
      lw = (uint)(q)*BASE_LIMB + (uint)a[--i];
5418
      q = (LIMB)(lw % *b);
5419
      c[i] = (LIMB)(lw / *b);
5420
    }
5421
#if defined(D_CHECK_EXACTNESS_OF_DIVISION)
5422
    nr = (q != 0);
5423
#endif
5424
  }
5425
  else
5426
  {                                 /* Division by big number: n > 1 */
5427
    BIGINT aw, bq;
5428
    int k, j, shift, n1 = n + 1;
5429
    LIMB carry, aj, aj1, aj2, bn1, bn2;
5430
    INTEGER_STACK_NEW(bq, n1);                        /* For B[] * Q */
5431
    COUNT_LEADING_ZERO_BITS_IN_LIMB(shift, b[n-1]);
5432
    if(shift)             /* Normalize to make b[n-1] >= BASE_LIMB/2 */
5433
    {
5434
      a[*pm] = BigNShiftLeft(a, *pm, shift);
5435
      BigNShiftLeft(b, n, shift);
5436
    }
5437
    else
5438
      a[*pm] = 0;
5439
    bn1 = b[n-1];
5440
    bn2 = b[n-2];
5441
    j = *pm;
5442
    k = *pm - n;                     /* Top digit char[M-N] may be zero */
5443
    *pm = k + 1;                /* Number of char[K] getting iterations */
5444
    aw = a + k;  /* Start of current subarray of A of the length N+1 */
5445
    do
5446
    {
5447
      aj = a[j];
5448
      aj1 = a[j-1];
5449
      aj2 = a[j-2];
5450
      lw = (uint)aj * BASE_LIMB + (uint)aj1;
5451
      q = (aj == bn1) ? MAX_LIMB : (LIMB)(lw/bn1);
5452
      lw -= (uint)q*(uint)bn1;
5453
      if(lw < BASE_LIMB && (uint)bn2*(uint)q > lw*BASE_LIMB + (uint)aj2)
5454
      {                      /* Knuth's criterion shows Q is too big */
5455
        q--;
5456
        lw += (uint)bn1;
5457
        if(lw < BASE_LIMB && (uint)bn2*(uint)q > lw*BASE_LIMB + (uint)aj2)
5458
          q--;  /* Q was still too big */
5459
      }
5460
      if(q)
5461
      {                                     /* Multiply and subtract */
5462
        i = carry = 0;                /* Make copy of product B by Q */
5463
        do
5464
        {
5465
          lw = (uint)q * (uint)b[i] + (uint)carry;
5466
          carry = (LIMB)(lw/BASE_LIMB);
5467
          bq[i] = (LIMB)lw;
5468
        }while(++i < n);
5469
        bq[i] = carry;               /* BQ[] padded by zero if needs */
5470
        i = n;
5471
        do
5472
          if(aw[i] != bq[i])
5473
          {                                      /* AW[] - BQ[] != 0 */
5474
            if(aw[i] < bq[i])
5475
            {                             /* AW[] - BQ[] is negative */
5476
              q--;                          /* Additional correction */
5477
              BigNMinusBigN(bq, n1, b, n);
5478
            }
5479
            break;
5480
          }
5481
        while(--i >= 0);
5482
#if defined(D_CHECK_EXACTNESS_OF_DIVISION)
5483
        nr =
5484
#endif
5485
        BigNMinusBigN(aw, n1, bq, n1);        /* AW[] - BQ[] on spot */
5486
      }
5487
      c[k--] = q;                    /* Set current LIMB of quotient */
5488
      --aw;                            /* Shift subarray of A digits */
5489
    }while(--j >= n);
5490
    if(c[*pm-1] == 0)
5491
      --*pm;           /* Real quotient size is M - N, not M - N + 1 */
5492
#if defined(D_CHECK_EXACTNESS_OF_DIVISION)
5493
    if(nr && shift)
5494
      nr = BigNShiftRight(a, nr, shift);      /* Normalize remainder */
5495
#endif
5496
  }
5497
  if(set_minus)
5498
    INTEGER_SET_MINUS(pm);
5499
OUT_INTEGER_QUOTIENT /*----------------------------------------------*/
5500
#if defined(D_CHECK_EXACTNESS_OF_DIVISION)
5501
  if(nr)
5502
  {
5503
    PutFormattedU("\n***Division violation at Debug==%u\n", Debug);
5504
    EXIT;
5505
  }
5506
#endif
5507
}
5508
/*=IntegerSum=========================================
5509
 Sum of two signed big numbers A and B, result in char
5510
*/
5511
void IntegerSum(BIGINT c, BIGINT a, BIGINT b)
5512
{
5513
  int set_minus, i, na, nb;
5514
  uint lw;
5515
  LIMB carry;
5516
IN_INTEGER_SUM /*-----------------------------------*/
5517
  if(INTEGER_N_LIMBS(a) < INTEGER_N_LIMBS(b))
5518
  {
5519
    BIGINT w = a;   /* Swap input numbers if necessary */
5520
    a = b;
5521
    b = w;
5522
  }
5523
  na = INTEGER_N_LIMBS(a);
5524
  nb = INTEGER_N_LIMBS(b);
5525
  if(INTEGER_SIGN(a) == INTEGER_SIGN(b))
5526
  {                     /* The same signs: addition */
5527
    set_minus = INTEGER_IS_NEGATIVE(a);
5528
    i = 1;
5529
    carry = 0;
5530
    while(i <= nb)                   /* Common part */
5531
    {
5532
      lw = (uint)carry + (uint)a[i] + (uint)b[i];
5533
      carry = (lw > MAX_LIMB);
5534
      c[i++] = (LIMB)lw;
5535
    }
5536
    while(i <= na)                          /* Tail */
5537
    {
5538
      lw = (uint)carry + (uint)a[i];
5539
      carry = (lw > MAX_LIMB);
5540
      c[i++] = (LIMB)lw;
5541
    }
5542
    if(carry)
5543
      c[i] = 1;
5544
    else
5545
      i--;
5546
#if defined(INTEGER_MAX_SIZE)
5547
    if(i > IntegerMaxSize)
5548
      IntegerMaxSize = i;
5549
#endif
5550
  }
5551
  else              /* Different signs: subtraction */
5552
  {
5553
    if(na == nb)
5554
    {
5555
      i = na;
5556
      while(i > 0)
5557
      {
5558
        if(a[i] < b[i])
5559
        {                           /* Swap numbers */
5560
          BIGINT w = a;
5561
          a = b;
5562
          b = w;
5563
          goto subtract;
5564
        }
5565
        else if(a[i] != b[i])
5566
          goto subtract;
5567
        i--;
5568
      }
5569
      c[0] = 0;       /* Zero result of subtraction */
5570
      goto out;
5571
    }
5572
    subtract:
5573
    set_minus = INTEGER_IS_NEGATIVE(a);
5574
    i = carry = 1;
5575
    while(i <= nb)                   /* Common part */
5576
    {
5577
      lw = MAX_LIMB + (uint)carry + (uint)a[i] - (uint)b[i];
5578
      carry = (lw > MAX_LIMB);
5579
      c[i++] = (LIMB)lw;
5580
    }
5581
    while(i <= na)
5582
    {
5583
      lw = MAX_LIMB + (uint)carry + (uint)a[i];
5584
      carry = (lw > MAX_LIMB);
5585
      c[i++] = (LIMB)lw;
5586
    }
5587
    while(--i > 0)
5588
      if(c[i] != 0)
5589
        break;
5590
  }
5591
  c[0] = i;               /* Number of LIMBs in sum */
5592
  if(set_minus)
5593
    INTEGER_SET_MINUS(c);
5594
  out:
5595
OUT_INTEGER_SUM /*----------------------------------*/
5596
  return;
5597
}
5598

5599
/*_6_6          Copy and delete functions===============================*/
5600

5601
/*=LieSumCopyInteger===================================
5602
  Integer regime
5603
*/
5604
uint LieSumCopyInteger(uint a)
5605
{
5606
  if(a != NIL)
5607
  {
5608
    uint ca, eca;
5609
    BIGINT n, cn;
5610
    int i;
5611
IN_LIE_SUM_COPY  /*----------------------------------*/
5612
    ca = eca = NodeLTNew();
5613
    LIE_TERM_MONOMIAL(eca) = LIE_TERM_MONOMIAL(a);
5614
    n = LIE_TERM_NUMERATOR_INTEGER(a);
5615
    INTEGER_HEAP_COPY(cn, n, i);
5616
    LIE_TERM_NUMERATOR_INTEGER(eca) = cn;
5617
    if((n = LIE_TERM_DENOMINATOR_INTEGER(a)) != NULL)
5618
    {
5619
      INTEGER_HEAP_COPY(cn, n, i);
5620
      LIE_TERM_DENOMINATOR_INTEGER(eca) = cn;
5621
    }
5622
    else
5623
      LIE_TERM_DENOMINATOR_INTEGER(eca) = NULL;
5624
    while((a = LIE_TERM_R(a)) != NIL)
5625
    {
5626
      LIE_TERM_R(eca) = NodeLTNew();
5627
      eca = LIE_TERM_R(eca);
5628
      LIE_TERM_MONOMIAL(eca) = LIE_TERM_MONOMIAL(a);
5629
      n = LIE_TERM_NUMERATOR_INTEGER(a);
5630
      INTEGER_HEAP_COPY(cn, n, i);
5631
      LIE_TERM_NUMERATOR_INTEGER(eca)= cn;
5632
      if((n = LIE_TERM_DENOMINATOR_INTEGER(a)) != NULL)
5633
      {
5634
        INTEGER_HEAP_COPY(cn, n, i);
5635
        LIE_TERM_DENOMINATOR_INTEGER(eca) = cn;
5636
      }
5637
      else
5638
        LIE_TERM_DENOMINATOR_INTEGER(eca) = NULL;
5639
    }
5640
OUT_LIE_SUM_COPY /*----------------------------------*/
5641
    return ca;
5642
  }
5643
  return NIL;
5644
}
5645
/*=LieSumCopyIntegerNegative===================================
5646
  Copy changing sign. Integer regime
5647
*/
5648
uint LieSumCopyIntegerNegative(uint a)
5649
{
5650
  if(a != NIL)
5651
  {
5652
    uint ca, eca;
5653
    BIGINT n, cn;
5654
    int i;
5655
    ca = eca = NodeLTNew();
5656
    LIE_TERM_MONOMIAL(eca) = LIE_TERM_MONOMIAL(a);
5657
    n = LIE_TERM_NUMERATOR_INTEGER(a);
5658
    INTEGER_HEAP_COPY(cn, n, i);
5659
    INTEGER_MINUS(cn);
5660
    LIE_TERM_NUMERATOR_INTEGER(eca) = cn;
5661
    if((n = LIE_TERM_DENOMINATOR_INTEGER(a)) != NULL)
5662
    {
5663
      INTEGER_HEAP_COPY(cn, n, i);
5664
      LIE_TERM_DENOMINATOR_INTEGER(eca) = cn;
5665
    }
5666
    else
5667
      LIE_TERM_DENOMINATOR_INTEGER(eca) = NULL;
5668
    while((a = LIE_TERM_R(a)) != NIL)
5669
    {
5670
      LIE_TERM_R(eca) = NodeLTNew();
5671
      eca = LIE_TERM_R(eca);
5672
      LIE_TERM_MONOMIAL(eca) = LIE_TERM_MONOMIAL(a);
5673
      n = LIE_TERM_NUMERATOR_INTEGER(a);
5674
      INTEGER_HEAP_COPY(cn, n, i);
5675
      INTEGER_MINUS(cn);
5676
      LIE_TERM_NUMERATOR_INTEGER(eca)= cn;
5677
      if((n = LIE_TERM_DENOMINATOR_INTEGER(a)) != NULL)
5678
      {
5679
        INTEGER_HEAP_COPY(cn, n, i);
5680
        LIE_TERM_DENOMINATOR_INTEGER(eca) = cn;
5681
      }
5682
      else
5683
        LIE_TERM_DENOMINATOR_INTEGER(eca) = NULL;
5684
    }
5685
    return ca;
5686
  }
5687
  return NIL;
5688
}
5689
/*=LieSumCopyParametric=====================================
5690
  Parametric regime
5691
*/
5692
uint LieSumCopyParametric(uint a)
5693
{
5694
  if(a != NIL)
5695
  {
5696
    uint ca, eca;
5697
IN_LIE_SUM_COPY  /*---------------------------------------*/
5698
    ca = eca = NodeLTNew();
5699
    LIE_TERM_MONOMIAL(eca) = LIE_TERM_MONOMIAL(a);
5700
    LIE_TERM_NUMERATOR_SCALAR_SUM(eca) =
5701

5702
      ScalarSumCopy(LIE_TERM_NUMERATOR_SCALAR_SUM(a));
5703
    if(LIE_TERM_DENOMINATOR_SCALAR_SUM(a) != NIL)
5704
      LIE_TERM_DENOMINATOR_SCALAR_SUM(eca) =
5705
        ScalarSumCopy(LIE_TERM_DENOMINATOR_SCALAR_SUM(a));
5706
    else
5707
      LIE_TERM_DENOMINATOR_SCALAR_SUM(eca) = NIL;
5708
    while((a = LIE_TERM_R(a)) != NIL)
5709
    {
5710
      LIE_TERM_R(eca) = NodeLTNew();
5711
      eca = LIE_TERM_R(eca);
5712
      LIE_TERM_MONOMIAL(eca) = LIE_TERM_MONOMIAL(a);
5713
      LIE_TERM_NUMERATOR_SCALAR_SUM(eca) =
5714
        ScalarSumCopy(LIE_TERM_NUMERATOR_SCALAR_SUM(a));
5715
      if(LIE_TERM_DENOMINATOR_SCALAR_SUM(a) != NIL)
5716
        LIE_TERM_DENOMINATOR_SCALAR_SUM(eca) =
5717
          ScalarSumCopy(LIE_TERM_DENOMINATOR_SCALAR_SUM(a));
5718
      else
5719
        LIE_TERM_DENOMINATOR_SCALAR_SUM(eca) = NIL;
5720
    }
5721
OUT_LIE_SUM_COPY /*---------------------------------------*/
5722
    return ca;
5723
  }
5724
  return NIL;
5725
}
5726
/*=LieSumKillInteger================================
5727
 a == NIL is admitted (Integer regime)
5728
*/
5729
void LieSumKillInteger(uint a)
5730
{
5731
  uint b;
5732
  BIGINT d;
5733
IN_LIE_SUM_KILL  /*-------------------------------*/
5734
  while(a != NIL)
5735
  {
5736
    b = a;
5737
    a = LIE_TERM_R(a);
5738
    INTEGER_KILL(LIE_TERM_NUMERATOR_INTEGER(b));
5739
    if((d = LIE_TERM_DENOMINATOR_INTEGER(b)) != NULL)
5740
      INTEGER_KILL(d);
5741
    NODE_LT_KILL(b);
5742
  }
5743
OUT_LIE_SUM_KILL  /*------------------------------*/
5744
}
5745
/*=LieSumKillParametric===============================
5746
 a == NIL is admitted (Parametric regime)
5747
*/
5748
void LieSumKillParametric(uint a)
5749
{
5750
  uint b;
5751
IN_LIE_SUM_KILL  /*---------------------------------*/
5752
  while(a != NIL)
5753
  {
5754
    b = a;
5755
    a = LIE_TERM_R(a);
5756
    ScalarSumKill(LIE_TERM_NUMERATOR_SCALAR_SUM(b));
5757
    ScalarSumKill(LIE_TERM_DENOMINATOR_SCALAR_SUM(b));
5758
    NODE_LT_KILL(b);
5759
  }
5760
OUT_LIE_SUM_KILL  /*--------------------------------*/
5761
}
5762
/*=LieTermFromMonomialInteger============
5763
*/
5764
uint LieTermFromMonomialInteger(int mon)
5765
{
5766
  BIGINT num;
5767
  uint a = NodeLTNew();
5768

5769
  LIE_TERM_MONOMIAL(a) = mon;
5770

5771
  INTEGER_HEAP_NEW(num, 2);
5772
  num[0] = num[1] = 1;
5773
  LIE_TERM_NUMERATOR_INTEGER(a) = num;
5774

5775
  LIE_TERM_DENOMINATOR_INTEGER(a) = NULL;
5776

5777
  return a;
5778
}
5779
/*=LieTermFromMonomialParametric===========
5780
*/
5781
uint LieTermFromMonomialParametric(int mon)
5782
{
5783
  BIGINT num;
5784
  uint c = NodeSTNew(),
5785
    a = NodeLTNew();
5786

5787
  LIE_TERM_MONOMIAL(a) = mon;
5788

5789
  SCALAR_TERM_MONOMIAL(c) = NIL;
5790
  INTEGER_HEAP_NEW(num, 2);
5791
  num[0] = num[1] = 1;
5792
  SCALAR_TERM_NUMERATOR(c) = num;
5793

5794
  LIE_TERM_NUMERATOR_SCALAR_SUM(a) = c;
5795

5796
  LIE_TERM_DENOMINATOR_SCALAR_SUM(a) = NIL;
5797

5798
  return a;
5799
}
5800
/*=ScalarSumCopy=======================================
5801
 Caller ensures a != NIL
5802
*/
5803
uint ScalarSumCopy(uint a)
5804
{
5805
  int i;
5806
  BIGINT n, o;
5807
  uint ca, bca, b, cb;
5808
  bca = ca = NodeSTNew();
5809
  while(YES)
5810
  {
5811
    /* Copy integer coefficient */
5812

5813
    o = SCALAR_TERM_NUMERATOR(a);
5814
    INTEGER_HEAP_COPY(n, o, i);
5815
    SCALAR_TERM_NUMERATOR(ca) = n;
5816

5817
    /* Copy scalar monomial */
5818

5819
    b = SCALAR_TERM_MONOMIAL(a);
5820
    if(b != NIL)
5821
    {
5822
      SCALAR_TERM_MONOMIAL(ca) = cb = NodeSFNew();
5823
      SCALAR_FACTOR_WORD(cb) = SCALAR_FACTOR_WORD(b);
5824
      while((b = SCALAR_FACTOR_R(b)) != NIL)
5825
      {
5826
        SCALAR_FACTOR_R(cb) = NodeSFNew();
5827
        cb = SCALAR_FACTOR_R(cb);
5828
        SCALAR_FACTOR_WORD(cb) = SCALAR_FACTOR_WORD(b);
5829
      }
5830
    }
5831
    else
5832
      SCALAR_TERM_MONOMIAL(ca) = NIL;
5833

5834
    if((a = SCALAR_TERM_R(a)) == NIL)
5835
      break;
5836
    SCALAR_TERM_R(ca) = NodeSTNew();
5837
    ca = SCALAR_TERM_R(ca);
5838
  }
5839
  return bca;
5840
}
5841
/*=ScalarSumKill=================================================
5842
  Only at IsParametric == YES, a == NIL is admitted
5843
*/
5844
void ScalarSumKill(uint a)
5845
{
5846
  uint b, c;
5847
  while(a != NIL)
5848
  {
5849
    b = a;
5850
    a = SCALAR_TERM_R(a);
5851
    INTEGER_KILL(SCALAR_TERM_NUMERATOR(b));
5852
    c = SCALAR_TERM_MONOMIAL(b);
5853
    NODE_ST_KILL(b);
5854
    while(c != NIL)   /* Scalar monomial may be NIL, uint-uint mix */
5855
    {
5856
      b = c;
5857
      c = SCALAR_FACTOR_R(c);
5858
      NODE_SF_KILL(b);
5859
    }
5860
  }
5861
}
5862
/*=ScalarTermCopy====================================
5863
 Caller ensures a != NIL
5864
*/
5865
uint ScalarTermCopy(uint a)
5866
{
5867
  int i;
5868
  BIGINT cn, n;
5869
  uint m, ca = NodeSTNew();
5870

5871
  /* Copy integer coefficient */
5872

5873
  n = SCALAR_TERM_NUMERATOR(a);
5874
  INTEGER_HEAP_COPY(cn, n, i);
5875
  SCALAR_TERM_NUMERATOR(ca) = cn;
5876

5877
  /* Copy monomial */
5878

5879
  if((m = SCALAR_TERM_MONOMIAL(a)) != NIL)
5880
  {
5881
    uint cm;
5882
    SCALAR_TERM_MONOMIAL(ca) = cm = NodeSFNew();
5883
    SCALAR_FACTOR_WORD(cm) = SCALAR_FACTOR_WORD(m);
5884
    while((m = SCALAR_FACTOR_R(m)) != NIL)
5885
    {
5886
      SCALAR_FACTOR_R(cm) = NodeSFNew();
5887
      cm = SCALAR_FACTOR_R(cm);
5888
      SCALAR_FACTOR_WORD(cm) = SCALAR_FACTOR_WORD(m);
5889
    }
5890
  }
5891
  else
5892
    SCALAR_TERM_MONOMIAL(ca) = NIL;
5893
  return ca;
5894
}
5895

5896
/*_6_7          Technical functions=====================================*/
5897

5898
/*=Error!===============
5899
*/
5900
void Error(int i_message)
5901
{
5902
  PutMessage(ERROR);
5903
  PutMessage(i_message);
5904
  EXIT;
5905
}
5906
/*=Initialization==========================================================
5907
*/
5908
void Initialization(void)
5909
{
5910
  FILE *inif;
5911
  short c;
5912
  uint i, j;
5913
  char * init_case[N_INIT_CASES];
5914

5915
  /* Set cases strings */
5916

5917
  init_case[COEFFICIENT_SUM_TABLE_SIZE] = "Co";
5918
  init_case[CRUDE_TIME]                 = "Cr";
5919
  init_case[ECHO_INPUT_FILE]            = "Ec";
5920
  init_case[EVEN_BASIS_SYMBOL]          = "Ev";
5921
  init_case[GAP_ALGEBRA_NAME]           = "GAP a";
5922
  init_case[GAP_BASIS_NAME]             = "GAP b";
5923
  init_case[GAP_RELATIONS_NAME]         = "GAP r";
5924
  init_case[GAP_OUTPUT_BASIS]           = "GAP output b";
5925
  init_case[GAP_OUTPUT_COMMUTATORS]     = "GAP output c";
5926
  init_case[GAP_OUTPUT_RELATIONS]       = "GAP output r";
5927
  init_case[GENERATOR_MAX_N]            = "Ge";
5928
  init_case[INPUT_DIRECTORY]            = "Input d";
5929
  init_case[INPUT_INTEGER_SIZE]         = "Input i";
5930
  init_case[INPUT_STRING_SIZE]          = "Input s";
5931
  init_case[LEFT_NORMED_OUTPUT]         = "Le";
5932
  init_case[LIE_MONOMIAL_SIZE]          = "Lie";
5933
  init_case[LINE_LENGTH]                = "Lin";
5934
  init_case[NAME_LENGTH]                = "Na";
5935
  init_case[NODE_LT_SIZE]               = "Node L";
5936
  init_case[NODE_SF_SIZE]               = "Node scalar f";
5937
  init_case[NODE_ST_SIZE]               = "Node scalar t";
5938
  init_case[ODD_BASIS_SYMBOL]           = "Od";
5939
  init_case[OUT_LINE_SIZE]              = "Ou";
5940
  init_case[PARAMETER_MAX_N]            = "Pa";
5941
  init_case[PUT_BASIS_ELEMENTS]         = "Put b";
5942
  init_case[PUT_COMMUTATORS]            = "Put c";
5943
  init_case[PUT_HILBERT_SERIES]         = "Put H";
5944
  init_case[PUT_INITIAL_RELATIONS]      = "Put i";
5945
  init_case[PUT_NON_ZERO_COEFFICIENTS]  = "Put n";
5946
  init_case[PUT_PROGRAM_HEADING]        = "Put p";
5947
  init_case[PUT_REDUCED_RELATIONS]      = "Put r";
5948
  init_case[PUT_STATISTICS]             = "Put s";
5949
  init_case[RELATION_SIZE]              = "Re";
5950

5951
#if !defined(GAP)
5952
#if defined(SPP_2000)
5953
  MessageFile = OpenFile("fplsa4.msg", "r");
5954
  SessionFile = OpenFile("fplsa4.ses", "w");
5955
  inif = OpenFile("fplsa4.ini", "r");
5956
#else
5957
  MessageFile = OpenFile("fplsa4.msg", "rt");
5958
  SessionFile = OpenFile("fplsa4.ses", "wt");
5959
  inif = OpenFile("fplsa4.ini", "rt");
5960
#endif
5961
#else
5962
#if defined(SPP_2000)
5963
  inif = OpenFile("fplsa4.ini", "r");
5964
#else
5965
  inif = OpenFile("fplsa4.ini", "rt");
5966
#endif
5967
#endif
5968
  while(YES)
5969
    switch(ReadCaseFromFile(inif, init_case, N_INIT_CASES))
5970
    {
5971
      case COEFFICIENT_SUM_TABLE_SIZE:
5972
        CoeffSumTableSize = ReadDecimalFromFile(inif);
5973
      break;
5974
      case CRUDE_TIME:
5975
        CrudeTime = ReadBooleanFromFile(inif);
5976
      break;
5977
      case ECHO_INPUT_FILE:
5978
        EchoInput = ReadBooleanFromFile(inif);
5979
      break;
5980
      case EVEN_BASIS_SYMBOL:
5981
        BasisSymbolEven = fgetc(inif);
5982
      break;
5983
      case GAP_ALGEBRA_NAME:
5984
        if(ReadStringFromFile(GAPAlgebraName, inif) == EOF)
5985
          goto out;
5986
      break;
5987
      case GAP_BASIS_NAME:
5988
        if(ReadStringFromFile(GAPBasisName, inif) == EOF)
5989
          goto out;
5990
      break;
5991
      case GAP_RELATIONS_NAME:
5992
        if(ReadStringFromFile(GAPRelationsName, inif) == EOF)
5993
          goto out;
5994
      break;
5995
      case GAP_OUTPUT_BASIS:
5996
        GAPOutputBasis = ReadBooleanFromFile(inif);
5997
      break;
5998
      case GAP_OUTPUT_COMMUTATORS:
5999
        GAPOutputCommutators = ReadBooleanFromFile(inif);
6000
      break;
6001
      case GAP_OUTPUT_RELATIONS:
6002
        GAPOutputRelations = ReadBooleanFromFile(inif);
6003
      break;
6004
      case GENERATOR_MAX_N:
6005
        GeneratorMaxN = ReadDecimalFromFile(inif);
6006
      break;
6007
      case INPUT_DIRECTORY:
6008
        while((c = fgetc(inif)) != '\n')
6009
        {
6010
          if(c == LEFT_COMMENT)
6011
          {
6012
            ungetc(c, inif);
6013
            break;
6014
          }
6015
          if(c == EOF)
6016
            goto out;
6017
          if(!isspace(c))
6018
            OutLine[PosOutLine++] = (char)c;
6019
        }
6020
      break;
6021
      case INPUT_INTEGER_SIZE:
6022
        InputIntegerSize =  (uint)ReadDecimalFromFile(inif);
6023
        InputIntegerSize++; /* For head */
6024
      break;
6025
      case INPUT_STRING_SIZE:
6026
        InputStringSize =  (uint)ReadDecimalFromFile(inif);
6027
      break;
6028
      case LEFT_NORMED_OUTPUT:
6029
        if(ReadBooleanFromFile(inif))
6030
          PutLieMonomial = PutLieMonomialLeftNormed;
6031
      break;
6032
      case LINE_LENGTH:
6033
        LineLength = (uint)ReadDecimalFromFile(inif);
6034
      break;
6035
      case LIE_MONOMIAL_SIZE:
6036
        LieMonomialSize = (int)ReadDecimalFromFile(inif);
6037
        LieMonomial = (LIE_MON*)NewArray(LieMonomialSize, sizeof(LIE_MON),
6038
                                                         E_A_LIE_MONOMIAL);
6039
      break;
6040
      case NAME_LENGTH:
6041
        NameLength1 = ReadDecimalFromFile(inif);
6042
        NameLength1++;
6043
      break;
6044
      case NODE_LT_SIZE:
6045
        NodeLTSize = (uint)ReadDecimalFromFile(inif);
6046
        NodeLT =
6047
          (NODE_LT*)NewArray(NodeLTSize, sizeof(NODE_LT), E_A_NODE_LT);
6048
        i = 1;
6049
        j = 2;
6050
        while(j < NodeLTSize) /* Install NodeLT for Lie terms */
6051
          LIE_TERM_R(i++) = j++;
6052
#if defined(SPACE_STATISTICS)
6053
        LIE_TERM_R(i) = NOTHING;
6054
#else
6055
        LIE_TERM_R(i) = NIL;
6056
#endif
6057
      break;
6058
      case NODE_SF_SIZE:
6059
        NodeSFSize = (uint)ReadDecimalFromFile(inif);
6060
      break;
6061
      case NODE_ST_SIZE:
6062
        NodeSTSize = (uint)ReadDecimalFromFile(inif);
6063
      break;
6064
      case ODD_BASIS_SYMBOL:
6065
        BasisSymbolOdd = fgetc(inif);
6066
      break;
6067
      case OUT_LINE_SIZE:
6068
        OutLineSize = (uint)ReadDecimalFromFile(inif);
6069
        OutLine = (char *)NewArray(OutLineSize, 1, E_A_OUT_LINE);
6070
      break;
6071
      case PARAMETER_MAX_N:
6072
        ParameterMaxN = ReadDecimalFromFile(inif);
6073
      break;
6074
      case PUT_BASIS_ELEMENTS:
6075
        BasisElementsPut = ReadBooleanFromFile(inif);
6076
      break;
6077
      case PUT_COMMUTATORS:
6078
        CommutatorsPut = ReadBooleanFromFile(inif);
6079
      break;
6080
      case PUT_HILBERT_SERIES:
6081
        HilbertSeriesPut = ReadBooleanFromFile(inif);
6082
      break;
6083
      case PUT_INITIAL_RELATIONS:
6084
        InitialRelationsPut = ReadBooleanFromFile(inif);
6085
      break;
6086
      case PUT_NON_ZERO_COEFFICIENTS:
6087
        NonZeroCoefficientsPut = ReadBooleanFromFile(inif);
6088
      break;
6089
      case PUT_PROGRAM_HEADING:
6090
        HeadingPut = ReadBooleanFromFile(inif);
6091
      break;
6092
      case PUT_REDUCED_RELATIONS:
6093
        ReducedRelationsPut = ReadBooleanFromFile(inif);
6094
      break;
6095
      case PUT_STATISTICS:
6096
        StatisticsPut = ReadBooleanFromFile(inif);
6097
      break;
6098
      case RELATION_SIZE:
6099
        RelationSize = (int)ReadDecimalFromFile(inif);
6100
        Relation = (REL*)NewArray(RelationSize, sizeof(REL), E_A_RELATION);
6101
      break;
6102
      case EOF:
6103
        goto out;
6104
      default:
6105
        Error(E_WRONG_INI_CASE);
6106
    }
6107
  out:
6108
  fclose(inif);
6109
  if(HeadingPut)
6110
    PutMessage(H_PROGRAM);
6111
  GeneratorName = (char *)NewArray(GeneratorMaxN*NameLength1, sizeof(char),
6112
                                                 E_A_GENERATOR_NAME);
6113
}
6114
/*=NewArray=========================================
6115
*/
6116
void * NewArray(uint n, uint size, int i_message)
6117
{
6118
  void * new_pointer = (void *)calloc(n, size);
6119
  if(new_pointer == NULL && n != 0)
6120
  {
6121
    const char * format = "%u elements of size %u\n%u bytes\n";
6122
    PutMessage(E_ALLOC);
6123
    PutMessage(i_message);
6124
#if defined(ECHO_TO_SCREEN)
6125
    printf(format, n,  size, n*size);
6126
#endif
6127
#if !defined(GAP)
6128
    fprintf(SessionFile, format, n,  size, n*size);
6129
#endif
6130
    EXIT;
6131
  }
6132
  return new_pointer;
6133
}
6134
/*=NodeLTNew===================
6135
 Get node from NodeLT pool.
6136
*/
6137
uint NodeLTNew(void)
6138
{
6139
  uint a = NodeLTTop;
6140
#if !defined(SPACE_STATISTICS)
6141
  if(a == NIL)
6142
  {
6143
    TIME_OFF;
6144
    PutStatistics();
6145
    Error(E_NODE_LT_SIZE);
6146
  }
6147
#endif
6148
  NodeLTTop = LIE_TERM_R(a);
6149
#if defined(SPACE_STATISTICS)
6150
  if(NodeLTTopMax < NodeLTTop)
6151
  {
6152
    if(NodeLTTop > NodeLTSize)
6153
    {
6154
      TIME_OFF;
6155
      PutStatistics();
6156
      Error(E_NODE_LT_SIZE);
6157
    }
6158
    NodeLTTopMax = NodeLTTop;
6159
  }
6160
#endif
6161
  LIE_TERM_R(a) = NIL;
6162
PP_CURRENT_N_LT     /* MEMORY */
6163
    return a;
6164
}
6165
/*=NodeSFNew=====================
6166
 Get node from NodeSF pool.
6167
*/
6168
uint NodeSFNew(void)
6169
{
6170
  uint a = NodeSFTop;
6171
#if !defined(SPACE_STATISTICS)
6172
  if(a == NIL)
6173
  {
6174
    TIME_OFF;
6175
    PutStatistics();
6176
    Error(E_NODE_SF_SIZE);
6177
  }
6178
#endif
6179
  NodeSFTop = SCALAR_FACTOR_R(a);
6180
#if defined(SPACE_STATISTICS)
6181
  if(NodeSFTopMax < NodeSFTop)
6182
  {
6183
    if(NodeSFTop > NodeSFSize)
6184
    {
6185
      TIME_OFF;
6186
      PutStatistics();
6187
      Error(E_NODE_SF_SIZE);
6188
    }
6189
    NodeSFTopMax = NodeSFTop;
6190
  }
6191
#endif
6192
  SCALAR_FACTOR_R(a) = NIL;
6193
PP_CURRENT_N_SF     /* MEMORY */
6194
    return a;
6195
}
6196
/*=NodeSTNew===================
6197
 Get node from NodeST pool.
6198
*/
6199
uint NodeSTNew(void)
6200
{
6201
  uint a = NodeSTTop;
6202
#if !defined(SPACE_STATISTICS)
6203
  if(a == NIL)
6204
  {
6205
    TIME_OFF;
6206
    PutStatistics();
6207
    Error(E_NODE_ST_SIZE);
6208
  }
6209
#endif
6210
  NodeSTTop = SCALAR_TERM_R(a);
6211
#if defined(SPACE_STATISTICS)
6212
  if(NodeSTTopMax < NodeSTTop)
6213
  {
6214
    if(NodeSTTop > NodeSTSize)
6215
    {
6216
      TIME_OFF;
6217
      PutStatistics();
6218
      Error(E_NODE_ST_SIZE);
6219
    }
6220
    NodeSTTopMax = NodeSTTop;
6221
  }
6222
#endif
6223
  SCALAR_TERM_R(a) = NIL;
6224
PP_CURRENT_N_ST     /* MEMORY */
6225
    return a;
6226
}
6227
/*=OpenFile================================
6228
*/
6229
FILE *OpenFile(char * file_name, char * file_type)
6230
{
6231
  FILE *file = fopen(file_name, file_type);
6232
  if(file == NULL)
6233
  {
6234
    printf("\nNo file: %s", file_name);
6235
    exit(1);
6236
  }
6237
  return file;
6238
}
6239

6240
/*_6_8		Input functions=========================================*/
6241

6242
/*=BinaryQuestion!================
6243
*/
6244
int BinaryQuestion(int i_message)
6245
{
6246
  char c[2];
6247
  get_symbol:
6248
  PutMessage(i_message);
6249
  scanf("%1s", c);
6250
#if !defined(GAP)
6251
  fputc(c[0], SessionFile);
6252
#endif
6253
  switch(c[0])
6254
  {
6255
    case 'y': case 'Y': case '\n':
6256
      return YES;
6257
    case 'n': case 'N':
6258
      break;
6259
    case 'c': case 'C':
6260
      Error(E_CANCEL_PROGRAM);
6261
    default:
6262
      goto get_symbol;
6263
  }
6264
  return NO;
6265
}
6266
/*=FindNameInTable==============================================
6267
 Find name from string in table ...NameIn
6268
*/
6269
int FindNameInTable(char * name, char * nametab, int n_nametab)
6270
{
6271
  char *w_nametab, *w_name;
6272
  int j = 0;
6273
  while(j < n_nametab)
6274
  {
6275
    w_nametab = nametab;
6276
    w_name = name;
6277
    while(YES)
6278
    {
6279
      if(*w_nametab == '\0')              /* Table name ended */
6280
      {
6281
        if(!isalnum(*w_name) && *w_name != SUBSCRIPT_INPUT_SIGN)
6282
          goto out;                      /* String name ended */
6283
        break;
6284
      }                                 /* Table name goes on */
6285
      if(!isalnum(*w_name) && *w_name != SUBSCRIPT_INPUT_SIGN)
6286
        break;                           /* String name ended */
6287
      if(*w_nametab != *w_name)
6288
        break;                             /* Different names */
6289
      w_nametab++;
6290
      w_name++;
6291
    }
6292
    nametab += NameLength1;
6293
    ++j;
6294
  }
6295
  out:
6296
  return j;
6297
}
6298
/*=GetGenerator===========================================================
6299
 Read single generator from description string
6300
*/
6301
void GetGenerator(char * str)
6302
{
6303
  char * name = GeneratorName + GeneratorN*NameLength1;
6304
  if(GeneratorN == GeneratorMaxN)
6305
    Error(E_GENERATOR_MAX_N);
6306
  do
6307
  {
6308
    if(*str == ODD_GENERATOR_INPUT_SIGN)        /* EVEN == 0 is assumed */
6309
      LIE_MONOMIAL_PARITY(GeneratorN) = ODD;
6310
    else
6311
      *(name++) = *str;
6312
  }while(*(str++));
6313
  LIE_MONOMIAL_ORDER(GeneratorN) =                 /* Standard settings */
6314
  LIE_MONOMIAL_POSITION(GeneratorN) = GeneratorN;
6315
  LIE_MONOMIAL_RIGHT(GeneratorN) = 1; /* To avoid SQUARE interpretation */
6316
  LIE_MONOMIAL_WEIGHT(GeneratorN++) = 1;
6317
}
6318
/*=GetInput===============================================================
6319
*/
6320
void GetInput(int n, char * fin)
6321
{
6322
  char *instr, *sfname, *in_case[N_INPUT_CASES];
6323
  FILE *inf;
6324
  uint i, j;
6325

6326
  in_case[GENERATORS]      = "G";
6327
  in_case[LIMITING_WEIGHT] = "L";
6328
  in_case[PARAMETERS]      = "P";
6329
  in_case[RELATIONS]       = "R";
6330
  in_case[WEIGHTS]         = "W";
6331

6332
  sfname = OutLine + PosOutLine;
6333
  if(n == 1)      /* No input file at call */
6334
  {
6335
    PutMessage(H_ENTER_FILE);
6336
    if (fgets(sfname, OutLineSize - PosOutLine, stdin)) {
6337
      // success
6338
      sfname[strcspn(sfname, "\n")] = '\0';
6339
    }
6340
    else {
6341
      // failure
6342
      exit(1);
6343
    }
6344
  }
6345
  else
6346
    do
6347
      *(sfname++) = *fin;
6348
    while(*(fin++));
6349
  sfname = OutLine;
6350
  while(YES)
6351
  {
6352
    if(*sfname == '.')
6353
      break;
6354
    if(*sfname == '\0')
6355
    {
6356
      *sfname = '.';
6357
      *++sfname = 'i';
6358
      *++sfname = 'n';
6359
      *++sfname = '\0';
6360
      break;
6361
    }
6362
    ++sfname;
6363
  }
6364
  /*
6365
  PutMessage(H_INPUT_FILE);
6366
  PutStringStandard(OutLine);
6367
  */
6368
#if defined(SPP_2000)
6369
  if((inf = fopen(OutLine, "r")) == NULL)
6370
#else
6371
  if((inf = fopen(OutLine, "rt")) == NULL)
6372
#endif
6373
  {	/* New file */
6374
    if(!BinaryQuestion(H_CREATE_NEW_FILE))
6375
      exit(1);
6376
    instr = (char *)alloca(InputStringSize);
6377
    if(instr == NULL)
6378
      Error(E_A_STACK_INPUT_STRING);
6379
    fgetc(stdin);
6380
#if defined(SPP_2000)
6381
    inf = OpenFile(OutLine, "w");
6382
#else
6383
    inf = OpenFile(OutLine, "wt");
6384
#endif
6385
    KeyBoardStringToFile(H_ENTER_GENERATORS, "Generators: ", instr, inf);
6386
    KeyBoardStringToFile(H_ENTER_WEIGHTS_IN_FILE, "Weights: ", instr, inf);
6387
    KeyBoardStringToFile(H_ENTER_LIMITING_WEIGHT, "Limiting weight: ",
6388
                                                               instr, inf);
6389
    KeyBoardStringToFile(H_ENTER_PARAMETERS, "Parameters: ", instr, inf);
6390
    if(KeyBoardStringToFile(H_ENTER_RELATIONS, "Relations:\n", instr, inf))
6391
    {
6392
      n = YES; /* Now non-last */
6393
      while(n && (j = KeyBoardBytesToString(instr)) > 0)
6394
        for(i = 0; i <= j; i++)
6395
        {
6396
          if(instr[i] == '.')
6397
            n = NO;             /* Last input */
6398
          fputc(instr[i], inf); /* Copy entered string to file */
6399
        }
6400
    }
6401
    fclose(inf);
6402
#if defined(SPP_2000)
6403
    inf = OpenFile(OutLine, "r");
6404
#else
6405
    inf = OpenFile(OutLine, "rt");
6406
#endif
6407
  }
6408
  if(EchoInput)
6409
  {
6410
    short c;
6411
    PutMessage(H_SHOW_INPUT);
6412
    while((c = fgetc(inf)) != EOF)
6413
      PutCharacter((char)c);
6414
  }
6415
  rewind(inf);
6416
  while(YES)
6417
    switch(ReadCaseFromFile(inf, in_case, N_INPUT_CASES))
6418
    {
6419
      case GENERATORS:
6420
        ReadAndProcessStringsFromFile(GetGenerator, inf, ' ', ';');
6421
        CUT_ARRAY(GeneratorName, char, NameLength1*GeneratorN);
6422
        LieMonomialFreePosition = LieMonomialN = GeneratorN;
6423
#if defined(SPACE_STATISTICS)
6424
        LieMonomialMaxN = LieMonomialN;
6425
#endif
6426
      break;
6427
      case WEIGHTS:    /* Should come after generators */
6428
        GeneratorMaxN = GeneratorN;
6429
        GeneratorN = 0;
6430
        ReadAndProcessStringsFromFile(GetWeight, inf, ' ', ';');
6431
        GeneratorN = GeneratorMaxN;
6432

6433
        /* Reorder generators in accordance with new weights */
6434

6435
        i = 1;
6436
        while(i < (uint)GeneratorN)
6437
        {
6438
          for(j = GeneratorN - 1; j >= i; j--)
6439
            if(LIE_MONOMIAL_WEIGHT(j-1) > LIE_MONOMIAL_WEIGHT(j))
6440
            {
6441
              byte wt;       /* To save swapped walues */
6442

6443
              /* Swap generator names */
6444

6445
              fin = GeneratorName + j*NameLength1; /* Next name */
6446
              instr = fin - NameLength1;           /* Previous name */
6447
              for(n = 1; n < NameLength1; n++)
6448
              {
6449
                wt = *instr;
6450
                *(instr++) = *fin;
6451
                *(fin++) = wt;
6452
              }
6453

6454
              /* Swap weights */
6455

6456
              wt = LIE_MONOMIAL_WEIGHT(j-1);
6457
              LIE_MONOMIAL_WEIGHT(j-1) = LIE_MONOMIAL_WEIGHT(j);
6458
              LIE_MONOMIAL_WEIGHT(j) = wt;
6459

6460
              /* Swap parities */
6461

6462
              wt = LIE_MONOMIAL_PARITY(j-1);
6463
              LIE_MONOMIAL_PARITY(j-1) = LIE_MONOMIAL_PARITY(j);
6464
              LIE_MONOMIAL_PARITY(j) = wt;
6465
            }
6466
          i++;
6467
        }
6468
      break;
6469
      case PARAMETERS:
6470
        IsParametric = YES;
6471
        LieLikeTermsCollection = LieLikeTermsCollectionParametric;
6472
        LieSumCopy = LieSumCopyParametric;
6473
        LieSumKill = LieSumKillParametric;
6474
        LieSumMinus = LieSumMinusParametric;
6475
        NormalizeRelation = NormalizeRelationParametric;
6476
        LieTermFromMonomial = LieTermFromMonomialParametric;
6477
        PairMonomialMonomial = PairMonomialMonomialParametric;
6478
        PairMonomialSum = PairMonomialSumParametric;
6479
        PairSumMonomial = PairSumMonomialParametric;
6480
        PairSumSum = PairSumSumParametric;
6481
        SubstituteRelationInRelation =
6482
                            SubstituteRelationInRelationParametric;
6483
        ParameterName = (char *)NewArray(NameLength1*ParameterMaxN,
6484
                                    sizeof(char), E_A_PARAMETER_NAME);
6485
        ParameterName[0] = 'i';         /* Obligatory imaginary unit */
6486
        ParameterN = 1;
6487
        ReadAndProcessStringsFromFile(GetParameter, inf, ' ', ';');
6488
        CUT_ARRAY(ParameterName, char, NameLength1*ParameterN);
6489
        NodeST =
6490
          (NODE_ST*)NewArray(NodeSTSize, sizeof(NODE_ST), E_A_NODE_ST);
6491
        i = 1;
6492
        j = 2;
6493
        while(j < NodeSTSize)     /* Install NodeST for scalar terms */
6494
          SCALAR_TERM_R(i++) = j++;
6495
#if defined(SPACE_STATISTICS)
6496
        SCALAR_TERM_R(i) = NOTHING;
6497
#else
6498
        SCALAR_TERM_R(i) = NIL;
6499
#endif
6500
        NodeSF =
6501
          (NODE_SF*)NewArray(NodeSFSize, sizeof(NODE_SF), E_A_NODE_SF);
6502
        i = 1;
6503
        j = 2;
6504
        while(j < NodeSFSize)   /* Install NodeSF for scalar factors */
6505
          SCALAR_FACTOR_R(i++) = j++;
6506
#if defined(SPACE_STATISTICS)
6507
        SCALAR_FACTOR_R(i) = NOTHING;
6508
#else
6509
        SCALAR_FACTOR_R(i) = NIL;
6510
#endif
6511
      break;
6512
      case RELATIONS:
6513
        if(!IsParametric)
6514
          NonZeroCoefficientsPut = NO;
6515
        ReadAndProcessStringsFromFile(GetRelation, inf, ';', '.');
6516
      break;
6517
      case LIMITING_WEIGHT:
6518
        LimitingWeight = ReadDecimalFromFile(inf);
6519
        while(fgetc(inf) != '\n')                 /* Go to next line */
6520
          ;
6521
      break;
6522
      case EOF:
6523
        goto out;
6524
      default:
6525
        Error(E_WRONG_INPUT_CASE);
6526
    }
6527
  out:
6528
  fclose(inf);
6529
  if(LimitingWeight == 0)
6530
  {
6531
    PutMessage(H_ENTER_LIMITING_WEIGHT);
6532
    scanf("%d", &LimitingWeight);
6533
#if !defined(GAP)
6534
    fprintf(SessionFile, "%d\n", LimitingWeight);
6535
#endif
6536
  }
6537
  TIME_ON;  /* First start of time */
6538
}
6539
/*=GetInteger===========================================================
6540
 Read big integer with shift in string.
6541
 A is already allocated array of LIMBs A[].
6542
*/
6543
void GetInteger(BIGINT a, char **pstr)
6544
{
6545
  BIGINT w;
6546
  int i;
6547
  LIMB digit[2], ten[2];
6548
  digit[0] = ten[0] = 1;
6549
  ten[1] = 10;
6550
  INTEGER_STACK_NEW(w, InputIntegerSize);
6551
  while(**pstr == '0')	/* Skip leading zeros */
6552
    ++*pstr;
6553
  if(isdigit(**pstr))
6554
  {                     /* First digit: IntegerProduct does not eat 0 */
6555
    a[0] = 1;
6556
    a[1] = (LIMB)(**pstr - '0');
6557
    while(isdigit(*(++*pstr)))
6558
    {
6559
      IntegerProduct(w, a, ten);                              /* a*10 */
6560
      i = w[0];
6561
      while(i >= 0) {
6562
        a[i] = w[i];                                 /* Copy w to a */
6563
        i--;
6564
      }
6565
      if((digit[1] = (LIMB)(**pstr - '0')) != 0)
6566
        IntegerSum(a, a, digit);                      /* a*10 + digit */
6567
    }
6568
  }
6569
  else        /* Caller interprets absence as  */
6570
    a[0] = 0; /* 1 (or 0) depending on context */
6571
}
6572
/*=GetLieMonomial=========================================================
6573
 Read monomial from string with transformations and substitutions
6574
*/
6575
uint GetLieMonomial(char **pstr)
6576
{
6577
  int mon;
6578
  uint a;
6579
IN_GET_LIE_MONOMIAL   /*------------------------------------------------*/
6580
  if(isalpha(**pstr))
6581
    if((mon=FindNameInTable(*pstr,GeneratorName,GeneratorN)) < GeneratorN)
6582
    {
6583
      BIGINT num;
6584
      SkipName(pstr);
6585
      SkipSpaces(pstr);
6586
      a = NodeLTNew();
6587
      LIE_TERM_MONOMIAL(a) = mon;
6588
      INTEGER_HEAP_NEW(num, 2);     /* Make integer 1 */
6589
      num[0] = num[1] = 1;
6590
      if(IsParametric)
6591
      {
6592
        uint st = NodeSTNew();
6593
        SCALAR_TERM_MONOMIAL(st) = NIL;
6594
        SCALAR_TERM_NUMERATOR(st) = num;
6595
        LIE_TERM_NUMERATOR_SCALAR_SUM(a) = st;
6596
        LIE_TERM_DENOMINATOR_SCALAR_SUM(a) = NIL;
6597
      }
6598
      else
6599
      {
6600
        LIE_TERM_NUMERATOR_INTEGER(a) = num;
6601
        LIE_TERM_DENOMINATOR_INTEGER(a) = NULL;
6602
      }
6603
    }
6604
    else
6605
      Error(E_UNDECLARED_GENERATOR);
6606
  else if(**pstr == '[')
6607
  {
6608
    uint b;
6609
    SkipSpaces(pstr);
6610
    ++*pstr;
6611
    a = GetLieMonomial(pstr);
6612
    SkipSpaces(pstr);
6613
    if(**pstr != ',')
6614
      Error(E_NO_COMMUTATOR_COMMA);
6615
    ++*pstr;
6616
    SkipSpaces(pstr);
6617
    b = GetLieMonomial(pstr);
6618
    SkipSpaces(pstr);
6619
    if(**pstr != ']')
6620
      Error(E_NO_COMMUTATOR_BRACKET);
6621
    ++*pstr;
6622
    a = (*PairSumSum)(a, b);
6623
  }
6624
  else
6625
    Error(E_INVALID_CHARACTER);
6626
OUT_GET_LIE_MONOMIAL  /*------------------------------------------------*/
6627
  return a;
6628
}
6629
/*=GetLieSum=====================================================
6630
 Read Lie expression from string and make internal representation
6631
*/
6632
uint GetLieSum(char **pstr)
6633
{
6634
  uint lsum, term;
6635
  int sign = PLUS;
6636
IN_GET_LIE_SUM   /*--------------------------------------------*/
6637
  SkipSpaces(pstr);
6638
  if(**pstr == '-')
6639
  {
6640
    sign = MINUS;
6641
    ++*pstr;
6642
    SkipSpaces(pstr);
6643
  }
6644
  lsum = GetLieTerm(pstr);
6645
  SkipSpaces(pstr);
6646
  if(sign)
6647
    LieSumMinus(lsum);
6648
  while(**pstr == '+' || **pstr == '-')
6649
  {
6650
    sign = (**pstr == '+') ? PLUS : MINUS;
6651
    ++*pstr;
6652
    SkipSpaces(pstr);
6653
    term = GetLieTerm(pstr);
6654
    SkipSpaces(pstr);
6655
    if(sign)
6656
      LieSumMinus(term);
6657
    lsum = LieSumAddition(lsum, term);
6658
  }
6659
OUT_GET_LIE_SUM  /*--------------------------------------------*/
6660
  return lsum;
6661
}
6662
/*=GetLieTerm===========================================================
6663
*/
6664
uint GetLieTerm(char **pstr)
6665
{
6666
  uint lterm;
6667
IN_GET_LIE_TERM   /*--------------------------------------------------*/
6668
  if(IsParametric)
6669
  {
6670
    uint num = GetScalarSum(pstr),
6671
       den = NIL;
6672
    SkipSpaces(pstr);
6673
    if(**pstr == '/')
6674
    {
6675
      ++*pstr;
6676
      SkipSpaces(pstr);
6677
      den = GetScalarSum(pstr);
6678
      ScalarSumCancellation(&num, &den);
6679
    }
6680
    lterm = GetLieMonomial(pstr);    /* May be sum with generic coeffs */
6681
    if(den != NIL)
6682
      LieSumDivScalarSum(lterm, den);
6683
    LieSumMultScalarSum(lterm, num);
6684
  }
6685
  else
6686
  {
6687
    BIGINT num, den;
6688
    INTEGER_STACK_NEW(num, InputIntegerSize);
6689
    INTEGER_STACK_NEW(den, InputIntegerSize);
6690
    GetInteger(num, pstr);
6691
    den[0] = 0;
6692
    SkipSpaces(pstr);
6693
    if(**pstr == '/')
6694
    {
6695
      ++*pstr;
6696
      SkipSpaces(pstr);
6697
      GetInteger(den, pstr);
6698
      SkipSpaces(pstr);
6699
      IntegerCancellation(num, den);
6700
    }
6701
    lterm = GetLieMonomial(pstr);    /* May be sum with generic coeffs */
6702
    if(den[0] != 0 && (den[0] != 1 || den[1] != 1))
6703
      LieSumDivInteger(lterm, den);
6704
    if(num[0] != 0 &&
6705
       (INTEGER_IS_NEGATIVE(num) || num[0] != 1 || num[1] != 1))
6706
      LieSumMultInteger(lterm, num);
6707
  }
6708
OUT_GET_LIE_TERM  /*--------------------------------------------------*/
6709
  return lterm;
6710
}
6711
/*=GetUInteger====================================
6712
 Read with shift long unsigned integer from string
6713
*/
6714
uint GetUInteger(char **pstr)
6715
{
6716
  uint i = 0;
6717
  while(isdigit(**pstr))
6718
  {
6719
    i = i*10 + **pstr - '0';
6720
    ++*pstr;
6721
  }
6722
  return i;
6723
}
6724
/*=GetParameter=====================================================
6725
 Read single parameter from description string
6726
*/
6727
void GetParameter(char * str)
6728
{
6729
  if(str[0] != 'i' || str[1] != '\0') /* Skip already settled `i' */
6730
  {
6731
    char * name = ParameterName + ParameterN*NameLength1;
6732
    if(ParameterN == ParameterMaxN)
6733
      Error(E_PARAMETER_MAX_N);
6734
    do
6735
      *(name++) = *str;
6736
    while(*(str++));
6737
    ++ParameterN;
6738
  }
6739
}
6740
/*=GetRelation===============================================================
6741
 Read single relation from string, reduce and set in array
6742
*/
6743
void GetRelation(char * str)
6744
{
6745
  uint a;
6746
  if(str[0] != '\0' && (a = GetLieSum(&str)) != NIL)
6747
  {
6748
    int lmonpos, pos, i, l;
6749
    if(RelationN + 1 == RelationSize)
6750
      Error(E_RELATION_SIZE);
6751
    (*NormalizeRelation)(a);
6752
    lmonpos = LIE_TERM_MONOMIAL(a);
6753
    i = LIE_MONOMIAL_ORDER(lmonpos);
6754
    l = FindNewPositionInRelation(i);
6755
    LIE_MONOMIAL_INDEX(lmonpos) = ~l;  /* Set int of relation in LieMonomial */
6756
    while(++i < LieMonomialN)     /* Shift int's of relations in LieMonomial */
6757
      if(LIE_MONOMIAL_IS_LEADING(pos = LIE_MONOMIAL_POSITION(i)))
6758
        --LIE_MONOMIAL_INDEX(pos);
6759
    for(i = RelationN; i > l; i--) /* Make room moving Relation structures */
6760
      Relation[i] = Relation[i-1];
6761
    RELATION_MIN_GENERATOR(l) = LIE_MONOMIAL_IS_GENERATOR(lmonpos) ?
6762
            GeneratorN /* Don't differentiate leading generator */ : 0;
6763
    RELATION_LIE_SUM(l) = a;
6764
    RELATION_TO_BE_SUBSTITUTED(l) = (byte)(l < RelationN);
6765
    ++RelationN;
6766
#if defined(SPACE_STATISTICS)
6767
    if(RelationN > MaxNRelation)
6768
      MaxNRelation = RelationN;
6769
#endif
6770
    ReduceRelations(l);
6771
  }
6772
}
6773
/*=GetScalarSum==================================================
6774
*/
6775
uint GetScalarSum(char **pstr)
6776
{
6777
  uint a, term;
6778
  int is_par, is_negative;
6779
  if(**pstr == '(')
6780
  {
6781
    is_par = YES;
6782
    ++*pstr;
6783
    SkipSpaces(pstr);
6784
  }
6785
  else
6786
    is_par = NO;
6787
  if(**pstr == '-')
6788
  {
6789
    is_negative = YES;
6790
    ++*pstr;
6791
    SkipSpaces(pstr);
6792
  }
6793
  else
6794
    is_negative = NO;
6795
  a = GetScalarTerm(pstr);
6796
  if(is_negative)
6797
    ScalarSumMinus(a);
6798
  while(**pstr == '+' || **pstr == '-')
6799
  {
6800
    is_negative = (**pstr == '+') ? NO : YES;
6801
    ++*pstr;
6802
    SkipSpaces(pstr);
6803
    term = GetScalarTerm(pstr);
6804
    if(is_negative)
6805
      ScalarSumMinus(term);
6806
    a = ScalarSumAddition(a, term);
6807
  }
6808
  if(is_par)
6809
  {
6810
    if(**pstr != ')')
6811
      Error(E_NO_R_PARENTHESIS);
6812
    ++*pstr;
6813
    SkipSpaces(pstr);
6814
  }
6815
  return a;
6816
}
6817
/*=GetScalarTerm=========================================================
6818
 Read unsigned scalar term in Parametric regime
6819
*/
6820
uint GetScalarTerm(char **pstr)
6821
{
6822
  BIGINT nums, numh;
6823
  int i, change_sign;
6824
  uint m, f, a = NodeSTNew();
6825

6826
  /* Read numerical coefficient */
6827

6828
  INTEGER_STACK_NEW(nums, InputIntegerSize);
6829
  GetInteger(nums, pstr);
6830
  if(nums[0] == 0)
6831
    nums[0] = nums[1] = 1;
6832
  INTEGER_HEAP_COPY(numh, nums, i);
6833
  SCALAR_TERM_NUMERATOR(a) = numh;
6834

6835
  /* Read scalar monomial */
6836

6837
  SkipSpaces(pstr);
6838
  m = NIL;
6839
  while(isalpha(**pstr) &&
6840
        (i=FindNameInTable(*pstr,ParameterName,ParameterN)) < ParameterN)
6841
  {
6842
    f = NodeSFNew();
6843
    SCALAR_FACTOR_PARAMETER(f) = i;
6844
    SkipName(pstr);
6845
    SkipSpaces(pstr);
6846
    if(**pstr == '^')
6847
    {
6848
      ++*pstr;
6849
      SkipSpaces(pstr);
6850
      if(isdigit(**pstr))
6851
      {
6852
        i = (byte)GetUInteger(pstr);                   /* Read degree */
6853
        SkipSpaces(pstr);
6854
      }
6855
      else
6856
        Error(E_NO_GENERAL_POWER);
6857
    }
6858
    else
6859
      i = 1;
6860
    SCALAR_FACTOR_DEGREE(f) = i;                /* Degree of parameter */
6861
    m = ScalarMonomialMultiplication(&change_sign, m, f);
6862
    if(change_sign)
6863
      SCALAR_TERM_MINUS(a);
6864
  }
6865
  SCALAR_TERM_MONOMIAL(a) = m;
6866
  return a;
6867
}
6868
/*=GetWeight=================================================
6869
 Read single generator weight from description string
6870
*/
6871
void GetWeight(char *str)
6872
{
6873
  if(GeneratorN == GeneratorMaxN)
6874
    Error(E_TOO_MUCH_INPUT_WEIGHTS);
6875
  if(!isdigit(*str))
6876
    Error(E_NON_NUM_INPUT_WEIGHT);
6877
  LIE_MONOMIAL_WEIGHT(GeneratorN++) = (byte)GetUInteger(&str);
6878
}
6879
/*=KeyBoardBytesToString=====================
6880
  Returns 0 for the last input (ended by '.')
6881
  and last position otherwise
6882
*/
6883
int KeyBoardBytesToString(char *str)
6884
{
6885
  char c;
6886
  int inspace = YES, i = -1;
6887
  while((c = fgetc(stdin)) != '\n')
6888
  {
6889
    if(c == ' ')
6890
    {
6891
      if(inspace)
6892
        continue;     /* Skip extra blanks */
6893
      inspace = YES;
6894
    }
6895
    else
6896
      inspace = NO;
6897
    PutCharacter(c);
6898
    if(c == '\b')
6899
    {
6900
#if !defined(GAP)
6901
       fseek(SessionFile, -2, SEEK_CUR);
6902
#endif
6903
       --i;
6904
    }
6905
    else
6906
    {
6907
      if(++i == InputStringSize)
6908
        Error(E_INPUT_STRING_SIZE);
6909
      str[i] = c;
6910
    }
6911
  }
6912
  putchar('\n');
6913
  if(i < 0)  		    /* Empty input */
6914
    return 0;
6915
  if(str[i] != ';' && str[i] != '.')
6916
  {          /* Add semicolon if necessary */
6917
    if(++i == InputStringSize)
6918
      Error(E_INPUT_STRING_SIZE);
6919
    str[i] = ';';
6920
  }
6921
  if(++i == InputStringSize)
6922
    Error(E_INPUT_STRING_SIZE);
6923
  str[i] = '\n';         /* Go to new line */
6924
  return i;
6925
}
6926
/*=KeyBoardStringToFile==========================================
6927
 Add string from keyboard to file between prefix and semicolon
6928
*/
6929
int KeyBoardStringToFile(int i_m, char * prefix, char * str, FILE *file)
6930
{
6931
  short itop;
6932
  PutMessage(i_m);
6933
  itop = KeyBoardBytesToString(str);
6934
  if(itop)
6935
  {
6936
    short i = 0;
6937
    while(*prefix)
6938
      fputc(*(prefix++), file);	/* Copy prefix to file */
6939
    while(i <= itop)
6940
      fputc(str[i++], file);	/* Copy entered string to file */
6941
  }
6942
  return itop;
6943
}
6944
/*=ReadAndProcessStringsFromFile==================================
6945
 Read array of strings separated by `sep' and ended with `end'
6946
 Remove comments and unnecessary spaces
6947
 Add ending '\0'   Process strings by (*proc_func)
6948
*/
6949
void ReadAndProcessStringsFromFile(void (*proc_func)(char *str), FILE *inf,
6950
                                                     char sep, char end)
6951
{
6952
  char *str, *wstr;
6953
  char line_break;
6954
  short c;
6955
  int i;
6956
  str = (char *)alloca(InputStringSize);
6957
  if(str == NULL)
6958
    Error(E_A_STACK_INPUT_STRING);
6959
  line_break = (sep == ' ') ? '\n' : '\0';
6960
  wstr = str;
6961
  i = 0;       /* Count number of characters */
6962
  while(YES)
6963
  {
6964
    if((c = fgetc(inf)) == sep || c == line_break || c == end)
6965
    {
6966
      if(wstr != str && wstr[-1] == ' ')
6967
        wstr[-1] = '\0';         /* Kill ending blank */
6968
      else
6969
        *wstr = '\0';
6970
      (*proc_func)(str);         /* Process string */
6971
      if(c == end)               /* Last */
6972
        break;
6973
      wstr = str;                /* Intermediate */
6974
      i = 0;                     /* Count number of characters */
6975
      while((c = SkipSpacesInFile(inf)) == LEFT_COMMENT)
6976
        SkipCommentInFile(inf);
6977
      if(c == EOF)
6978
        break;
6979
      continue;
6980
    }
6981
    if(isspace(c))
6982
    {
6983
      if(++i == InputStringSize)
6984
        Error(E_INPUT_STRING_SIZE);
6985
      *(wstr++) = ' ';
6986
      SkipSpacesInFile(inf);
6987
      continue;
6988
    }
6989
    if(c == LEFT_COMMENT)
6990
    {
6991
      if(*wstr != ' ')
6992
      {
6993
        if(++i == InputStringSize)
6994
          Error(E_INPUT_STRING_SIZE);
6995
        *(wstr++) = ' ';
6996
      }
6997
      do
6998
        SkipCommentInFile(inf);
6999
      while((c = SkipSpacesInFile(inf)) == LEFT_COMMENT);
7000
      continue;
7001
    }
7002
    if(++i == InputStringSize)
7003
      Error(E_INPUT_STRING_SIZE);
7004
    *(wstr++) = (char)c;
7005
  }
7006
}
7007
/*=ReadBooleanFromFile========================
7008
  Read boolean constant from file
7009
*/
7010
int ReadBooleanFromFile(FILE *file)
7011
{
7012
  short c;
7013
  int bool;
7014
  c = fgetc(file);
7015
  switch(c)
7016
  {
7017
    case 'Y': case 'y':
7018
    bool = YES;
7019
    break;
7020
    case 'N': case 'n':
7021
    bool = NO;
7022
    break;
7023
  }
7024
  while(!isspace(c = fgetc(file)) && c != EOF)
7025
    ;
7026
  ungetc(c, file);
7027
  return bool;
7028
}
7029
/*=ReadCaseFromFile=====================================
7030
*/
7031
int ReadCaseFromFile(FILE * file, char * case_str[], int n_cases)
7032
{
7033
  char file_str[CASE_STRING_SIZE];
7034
  char * w_file_str, *w_case_str;
7035
  int i_case;
7036
  short c;
7037
  while(SkipSpacesInFile(file) == LEFT_COMMENT)
7038
    SkipCommentInFile(file);
7039

7040
  /* Read string ending with : from file */
7041

7042
  w_file_str = file_str;
7043
  do
7044
  {
7045
    if((c = fgetc(file)) == EOF)
7046
    {
7047
      i_case = c;
7048
      goto out;
7049
    }
7050
    if(c == ':')
7051
      c = '\0';
7052
    *(w_file_str++) = (char)c;
7053
  }while(c);
7054

7055
  /* Compare strings */
7056

7057
  i_case = 0;
7058
  do
7059
  {
7060
    w_file_str = file_str;
7061
    w_case_str = case_str[i_case];
7062
    do
7063
    {
7064
      if(*w_case_str == '\0')  /* Case is found */
7065
      {
7066
        while(SkipSpacesInFile(file) == LEFT_COMMENT)
7067
          SkipCommentInFile(file);
7068
        goto out;
7069
      }
7070
      if(*w_file_str == '\0')
7071
        break;
7072
    }while(*(w_file_str++) == *(w_case_str++));
7073
  }while(++i_case < n_cases);
7074
  out:
7075
  return i_case;
7076
}
7077
/*=ReadDecimalFromFile===================
7078
  Read unsigned decimal integer from file
7079
*/
7080
uint ReadDecimalFromFile(FILE *file)
7081
{
7082
  short c;
7083
  uint i = 0;
7084
  while(isdigit(c = fgetc(file)))
7085
    i = i*10 + c - '0';
7086
  ungetc(c, file);
7087
  return i;
7088
}
7089
/*=ReadStringFromFile====================
7090
*/
7091
short ReadStringFromFile(char * str, FILE *file)
7092
{
7093
  short c;
7094
  while((c = fgetc(file)) != '\n')
7095
  {
7096
    if(c == LEFT_COMMENT)
7097
    {
7098
      ungetc(c, file);
7099
      break;
7100
    }
7101
    if(c == EOF)
7102
      break;
7103
    if(!isspace(c))
7104
      *(str++) = (char)c;
7105
  }
7106
  return c;
7107
}
7108
/*=SkipCommentInFile=======================
7109
*/
7110
short SkipCommentInFile(FILE *file)
7111
{
7112
  short c;
7113
  while((c = fgetc(file)) != RIGHT_COMMENT)
7114
    if(c == EOF)
7115
      Error(E_UNEXPECTED_EOF);
7116
  return c;
7117
}
7118
/*=SkipName===============================================
7119
*/
7120
void SkipName(char **pstr)
7121
{
7122
  while(isalnum(**pstr) || **pstr == SUBSCRIPT_INPUT_SIGN)
7123
    ++*pstr;
7124
}
7125
/*=SkipSpaces==================
7126
 Skip spaces to right in string
7127
*/
7128
void SkipSpaces(char **pstr)
7129
{
7130
  while(isspace(**pstr))
7131
    ++*pstr;
7132
}
7133
/*=SkipSpacesInFile==============
7134
  Returns first non-space symbol
7135
*/
7136
short SkipSpacesInFile(FILE *file)
7137
{
7138
  short c;
7139
  while(isspace(c = fgetc(file)))
7140
    ;
7141
  ungetc(c, file);
7142
  return c;
7143
}
7144

7145
/*_6_9          Output functions========================================*/
7146

7147
/*=AddSymbolToOutLine!===============
7148
 Add symbol to output line OutLine
7149
*/
7150
void AddSymbolToOutLine(char c, int position)
7151
{
7152
  if(position >= OutLineSize)
7153
    Error(E_OUT_LINE_SIZE);
7154
  OutLine[position] = c;
7155
}
7156
/*=InLineLevel==============================
7157
 Install level in OutLine
7158
*/
7159
void InLineLevel(int level)
7160
{
7161
  if(level != CurrentLevel)
7162
  {
7163
    AddSymbolToOutLine(LEVEL, ++PosOutLine);
7164
    AddSymbolToOutLine((char)level, ++PosOutLine);
7165
    CurrentLevel = level;
7166
    if(level > MaxLevel)
7167
      MaxLevel = level;
7168
    else if(level < MinLevel)
7169
      MinLevel = level;
7170
  }
7171
}
7172
/*=InLineNumberInBrackets=====
7173
 (With 2 blanks after)
7174
*/
7175
void InLineNumberInBrackets(uint n)
7176
{
7177
  InLineSymbol('(');
7178
  InLineString(UToString(n));
7179
  InLineString(")  ");
7180
}
7181
/*=InLineString!================================
7182
 Add string to output line OutLine for 2D output
7183
*/
7184
void InLineString(char *str)
7185
{
7186
  while(*str)
7187
    InLineSymbol(*(str++));
7188
}
7189
/*=InLineSubscript================
7190
 Add symbolic subscript to OutLine
7191
*/
7192
void InLineSubscript(char * s)
7193
{
7194
  int level = CurrentLevel;
7195
  InLineLevel(level - 1);
7196
  InLineString(s);
7197
  InLineLevel(level);
7198
}
7199
/*=InLineSymbol!================================
7200
 Add symbol to output line OutLine for 2D output
7201
*/
7202
void InLineSymbol(char symbol)
7203
{
7204
  AddSymbolToOutLine(symbol, ++PosOutLine);
7205
  ++LastItemEnd;
7206
}
7207
/*=InLineTableName===================
7208
 Possibly subscripted
7209
*/
7210
void InLineTableName(char * name)
7211
{
7212
  PreviousEnd = LastItemEnd;
7213
  while(*name)
7214
  {
7215
    if(*name == SUBSCRIPT_INPUT_SIGN)
7216
    {
7217
      InLineSubscript(++name);
7218
      break;
7219
    }
7220
    InLineSymbol(*(name++));
7221
  }
7222
}
7223
/*=UToString!====================================
7224
 Transform unsigned long number to decimal string
7225
*/
7226
char * UToString(uint n)
7227
{                            /*12345678910*/
7228
  static char decimal_string[] = "4294967295";
7229
  char * first = decimal_string + 10;
7230
  do
7231
  {
7232
    *--first = '0' + (char)(n % 10);
7233
    n /= 10;
7234
  }while(n);
7235
  return first;
7236
}
7237
/*=PutBasis============================================
7238
 Set index numbers and print basis elements
7239
*/
7240
void PutBasis(void)
7241
{
7242
  int pos, ord;
7243
  uint  i = 0;      /* Index number of basis element */
7244
  TIME_OFF;
7245
  if(BasisElementsPut)
7246
    PutMessage(H_BASIS_ELEMENTS);
7247
  for(ord = 0; ord < LieMonomialN; ord++)
7248
  {
7249
    pos = LIE_MONOMIAL_POSITION(ord);
7250
    if(LIE_MONOMIAL_IS_BASIS(pos))
7251
    {
7252
      LIE_MONOMIAL_INDEX(pos) = ++i;
7253
      if(BasisElementsPut)
7254
      {
7255
        PutStart();
7256
        InLineNumberInBrackets(i);
7257
        PutLieBasisElement(pos);
7258
        InLineString(" = ");
7259
        IN_LINE_MARGIN;
7260
        (*PutLieMonomial)(pos);
7261
        PutEnd();
7262
      }
7263
    }
7264
  }
7265
  if(BasisElementsPut)
7266
    if(IncompletedBasis)
7267
      PutDots();
7268
  TIME_ON;
7269
}
7270
#if defined(GAP)
7271
/*=PutBasisGAP=============================================
7272

7273
 Print basis elements into GAP file
7274
*/
7275
void PutBasisGAP(void)
7276
{
7277
  int pos, ord, tord;
7278
  tord = LieMonomialN - 1;
7279
  while(YES)
7280
  {
7281
    if(LIE_MONOMIAL_IS_BASIS(LIE_MONOMIAL_POSITION(tord)))
7282
      break;
7283
    --tord;
7284
  }
7285
  PutStringStandard(GAPBasisName);
7286
  PutStringStandard(":=[\n");
7287
  for(ord = 0; ord <= tord; ord++)
7288
  {
7289
    pos = LIE_MONOMIAL_POSITION(ord);
7290
    if(LIE_MONOMIAL_IS_BASIS(pos))
7291
    {
7292
      PosOutLine = -1;
7293
      PutLieMonomialGAP(pos);
7294
      if(ord < tord)
7295
        PutStringGAP(",\n");
7296
    }
7297
  }
7298
  PutStringStandard("\n];\n");
7299
}
7300
#endif
7301
/*=PutBlock==============================================================
7302
 Print block of 2D output
7303
*/
7304
void PutBlock(void)
7305
{
7306
  if(!PrintEnd && (LastItemEnd > LineLength || PreviousEnd==LastItemEnd))
7307
    PrintEnd = PreviousEnd;
7308
  if(PrintEnd && CurrentLevel <= MAIN_LEVEL)
7309
  {
7310
    int xp, yp = MaxLevel, i, prlvl;
7311
    while(yp >= MinLevel)
7312
    {
7313
      for(xp = 1; xp <= Margin; xp++)
7314
        PutCharacter(' ');
7315
      i = 0;
7316
      while(xp <= PrintEnd)
7317
      {
7318
        switch(OutLine[i])
7319
        {
7320
          case LEVEL:
7321
            prlvl = OutLine[++i];
7322
            break;
7323
          case MARGIN:
7324
            NewMargin = xp - 1;
7325
            break;
7326
          default:
7327
            PutCharacter((char)((prlvl == yp) ? OutLine[i] : ' '));
7328
            xp++;
7329
        }
7330
        i++;
7331
      }
7332
      PutCharacter('\n');
7333
      yp--;
7334
    }
7335
    PutCharacter('\n'); /* To next line */
7336
    Margin = NewMargin;
7337
    LastItemEnd += Margin - PrintEnd;
7338
    PrintEnd = 0;
7339
    xp = i;
7340
    while(OutLine[xp] != LEVEL)
7341
      xp--;
7342
    *OutLine = LEVEL;
7343
    OutLine[1] = MaxLevel = MinLevel = OutLine[xp + 1];
7344
    xp = PosOutLine;
7345
    PosOutLine = 1;
7346
    while(i <= xp)
7347
    {
7348
      OutLine[++PosOutLine] = OutLine[i];
7349
      if(OutLine[i++] == LEVEL)
7350
      {
7351
        if(OutLine[i] > MaxLevel)
7352
          MaxLevel = OutLine[i];
7353
        else if(OutLine[i] < MinLevel)
7354
          MinLevel = OutLine[i];
7355
      }
7356
    }
7357
  }
7358
}
7359
/*=PutCharacter!=============
7360
   Echoed output of character
7361
*/
7362
void PutCharacter(char c)
7363
{
7364
#if defined(ECHO_TO_SCREEN)
7365
  putc(c, stdout);
7366
#endif
7367
#if !defined(GAP)
7368
  putc(c, SessionFile);
7369
#endif
7370
}
7371
#if defined(GAP)
7372
/*=PutCharacterGAP!======================
7373
   Echoed output of character in GAP file
7374
*/
7375
void PutCharacterGAP(char c)
7376
{
7377
#if defined(ECHO_TO_SCREEN)
7378
  putc(c, stdout);
7379
#endif
7380
/*  putc(c, SessionFile);  */
7381
  PosOutLine++;
7382
}
7383
#endif
7384
/*=PutCoefficientTable=================================
7385
 Print list of non-zero coefficients
7386
*/
7387
void PutCoefficientTable(void)
7388
{
7389
  int i, j = 0, first = YES;
7390
  TIME_OFF;
7391
  if(CoeffParamTable != NULL)
7392
  {
7393
    for(i = FIRST_GENUINE_PARAMETER; i < ParameterN; i++)
7394
      if(CoeffParamTable[i])
7395
      {
7396
        if(first)
7397
        {
7398
          first = NO;
7399
          PutMessage(H_NON_ZERO_COEFFICIENTS);
7400
        }
7401
        PutStart();
7402
        InLineNumberInBrackets(++j);
7403
        InLineTableName(ParameterName + i*NameLength1);
7404
        PutEnd();
7405
      }
7406
    free(CoeffParamTable);
7407
  }
7408
  if(CoeffSumTableN)
7409
  {
7410
    if(first)
7411
    {
7412
      first = NO;
7413
      PutMessage(H_NON_ZERO_COEFFICIENTS);
7414
    }
7415
    for(i = 0; i < CoeffSumTableN; i++)
7416
    {
7417
      PutStart();
7418
      InLineNumberInBrackets(++j);
7419
      IN_LINE_MARGIN;
7420
      PutScalarSum(CoeffSumTable[i]);
7421
      PutEnd();
7422
      ScalarSumKill(CoeffSumTable[i]);
7423
    }
7424
    free(CoeffSumTable);
7425
  }
7426
  TIME_ON;
7427
}
7428
/*=PutCommutators========================================================
7429
 Compute and print commutators of basis elements [E(O),E(O)] -> E(O)
7430
*/
7431
void PutCommutators(void)
7432
{
7433
  int oi, oj, i, j, was_comm, set_minus;
7434
  uint icomm, rpart;
7435
  byte weight_j;
7436
  TIME_OFF;
7437
  PutMessage(H_COMMUTATORS);
7438
  TIME_ON;
7439
  icomm = 0;
7440
  for(oj = 0; oj < LieMonomialN; oj++)
7441
    if(LIE_MONOMIAL_IS_BASIS(j = LIE_MONOMIAL_POSITION(oj)))
7442
    {
7443
      weight_j = LIE_MONOMIAL_WEIGHT(j);
7444
      was_comm = NO;
7445
      set_minus = LIE_MONOMIAL_IS_EVEN(j);
7446
      for(oi = 0; oi < oj ||
7447
                  (oi == oj &&
7448
                   LIE_MONOMIAL_IS_ODD(LIE_MONOMIAL_POSITION(oi))); oi++)
7449
        if(weight_j + LIE_MONOMIAL_WEIGHT(i = LIE_MONOMIAL_POSITION(oi))
7450
           <= LimitingWeight)
7451
        {
7452
          if(LIE_MONOMIAL_IS_BASIS(i))
7453
          {
7454
            if(LIE_MONOMIAL_IS_EVEN(i))
7455
              set_minus = YES;
7456
            rpart = (*PairMonomialMonomial)(j, i);
7457
            if(rpart != NIL)
7458
            {
7459
              TIME_OFF;
7460
              PutStart();
7461
              InLineNumberInBrackets(++icomm);
7462
              InLineSymbol('[');
7463
              PutLieBasisElement(i);
7464
              InLineSymbol(',');
7465
              PutLieBasisElement(j);
7466
              InLineString("] = ");
7467
              IN_LINE_MARGIN;
7468
              if(set_minus)
7469
                (*LieSumMinus)(rpart);
7470
              PutLieSum(PutLieBasisElement, rpart);
7471
              LieSumKill(rpart);
7472
              PutEnd();
7473
              TIME_ON;
7474
            }
7475
          }
7476
          was_comm = YES;
7477
        }
7478
        else
7479
        {
7480
          if(was_comm)
7481
          {
7482
            while(oi < oj ||
7483
                 (oi == oj &&
7484
                  LIE_MONOMIAL_IS_ODD(LIE_MONOMIAL_POSITION(oi))))
7485
            {
7486
              if(LIE_MONOMIAL_IS_BASIS(LIE_MONOMIAL_POSITION(oi)))
7487
                ++icomm;
7488
              ++oi;
7489
            }
7490
            TIME_OFF;
7491
            PutDots();
7492
            PutCharacter('\n');
7493
            TIME_ON;
7494
          }
7495
          break;
7496
        }
7497
    }
7498
  TIME_OFF;
7499
  if(icomm == 0)
7500
    PutMessage(H_NO_PUT_COMMUTATORS);
7501
  TIME_ON;
7502
}
7503
#if defined(GAP)
7504
/*=PutCommutatorsGAP==================================
7505
 Transform commutators of ordinary finite-dimensional
7506
 parameter-free Lie algebra to GAP input format
7507
*/
7508
void PutCommutatorsGAP(void)
7509
{
7510
  int oi, oj, otop, i, j;
7511
  BIGINT num;
7512
  uint rpart, a, b;
7513
  otop = LieMonomialN - 1;
7514
  while(YES)
7515
  {
7516
    if(LIE_MONOMIAL_IS_BASIS(LIE_MONOMIAL_POSITION(otop)))
7517
      break;
7518
    --otop;
7519
  }
7520
  PutStringStandard(GAPAlgebraName);
7521
  PutStringStandard(":=[\n");   /* Begin main list */
7522
  for(oj = 0; oj <= otop; oj++)
7523
    if(LIE_MONOMIAL_IS_BASIS(j = LIE_MONOMIAL_POSITION(oj)))
7524
    {
7525
      PosOutLine = -1;
7526
      PutCharacterGAP('[');
7527
      for(oi = 0; oi <= otop; oi++)
7528
        if(LIE_MONOMIAL_IS_BASIS(i = LIE_MONOMIAL_POSITION(oi)))
7529
        {
7530
          if(oi == oj)
7531
            rpart = NIL;
7532
          else if(oj < oi)
7533
          {
7534
            rpart = (*PairMonomialMonomial)(i, j);
7535
            (*LieSumMinus)(rpart);
7536
          }
7537
          else
7538
            rpart = (*PairMonomialMonomial)(j, i);
7539
          if(rpart != NIL)
7540
          {
7541
            a = LIE_TERM_R(rpart);     /* Invert list */
7542
            LIE_TERM_R(rpart) = NIL;
7543
            while(a != NIL)
7544
            {
7545
              b = a;
7546
              a = LIE_TERM_R(a);
7547
              LIE_TERM_R(b) = rpart;
7548
              rpart = b;
7549
            }
7550
            PutStringGAP("[[");
7551
            a = rpart;      /* Put indices of basis elements */
7552
            while(YES)
7553
            {
7554
              PutStringGAP(UToString(LIE_MONOMIAL_INDEX(
7555
                                       LIE_TERM_MONOMIAL(a))));
7556
              a = LIE_TERM_R(a);
7557
              if(a == NIL)
7558
                break;
7559
              PutStringGAP(",");
7560
            }
7561
            PutStringGAP("],[");
7562
            a = rpart;                  /* Put coefficients */
7563
            while(YES)
7564
            {
7565
              num = LIE_TERM_NUMERATOR_INTEGER(a);
7566
              if(INTEGER_IS_NEGATIVE(num))
7567
                PutStringGAP("-");
7568
              PutIntegerUnsignedGAP(num);
7569
              if((num = LIE_TERM_DENOMINATOR_INTEGER(a)) != NULL)
7570
              {
7571
                PutStringGAP("/");
7572
                PutIntegerUnsignedGAP(num);
7573
              }
7574
              a = LIE_TERM_R(a);
7575
              if(a == NIL)
7576
                break;
7577
              PutStringGAP(",");
7578
            }
7579
            PutStringGAP("]]");
7580
            LieSumKill(rpart);
7581
          }
7582
          else
7583
            PutStringGAP("[[],[]]");
7584
          if(oi != otop)
7585
            PutStringGAP(",");
7586
        }
7587
      PutStringGAP("],");
7588
      PutCharacter('\n');
7589
    }
7590
  PutStringStandard("-1,0];\n");  /* Close main list */
7591
}
7592
#endif
7593
/*=PutDegree==========================
7594
 Print (positive) integer degree
7595
*/
7596
void PutDegree(uint deg)
7597
{
7598
  if(deg != 1)
7599
  {
7600
    int level = CurrentLevel;
7601
    InLineLevel(level + 1);
7602
    InLineString(UToString((uint)deg));
7603
    InLineLevel(level);
7604
    PutBlock();
7605
  }
7606
}
7607
/*=PutDimensions================================================
7608
  Print dimensions of homogeneous components of algebra
7609
*/
7610
void PutDimensions(void)
7611
{
7612
  int next, ord, pos;
7613
  byte   curwt;
7614
  uint   dim;
7615
  TIME_OFF;
7616
  PutMessage(H_HILBERT_SERIES);
7617
  PutStart();
7618
  InLineString("H(t) = ");
7619
  IN_LINE_MARGIN;
7620
  next = NO;
7621
  curwt = LIE_MONOMIAL_WEIGHT(0);     /* Start initial weight */
7622
  dim = 0;
7623
  for(ord = 0; ord < LieMonomialN; ord++)
7624
  {
7625
    pos = LIE_MONOMIAL_POSITION(ord);
7626
    if(LIE_MONOMIAL_IS_BASIS(pos))
7627
    {
7628
      if(LIE_MONOMIAL_WEIGHT(pos) != curwt)
7629
      {
7630
        if(dim != 0)
7631
        {
7632
          if(next)
7633
            PutString(" + ");
7634
          else
7635
            next = YES;
7636
          if(dim != 1)
7637
          {
7638
            PutString(UToString(dim));
7639
            PutSymbol(' ');
7640
          }
7641
          PutSymbol('t');
7642
          PutDegree(curwt);
7643
        }
7644
        curwt = LIE_MONOMIAL_WEIGHT(pos); /* Start new weight */
7645
        dim = 1;
7646
      }
7647
      else
7648
        dim++;
7649
    }
7650
  }
7651
  if(dim != 0)   /* Print last element */
7652
  {
7653
    if(next)
7654
      PutString(" + ");
7655
    if(dim != 1)
7656
    {
7657
      PutString(UToString(dim));
7658
      PutSymbol(' ');
7659
    }
7660
    PutSymbol('t');
7661
    PutDegree(curwt);
7662
  }
7663
  if(IncompletedBasis)
7664
    PutString(" + ...");
7665
  PutEnd();
7666
  TIME_ON;
7667
}
7668
/*=PutDots=============================
7669
 Print vertical dots
7670
*/
7671
void PutDots(void)
7672
{
7673
#if defined(ECHO_TO_SCREEN)
7674
  printf(" .\n .\n .\n");
7675
#endif
7676
#if !defined(GAP)
7677
  fprintf(SessionFile, " .\n .\n .\n");
7678
#endif
7679
}
7680
/*=PutEnd=======================
7681
   Print last block of 2D output
7682
*/
7683
void PutEnd(void)
7684
{
7685
  PreviousEnd = LastItemEnd;
7686
  PutBlock();
7687
}
7688
/*=PutFormattedU=================
7689
*/
7690
void PutFormattedU(char * format, uint i)
7691
{
7692
#if !defined(GAP)
7693
  fprintf(SessionFile, format, i);
7694
#endif
7695
#if defined(ECHO_TO_SCREEN)
7696
  printf(format, i);
7697
#endif
7698
}
7699
/*=PutLieBareTerm=======================================================
7700
 put_lie_mon == PutLieMonomial     -> in terms of generators,
7701
 put_lie_mon == PutLieBasisElement -> in terms of basis elements.
7702
*/
7703
void PutLieBareTerm(void (*put_lie_mon)(int a), uint a)
7704
{
7705
  int put_mult_sign = NO;
7706
  if(IsParametric)
7707
  {
7708
    uint num = LIE_TERM_NUMERATOR_SCALAR_SUM(a),
7709
      den = LIE_TERM_DENOMINATOR_SCALAR_SUM(a);
7710

7711
    /* Put numerator */
7712

7713
    if(SCALAR_TERM_R(num) != NIL)
7714
    {
7715
      PutSymbol('(');              /* Sum */
7716
      PutScalarSum(num);
7717
      PutSymbol(')');
7718
      put_mult_sign = YES;
7719
    }
7720
    else if(SCALAR_TERM_MONOMIAL(num) != NIL ||
7721
            INTEGER_IS_NOT_UNIT_ABS(SCALAR_TERM_NUMERATOR(num)) ||
7722
            den != NIL)
7723
    {
7724
      PutScalarBareTerm(num);     /* Single term */
7725
      put_mult_sign = YES;
7726
    }
7727

7728
    /* Put denominator */
7729

7730
    if(den != NIL)
7731
    {
7732
      PutSymbol('/');
7733
      if(SCALAR_TERM_R(den) == NIL &&  /* Single factor denominator */
7734
         (SCALAR_TERM_MONOMIAL(den) == NIL ||
7735
          INTEGER_IS_UNIT(SCALAR_TERM_NUMERATOR(den))))
7736
        PutScalarBareTerm(den);
7737
      else
7738
      {
7739
        PutSymbol('(');            /* Sum or multifactor denominator */
7740
        PutScalarSum(den);
7741
        PutSymbol(')');
7742
      }
7743
    }
7744
  }
7745
  else
7746
  {
7747
    BIGINT num = LIE_TERM_NUMERATOR_INTEGER(a),
7748
        den = LIE_TERM_DENOMINATOR_INTEGER(a);
7749
    if(den != NULL)
7750
    {
7751
      PutIntegerUnsigned(num);
7752
      PutSymbol('/');
7753
      PutIntegerUnsigned(den);
7754
      put_mult_sign = YES;
7755
    }
7756
    else if(INTEGER_IS_NOT_UNIT_ABS(num))
7757
    {
7758
      PutIntegerUnsigned(num);
7759
      put_mult_sign = YES;
7760
    }
7761
  }
7762
  if(put_mult_sign)
7763
    PutSymbol(' ');
7764
  (*put_lie_mon)(LIE_TERM_MONOMIAL(a));
7765
}
7766
/*=PutLieBasisElement======================================
7767
 Print Lie monomial in form E  or O
7768
                             i     i
7769
*/
7770
void PutLieBasisElement(int pos)
7771
{
7772
  InLineSymbol((char)(LIE_MONOMIAL_PARITY(pos) ? BasisSymbolOdd :
7773
                                          BasisSymbolEven));
7774
  InLineSubscript(UToString(LIE_MONOMIAL_INDEX(pos)));
7775
  PutBlock();
7776
}
7777
/*=PutLieMonomialLeftNormed=====================================
7778
 Put Lie monomial in terms of generators in left normed notation
7779
*/
7780
void PutLieMonomialLeftNormed(int pos)
7781
{
7782
  if(LIE_MONOMIAL_IS_GENERATOR(pos))
7783
  {
7784
    InLineTableName(GeneratorName + pos*NameLength1);
7785
    PutBlock();
7786
  }
7787
  else
7788
  {
7789
    uint deg = 1;
7790
    int posi = LIE_MONOMIAL_LEFT(pos),
7791
      posj = LIE_MONOMIAL_RIGHT(pos), posw;
7792
    while(LIE_MONOMIAL_IS_COMMUTATOR(posi))
7793
    {
7794
      pos = posi;
7795
      posi = LIE_MONOMIAL_LEFT(pos);
7796
      posw = LIE_MONOMIAL_RIGHT(pos);
7797
      if(posj == posw)
7798
        ++deg;
7799
      else
7800
      {
7801
        posi = pos;
7802
        break;
7803
      }
7804
    }
7805
    if(posi != posj)
7806
        PutLieMonomialLeftNormed(posi);
7807
    else
7808
      ++deg;
7809
    if(LIE_MONOMIAL_IS_COMMUTATOR(posj))
7810
    {
7811
      PutSymbol('(');
7812
      PutLieMonomialLeftNormed(posj);
7813
      PutSymbol(')');
7814
    }
7815
    else
7816
      PutLieMonomialLeftNormed(posj);
7817
    PutDegree(deg);
7818
  }
7819
}
7820
/*=PutLieMonomialStandard============================================
7821
 Put Lie monomial in terms of generators in standard bracket notation
7822
*/
7823
void PutLieMonomialStandard(int pos)
7824
{
7825
  if(LIE_MONOMIAL_IS_GENERATOR(pos))
7826
  {
7827
    InLineTableName(GeneratorName + pos*NameLength1);
7828
    PutBlock();
7829
  }
7830
  else
7831
  {
7832
    PutSymbol('[');
7833
    PutLieMonomialStandard(LIE_MONOMIAL_LEFT(pos));
7834
    PutSymbol(',');
7835
    PutLieMonomialStandard(LIE_MONOMIAL_RIGHT(pos));
7836
    PutSymbol(']');
7837
  }
7838
}
7839
#if defined(GAP)
7840
/*=PutLieMonomialGAP============================================
7841
 Put Lie monomial in terms of generators in GAP bracket notation
7842
*/
7843
void PutLieMonomialGAP(int pos)
7844
{
7845
  if(LIE_MONOMIAL_IS_GENERATOR(pos))
7846
    PutStringGAP(UToString(pos+1));
7847
  else
7848
  {
7849
    PutStringGAP("[");
7850
    PutLieMonomialGAP(LIE_MONOMIAL_LEFT(pos));
7851
    PutStringGAP(",");
7852
    PutLieMonomialGAP(LIE_MONOMIAL_RIGHT(pos));
7853
    PutStringGAP("]");
7854
  }
7855
}
7856
#endif
7857
/*=PutLieSum=====================================================
7858
 put_lie_mon == PutLieMonomial     -> in terms of generators,
7859
 put_lie_mon == PutLieBasisElement -> in terms of basis elements
7860
*/
7861
void PutLieSum(void (*put_lie_mon)(int a), uint a)
7862
{
7863
  if(a == NIL)
7864
    PutSymbol('0');
7865
  else
7866
  {
7867
    uint na;
7868
    int is_negative = NO;
7869
    if(IsParametric)
7870
    {
7871
      na = LIE_TERM_NUMERATOR_SCALAR_SUM(a);
7872
      if(SCALAR_TERM_R(na) == NIL &&
7873
         INTEGER_IS_NEGATIVE(SCALAR_TERM_NUMERATOR(na)))
7874
        is_negative = YES;
7875
    }
7876
    else if(INTEGER_IS_NEGATIVE(LIE_TERM_NUMERATOR_INTEGER(a)))
7877
      is_negative = YES;
7878
    if(is_negative)
7879
      PutString("- ");
7880
    PutLieBareTerm(put_lie_mon, a);
7881
    while((a = LIE_TERM_R(a)) != NIL)
7882
    {
7883
      is_negative = NO;
7884
      if(IsParametric)
7885
      {
7886
        na = LIE_TERM_NUMERATOR_SCALAR_SUM(a);
7887
        if(SCALAR_TERM_R(na) == NIL &&
7888
           INTEGER_IS_NEGATIVE(SCALAR_TERM_NUMERATOR(na)))
7889
          is_negative = YES;
7890
      }
7891
      else if(INTEGER_IS_NEGATIVE(LIE_TERM_NUMERATOR_INTEGER(a)))
7892
        is_negative = YES;
7893
      PutString(is_negative ? " - " : " + ");
7894
      PutLieBareTerm(put_lie_mon, a);
7895
    }
7896
  }
7897
}
7898
/*=PutMessage!=========================
7899
 Put message from MessageFile
7900
*/
7901
void PutMessage(int i_message)
7902
{
7903
#if !defined(GAP)
7904
  static int current_message;
7905
  short c;
7906
  if(i_message < current_message)
7907
  {
7908
    rewind(MessageFile);
7909
    current_message = 0;
7910
  }
7911
  while(i_message > current_message)
7912
    if((c = fgetc(MessageFile)) == '$')
7913
      ++current_message;
7914
    else if(c == EOF)
7915
      Error(E_MESSAGE);
7916
  while(YES)
7917
  {
7918
    c = fgetc(MessageFile);
7919
    if(c == '$')
7920
    {
7921
      ++current_message;
7922
      return;
7923
    }
7924
    PutCharacter((char)c);
7925
  }
7926
#endif
7927
}
7928
/*=PutRelations====================================
7929
 Print list of relations
7930
*/
7931
void PutRelations(int msg)
7932
{
7933
  int i;
7934
  TIME_OFF;
7935
  PutMessage(msg);
7936
  for(i = 0; i < RelationN; i++)
7937
  {
7938
    PutStart();
7939
    InLineNumberInBrackets(i+1);
7940
    IN_LINE_MARGIN;
7941
    PutLieSum(PutLieMonomial, RELATION_LIE_SUM(i));
7942
    InLineString(" = 0");
7943
    PutEnd();
7944
  }
7945
  if(IncompletedRelations)
7946
    PutDots();
7947
  TIME_ON;
7948
}
7949
#if defined(GAP)
7950
/*=PutRelationsGAP=================================
7951
*/
7952
void PutRelationsGAP(void)
7953
{
7954
  int i;
7955
  BIGINT num;
7956
  uint a;
7957
  PutStringStandard(GAPRelationsName);
7958
  PutStringStandard(":=[\n");   /* Begin main list */
7959
  for(i = 0; i < RelationN; i++)
7960
  {
7961
    a = RELATION_LIE_SUM(i);
7962
    PosOutLine = -1;
7963
    PutCharacterGAP('[');
7964
    while(YES)
7965
    {
7966
      PutLieMonomialGAP(LIE_TERM_MONOMIAL(a));
7967
      PutStringGAP(",");
7968
      num = LIE_TERM_NUMERATOR_INTEGER(a);
7969
      if(INTEGER_IS_NEGATIVE(num))
7970
        PutStringGAP("-");
7971
      PutIntegerUnsignedGAP(num);
7972
      if((a = LIE_TERM_R(a)) == NIL)
7973
        break;
7974
      PutStringGAP(",");
7975
    }
7976
    PutStringGAP("]");
7977
    if(i < RelationN - 1)
7978
      PutStringGAP(",\n");
7979
  }
7980
  PutStringStandard("\n];\n");
7981
}
7982
#endif
7983
/*=PutScalarBareTerm===============================
7984
 Intermediate print of unsigned scalar term
7985
*/
7986
void PutScalarBareTerm(uint a)
7987
{
7988
  int put_1 = YES;
7989

7990
  /* Put integer coefficient */
7991

7992
  if(INTEGER_IS_NOT_UNIT_ABS(SCALAR_TERM_NUMERATOR(a)))
7993
  {
7994
    PutIntegerUnsigned(SCALAR_TERM_NUMERATOR(a));
7995
    put_1 = NO;
7996
  }
7997

7998
  /* Put scalar monomial */
7999

8000
  a = SCALAR_TERM_MONOMIAL(a); /* uint - uint mixing */
8001
  if(a != NIL)
8002
  {
8003
    if(put_1 == NO)
8004
        PutSymbol(' ');
8005
    PutScalarFactor(a);
8006
    while((a = SCALAR_FACTOR_R(a)) != NIL)
8007
    {
8008
      PutSymbol(' ');
8009
      PutScalarFactor(a);
8010
    }
8011
    put_1 = NO;
8012
  }
8013
  if(put_1)         /* Nothing's been put before */
8014
    PutSymbol('1');
8015
}
8016
/*=PutIntegerUnsigned=============================================
8017
 Print big integer
8018
*/
8019
void PutIntegerUnsigned(BIGINT bn)
8020
{
8021
  BIGINT bnw;
8022
  char * decstr;
8023
  LIMB res;
8024
  uint lw;
8025
  int i,
8026
    n = INTEGER_N_LIMBS(bn),
8027
    nw = n;
8028
  bnw = (BIGINT)alloca(sizeof(LIMB)*n);
8029
  if(bnw == NULL)
8030
    Error(E_A_STACK_INTEGER); /* LIMB contains 5 decimal digits */
8031
  decstr = (char *)alloca(5*n + 1);
8032
  if(decstr == NULL)
8033
    Error(E_A_STACK_INTEGER_DECIMAL_STRING);
8034
  decstr += 5*n;            /* Go to last byte of string */
8035
  for(i = 0; i < n; i++)
8036
    bnw[i] = *(++bn);       /* Copy body of big number */
8037
  /* Transform big number array to decimal string */
8038
  decstr[0] = '\0';
8039
  do
8040
  { /* Divide bnw number in array form by 10 on spot */
8041
    res = 0;
8042
    if(nw)       /* Otherwise 0/n -> 0, 0 mod n -> 0 */
8043
    {
8044
      i = nw;
8045
      do
8046
      {
8047
        lw = (uint)res * BASE_LIMB + (uint)bnw[--i];
8048
        res = (LIMB)(lw % 10);
8049
        bnw[i] = (LIMB)(lw / 10);
8050
      }while(i);
8051
      if(bnw[nw-1] == 0)
8052
        --nw;
8053
    }
8054
    *--decstr = '0' + res;
8055
  }while(nw);
8056
  if(n < 3)
8057
    PutString(decstr);      /* Don't cut short number */
8058
  else
8059
    do
8060
      PutSymbol(*decstr);
8061
    while(*(++decstr));
8062
}
8063
#if defined(GAP)
8064
/*=PutIntegerUnsignedGAP==========================================
8065
 Print big integer into GAP file
8066
*/
8067
void PutIntegerUnsignedGAP(BIGINT bn)
8068
{
8069
  BIGINT bnw;
8070
  char * decstr;
8071
  LIMB res;
8072
  uint lw;
8073
  int i,
8074
    n = INTEGER_N_LIMBS(bn),
8075
    nw = n;
8076
  bnw = (BIGINT)alloca(sizeof(LIMB)*n);
8077
  if(bnw == NULL)
8078
    Error(E_A_STACK_INTEGER); /* LIMB contains 5 decimal digits */
8079
  decstr = (char *)alloca(5*n + 1);
8080
  if(decstr == NULL)
8081
    Error(E_A_STACK_INTEGER_DECIMAL_STRING);
8082
  decstr += 5*n;            /* Go to last byte of string */
8083
  for(i = 0; i < n; i++)
8084
    bnw[i] = *(++bn);       /* Copy body of big number */
8085
  /* Transform big number array to decimal string */
8086
  decstr[0] = '\0';
8087
  do
8088
  { /* Divide bnw number in array form by 10 on spot */
8089
    res = 0;
8090
    if(nw)       /* Otherwise 0/n -> 0, 0 mod n -> 0 */
8091
    {
8092
      i = nw;
8093
      do
8094
      {
8095
        lw = (uint)res * BASE_LIMB + (uint)bnw[--i];
8096
        res = (LIMB)(lw % 10);
8097
        bnw[i] = (LIMB)(lw / 10);
8098
      }while(i);
8099
      if(bnw[nw-1] == 0)
8100
        --nw;
8101
    }
8102
    *--decstr = '0' + res;
8103
  }while(nw);
8104
  PutStringGAP(decstr);
8105
}
8106
#endif
8107
/*=PutScalarFactor========================================================
8108
*/
8109
void PutScalarFactor(uint a)
8110
{
8111
  InLineTableName(ParameterName + SCALAR_FACTOR_PARAMETER(a)*NameLength1);
8112
  PutDegree(SCALAR_FACTOR_DEGREE(a));
8113
  PutBlock();
8114
}
8115
/*=PutScalarSum================================================
8116
 Intermediate print of scalar sum
8117
*/
8118
void PutScalarSum(uint a)
8119
{
8120
  if(a == NIL)
8121
    PutSymbol('0');
8122
  else
8123
  {
8124
    if(INTEGER_IS_NEGATIVE(SCALAR_TERM_NUMERATOR(a)))
8125
      PutString("- ");
8126
    PutScalarBareTerm(a);
8127
    while((a = SCALAR_TERM_R(a)) != NIL)
8128
    {
8129
      PutString(INTEGER_IS_NEGATIVE(SCALAR_TERM_NUMERATOR(a)) ?
8130
                " - " : " + ");
8131
      PutScalarBareTerm(a);
8132
    }
8133
  }
8134
}
8135
/*=PutStart=======================================
8136
 Start of 2dimensional output
8137
*/
8138
void PutStart(void)
8139
{
8140
  LastItemEnd = PrintEnd = Margin = NewMargin = 0;
8141
  AddSymbolToOutLine(LEVEL, 0);
8142
  AddSymbolToOutLine(MAIN_LEVEL, 1);
8143
  PosOutLine = 1;
8144
  CurrentLevel = MaxLevel = MinLevel = MAIN_LEVEL;
8145
}
8146
/*=PutStatistics=========================================================
8147
 Put time and space statistics
8148
*/
8149
void PutStatistics(void)
8150
{
8151
  uint sec, min, sec_100,
8152
     time = CrudeTime ? TimeC : (uint)(((double)TimeC/CLOCKS_PER_SEC)*100);
8153
  PutStringStandard("Time: ");
8154
  if(!CrudeTime)
8155
  {
8156
    sec_100 = (uint)(time%100);
8157
    time /= 100;                /* In seconds */
8158
  }
8159
  sec = (uint)(time%60);
8160
  time /= 60;                   /* In minutes */
8161
  min = (uint)(time%60);
8162
  time /= 60;                   /* In hours */
8163
  if(time)
8164
    PutFormattedU("%lu h ", time);
8165
  if(min || time)
8166
    PutFormattedU("%lu min ", min);
8167
  if(CrudeTime)
8168
    PutFormattedU("%lu sec\n", sec);
8169
  else
8170
  {
8171
    PutFormattedU("%u.", sec);
8172
    if(sec_100 < 10 && sec_100 > 0)
8173
      PutCharacter('0');
8174
    PutFormattedU("%u sec\n", sec_100);
8175
  }
8176
#if defined(SPACE_STATISTICS)
8177
  PutFormattedU("Number of relations: %14u\n", MaxNRelation);
8178
  PutFormattedU("Number of Lie monomials: %10u\n", LieMonomialMaxN);
8179
  PutFormattedU("Number of Lie terms: %14u\n", NodeLTTopMax - 1);
8180
  if(IsParametric)
8181
  {
8182
    PutFormattedU("Number of scalar terms: %11u\n", NodeSTTopMax - 1);
8183
    min = NodeSFTopMax - 1;
8184
    PutFormattedU("Number of scalar factors:%10u\n", NodeSFTopMax - 1);
8185
  }
8186
#endif
8187
#if defined(INTEGER_MAX_SIZE)
8188
  PutFormattedU("Maximum size of integer in limbs: %5u\n", IntegerMaxSize);
8189
#endif
8190
#if defined(DEBUG)
8191
  PutDebugU("Current Debug", Debug);
8192
#endif
8193
}
8194
/*=PutString================
8195
 2D output of string
8196
*/
8197
void PutString(char *str)
8198
{
8199
  PreviousEnd = LastItemEnd;
8200
  InLineString(str);
8201
  PutBlock();
8202
}
8203
#if defined(GAP)
8204
/*=PutStringGAP=======================================================
8205
 Put string in GAP file
8206
*/
8207
void PutStringGAP(char *str)
8208
{
8209
  char c = 0;
8210
  while(*str)
8211
  {
8212
     if(PosOutLine == GAP_WIDTH - 2)
8213
       if(isdigit(*str))         /* Going to write in last position */
8214
       {
8215
         if(isdigit(c))
8216
           PutCharacter('\\');
8217
         PutCharacter('\n');
8218
         PosOutLine = -1;
8219
         PutCharacterGAP(*str); /* Continue number in the next line */
8220
       }
8221
       else
8222
       {
8223
         PutCharacter(*str);
8224
         PutCharacter('\n');
8225
         PosOutLine = -1;                     /* Ready to next line */
8226
       }
8227
     else
8228
       PutCharacterGAP(*str);
8229
     c = *str;                          /* Remember previous symbol */
8230
     ++str;
8231
  }
8232
}
8233
#endif
8234
/*=PutStringStandard==============
8235
*/
8236
void PutStringStandard(char *str)
8237
{
8238
#if defined(ECHO_TO_SCREEN)
8239
  printf("%s", str);
8240
#endif
8241
#if !defined(GAP)
8242
  fprintf(SessionFile, "%s", str);
8243
#endif
8244
}
8245
/*=PutSymbol!===============
8246
 2D output of symbol
8247
*/
8248
void PutSymbol(char c)
8249
{
8250
  PreviousEnd = LastItemEnd;
8251
  InLineSymbol(c);
8252
  PutBlock();
8253
}
8254

8255
/*_6_10   Debugging functions===========================================*/
8256

8257
#if defined(DEBUG)
8258
/*=PutDebugHeader====================================================
8259
  Put header of tracing output.
8260
*/
8261
void PutDebugHeader(uint debug, char * f_name, char * in_out)
8262
{
8263
#if !defined(GAP)
8264
  fprintf(SessionFile,"\nDebug==%lu %s %s:\n", debug, f_name, in_out);
8265
#endif
8266
  printf("\nDebug==%lu %s %s\n", debug, f_name, in_out);
8267
}
8268
/*=PutDebugInteger==============
8269
 Put name and signed big number
8270
*/
8271
void PutDebugInteger(char * name, BIGINT u)
8272
{
8273
  PutStart();
8274
  InLineString(name);
8275
  InLineString(": ");
8276
  if(INTEGER_IS_NEGATIVE(u))
8277
    InLineSymbol('-');
8278
  PutIntegerUnsigned(u);
8279
  PutEnd();
8280
}
8281
/*=PutDebugLieMonomial==============
8282
  Put name and Lie sum
8283
*/
8284
void PutDebugLieMonomial(char * name, int a)
8285
{
8286
  PutStart();
8287
  InLineString(name);
8288
  InLineString(": ");
8289
  (*PutLieMonomial)(a);
8290
  PutEnd();
8291
}
8292
/*=PutDebugLieMonomialTable=================================================
8293
*/
8294
void PutDebugLieMonomialTable(int newmon)
8295
{
8296
  int i, j, count;
8297
  PutStringStandard("LieMonomial table:\n"
8298
               "ORDER POSITION LEFT RIGHT PARITY INDEX WEIGHT MONOMIAL\n");
8299
  i = count = 0;
8300
  while(count < LieMonomialN)
8301
  {
8302
    if(LIE_MONOMIAL_IS_OCCUPIED(i))
8303
    {
8304
      count++;
8305
      PutFormattedU("%5d", LIE_MONOMIAL_ORDER(i));
8306
      PutFormattedU("%9d", i);
8307
      PutFormattedU("%5d", LIE_MONOMIAL_LEFT(i));
8308
      PutFormattedU("%6d", LIE_MONOMIAL_RIGHT(i));
8309
      PutFormattedU("%4d", LIE_MONOMIAL_PARITY(i));
8310
      if((j = LIE_MONOMIAL_INDEX(i)) < 0 )
8311
        PutFormattedU(" Rel %-4d", ~j);
8312
      else
8313
        PutFormattedU("%9d", j);
8314
      PutFormattedU("%7d ", LIE_MONOMIAL_WEIGHT(i));
8315
      if(newmon == i)
8316
        PutStringStandard("New! ");
8317
      PutStart();
8318
      (*PutLieMonomial)(i);
8319
      PutEnd();
8320
    }
8321
    else
8322
      PutFormattedU("Position %d is free!\n", i);
8323
    i++;
8324
  }
8325
}
8326
/*=PutDebugLieSum==============
8327
  Put name and Lie sum
8328
*/
8329
void PutDebugLieSum(char * name, uint a)
8330
{
8331
  PutStart();
8332
  InLineString(name);
8333
  InLineString(": ");
8334
  PutLieSum(PutLieMonomial, a);
8335
  PutEnd();
8336
}
8337
/*=PutDebugLieTerm==============================================
8338
*/
8339
void PutDebugLieTerm(char * name, uint a)
8340
{
8341
  PutStart();
8342
  InLineString(name);
8343
  InLineString(": ");
8344
  if(a == NIL)
8345
    PutSymbol('0');
8346
  else
8347
  {
8348
    uint na;
8349
    int is_negative = NO;
8350
    if(IsParametric)
8351
    {
8352
      na = LIE_TERM_NUMERATOR_SCALAR_SUM(a);
8353
      if(SCALAR_TERM_R(na) == NIL &&
8354
         INTEGER_IS_NEGATIVE(SCALAR_TERM_NUMERATOR(na)))
8355
        is_negative = YES;
8356
    }
8357
    else if(INTEGER_IS_NEGATIVE(LIE_TERM_NUMERATOR_INTEGER(a)))
8358
      is_negative = YES;
8359
    if(is_negative)
8360
      PutString("- ");
8361
    PutLieBareTerm(PutLieMonomial, a);
8362
  }
8363
  PutEnd();
8364
}
8365
/*=PutDebugU==================================
8366
  Put name and long unsigned integer
8367
*/
8368
void PutDebugU(char * name, uint i)
8369
{
8370
  printf("\n%s==%lu\n", name, i);
8371
#if !defined(GAP)
8372
  fprintf(SessionFile, "\n%s==%lu\n", name, i);
8373
#endif
8374
}
8375
#if defined(D_PUT_RELATIONS)
8376
/*=PutDebugRelations======================================
8377
 Put Relation table with structure fields
8378
*/
8379
void PutDebugRelations(void)
8380
{
8381
  int i, mg;
8382
  char * hformat = "Relations:\n  N SUB MIN_GEN  RELATION\n";
8383
  printf(hformat);
8384
#if !defined(GAP)
8385
  fprintf(SessionFile, hformat);
8386
#endif
8387
  for(i = 0; i < RelationN; i++)
8388
  {
8389
    PutStart();
8390
    if(i < 100)
8391
      InLineSymbol(' ');
8392
    if(i < 10)
8393
      InLineSymbol(' ');
8394
    InLineString(UToString(i));
8395
    InLineString("  ");
8396
    InLineSymbol(RELATION_TO_BE_SUBSTITUTED(i) ? 'Y':'N');
8397
    InLineString(" ");
8398
    mg = RELATION_MIN_GENERATOR(i);
8399
    if(mg < 10)
8400
      InLineSymbol(' ');
8401
    InLineString(UToString(mg));
8402
    InLineString(" ");
8403
    if(mg < GeneratorN)
8404
      PutLieMonomial(mg);
8405
    else
8406
      InLineString("done");
8407
    InLineString("    ");
8408
    IN_LINE_MARGIN;
8409
    PutLieSum(PutLieMonomial, RELATION_LIE_SUM(i));
8410
    PutEnd();
8411
  }
8412
}
8413
#endif
8414
/*=PutDebugScalarSum==============
8415
  Put name and scalar sum
8416
*/
8417
void PutDebugScalarSum(char * name, uint a)
8418
{
8419
  PutStart();
8420
  InLineString(name);
8421
  InLineString(": ");
8422
  PutScalarSum(a);
8423
  PutEnd();
8424
}
8425
/*=PutDebugString================================
8426
  Put name of string and string
8427
*/
8428
void PutDebugString(char * strname, char * str)
8429
{
8430
  printf("%s: %s\n", strname, str);
8431
#if !defined(GAP)
8432
  fprintf(SessionFile, "%s: %s\n", strname, str);
8433
#endif
8434
}
8435
#endif
8436
#if defined(MEMORY)
8437
/*=AddLieSumNs=============================================
8438

8439
*/
8440
void AddLieSumNs(uint a, int minus_or_plus,
8441
              int *pn_lt, int *pn_int, int *pn_st, int *pn_sf)
8442
{
8443
  int dn_lt, dn_int;
8444
  dn_lt = dn_int = 0;
8445
  while(a != NIL)
8446
  {
8447
    ++dn_lt;
8448
    if(IsParametric)
8449
    {
8450
      AddScalarSumNs(LIE_TERM_NUMERATOR_SCALAR_SUM(a),
8451
                     minus_or_plus, pn_int, pn_st, pn_sf);
8452
      AddScalarSumNs(LIE_TERM_DENOMINATOR_SCALAR_SUM(a),
8453
                     minus_or_plus, pn_int, pn_st, pn_sf);
8454
    }
8455
    else
8456
    {
8457
      ++dn_int;             /* Numerator is obligatory */
8458
      if(LIE_TERM_DENOMINATOR_INTEGER(a) != NULL)
8459
        ++dn_int;
8460
    }
8461
    a = LIE_TERM_R(a);
8462
  }
8463
  if(minus_or_plus == PLUS)
8464
  {
8465
    *pn_lt += dn_lt;
8466
    if(!IsParametric)
8467
      *pn_int += dn_int;
8468
  }
8469
  else
8470
  {
8471
    *pn_lt -= dn_lt;
8472
    if(!IsParametric)
8473
      *pn_int -= dn_int;
8474
  }
8475
}
8476
/*=AddScalarSumNs========================================================
8477
*/
8478
void AddScalarSumNs(uint a, int minus_or_plus, int *pn_int, int *pn_st, int *pn_sf)
8479
{
8480
  int dn_int, dn_st, dn_sf;
8481
  uint b;
8482
  dn_int = dn_st = dn_sf = 0;
8483
  while(a != NIL)
8484
  {
8485
    ++dn_st;
8486
    ++dn_int;    /* Numerator is obligatory */
8487
    b = SCALAR_TERM_MONOMIAL(a);
8488
    while(b != NIL)
8489
    {
8490
      ++dn_sf;
8491
      b = SCALAR_FACTOR_R(b);
8492
    }
8493
    a = SCALAR_TERM_R(a);
8494
  }
8495
  if(minus_or_plus == PLUS)
8496
  {
8497
    *pn_int += dn_int;
8498
    *pn_st += dn_st;
8499
    *pn_sf += dn_sf;
8500
  }
8501
  else
8502
  {
8503
    *pn_int -= dn_int;
8504
    *pn_st -= dn_st;
8505
    *pn_sf -= dn_sf;
8506
  }
8507
}
8508
/*=PutIntegerBalance===================================================
8509
*/
8510
void PutIntegerBalance(char * fname, int dn)
8511
{
8512
  PutStringStandard("\nHeap integer balance violation in function:\n");
8513
  PutStringStandard(fname);
8514
  if(dn > 0)
8515
  {
8516
#if !defined(GAP)
8517
    fprintf(SessionFile, "\n*** %ld INTs gone to garbage\n", dn);
8518
#endif
8519
    printf("\n*** %ld INTs gone to garbage\n", dn);
8520
  }
8521
  else
8522
  {
8523
    dn = -dn;
8524
#if !defined(GAP)
8525
    fprintf(SessionFile, "\n*** %ld INTs appeared from nothing\n", dn);
8526
#endif
8527
    printf("\n*** %ld INTs appeared from nothing\n", dn);
8528
  }
8529
}
8530
/*=PutNodeBalance======================================================
8531
*/
8532
void PutNodeBalance(char * type, char * fname, int dn)
8533
{
8534
  PutStringStandard(type);
8535
  PutStringStandard(" balance violation in function:\n");
8536
  PutStringStandard(fname);
8537
  if(dn > 0)
8538
  {
8539
#if !defined(GAP)
8540
    fprintf(SessionFile, "\n*** %ld nodes gone to garbage\n", dn);
8541
#endif
8542
    printf("\n*** %ld nodes gone to garbage", dn);
8543
  }
8544
  else
8545
  {
8546
    dn = -dn;
8547
#if !defined(GAP)
8548
    fprintf(SessionFile, "\n***%ld nodes appeared from nothing\n", dn);
8549
#endif
8550
    printf("\n***%ld nodes appeared from nothing\n", dn);
8551
  }
8552
}
8553
#endif
8554

8555

8556
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.
