• Home
  • Features
  • Pricing
  • Docs
  • Announcements
  • Sign In

vermaseren / form / 8291682109

15 Mar 2024 05:19AM UTC coverage: 48.436% (+0.2%) from 48.252%
8291682109

push

github

tueda
test: temporarily disable Diagram tests that are known to fail

To ensure CI tests pass.

40089 of 82767 relevant lines covered (48.44%)

443858.82 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

61.53
/sources/function.c
1
/** @file function.c
2
 * 
3
 *  The file with the central routines for the pattern matching of
4
 *        functions and their arguments.
5
 *        The file also contains the routines for the execution of the
6
 *        Symmetrize statement and its variations (like antisymmetrize etc).
7
 */
8
/* #[ License : */
9
/*
10
 *   Copyright (C) 1984-2023 J.A.M. Vermaseren
11
 *   When using this file you are requested to refer to the publication
12
 *   J.A.M.Vermaseren "New features of FORM" math-ph/0010025
13
 *   This is considered a matter of courtesy as the development was paid
14
 *   for by FOM the Dutch physics granting agency and we would like to
15
 *   be able to track its scientific use to convince FOM of its value
16
 *   for the community.
17
 *
18
 *   This file is part of FORM.
19
 *
20
 *   FORM is free software: you can redistribute it and/or modify it under the
21
 *   terms of the GNU General Public License as published by the Free Software
22
 *   Foundation, either version 3 of the License, or (at your option) any later
23
 *   version.
24
 *
25
 *   FORM is distributed in the hope that it will be useful, but WITHOUT ANY
26
 *   WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
27
 *   FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
28
 *   details.
29
 *
30
 *   You should have received a copy of the GNU General Public License along
31
 *   with FORM.  If not, see <http://www.gnu.org/licenses/>.
32
 */
33
/* #] License : */ 
34
/*
35
          #[ Includes : function.c
36
*/
37

38
#include "form3.h"
39

40
/*
41
          #] Includes : 
42
         #[ Utilities :
43
                 #[ MakeDirty :
44

45
                Routine finds the function with the address x in it
46
                and mark all arguments that contain x as dirty.
47
                if par == 0 term is a full term, else term is the start of a 
48
                function
49
*/
50

51
WORD MakeDirty(WORD *term, WORD *x, WORD par)
×
52
{
53
        WORD *next, *n;
×
54
        if ( !par ) {
×
55
                next = term; next += *term;
×
56
                next -= ABS(next[-1]);
×
57
                term++;
×
58
                if ( x < term ) return(0);
×
59
                if ( x >= next ) return(0);
×
60
                while ( term < next ) {
×
61
                        n = term + term[1];
×
62
                        if ( x < n ) break;
×
63
                        term = n;
64
                }
65
/*                next = n; */
66
        }
67
        else {
68
                next = term + term[1];
×
69
                if ( x < term || x >= next ) return(0);
×
70
        }
71
        if ( *term < FUNCTION ) return(0);
×
72
        if ( functions[*term-FUNCTION].spec >= TENSORFUNCTION ) return(0);
×
73
        term += FUNHEAD;
×
74
        if ( x < term ) return(0);
×
75
        next = term; NEXTARG(next)
×
76
        while ( x >= next ) { term = next; NEXTARG(next) }
×
77
        if ( *term < 0 ) return(0);
×
78
        term[1] = 1;
×
79
        term += ARGHEAD;
×
80
        if ( x < term ) return(1);
×
81
        next = term + *term;
×
82
        while ( x >= next ) { term = next; next += *next; }
×
83
        MakeDirty(term,x,0);
×
84
        return(1);
×
85
}
86

87
/*
88
                 #] MakeDirty : 
89
                 #[ MarkDirty :
90

91
                Routine marks all functions dirty with the given flags.
92
                Is to be used when there is a possibility that symmetrization
93
                properties of functions may have changed. In that case we play
94
                it safe.
95
*/
96

97
void MarkDirty(WORD *term, WORD flags)
73✔
98
{
99
        WORD *t, *r, *m, *tstop;
73✔
100
        GETSTOP(term,tstop);
73✔
101
        t = term+1;
73✔
102
        while ( t < tstop ) {
148✔
103
                if ( *t < FUNCTION ) { t += t[1]; continue; }
75✔
104
                t[2] |= flags;
6✔
105
                if ( *t < FUNCTION+WILDOFFSET && functions[*t-FUNCTION].spec > 0 ) {
6✔
106
                        t += t[1]; continue;
×
107
                }
108
                if ( *t >= FUNCTION+WILDOFFSET && functions[*t-FUNCTION-WILDOFFSET].spec > 0 ) {
6✔
109
                        t += t[1]; continue;
×
110
                }
111
                r = t + FUNHEAD;
6✔
112
                t += t[1];
6✔
113
                while ( r < t ) {
66✔
114
                        if ( *r <= 0 ) {
60✔
115
                                if ( *r <= -FUNCTION ) r++;
60✔
116
                                else r += 2;
60✔
117
                                continue;
60✔
118
                        }
119
                        r[1] |= DIRTYFLAG;
×
120
                        m = r + ARGHEAD;
×
121
                        r += *r;
×
122
                        while ( m < r ) {
×
123
                                MarkDirty(m,flags);
×
124
                                m += *m;
×
125
                        }
126
                }
127
        }
128
}
73✔
129

130
/*
131
                 #] MarkDirty : 
132
                 #[ PolyFunDirty :
133

134
                Routine marks the PolyFun or the PolyRatFun dirty.
135
                This is used when there is modular calculus and the modulus
136
                has changed for the current module.
137
*/
138

139
void PolyFunDirty(PHEAD WORD *term)
128✔
140
{
141
        GETBIDENTITY
142
        WORD *t, *tstop, *endarg;
128✔
143
        tstop = term + *term;
128✔
144
        tstop -= ABS(tstop[-1]);
128✔
145
        t = term+1;
128✔
146
        while ( t < tstop ) {
295✔
147
                if ( *t == AR.PolyFun ) {
167✔
148
                        if ( AR.PolyFunType == 2 ) t[2] |= MUSTCLEANPRF;
45✔
149
                        endarg = t + t[1];
45✔
150
                        t[2] |= DIRTYFLAG;
45✔
151
                        t += FUNHEAD;
45✔
152
                        while ( t < endarg ) {
45✔
153
                                if ( *t > 0 ) {
90✔
154
                                        t[1] |= DIRTYFLAG;
33✔
155
                                }
156
                                NEXTARG(t);
225✔
157
                        }
158
                }
159
                else {
160
                        t += t[1];
122✔
161
                }
162
        }
163
}
128✔
164

165
/*
166
                 #] PolyFunDirty : 
167
                 #[ PolyFunClean :
168

169
                Routine marks the PolyFun or the PolyRatFun clean.
170
                This is used when there is modular calculus and the modulus
171
                has changed for the current module.
172
*/
173

174
void PolyFunClean(PHEAD WORD *term)
63✔
175
{
176
        GETBIDENTITY
177
        WORD *t, *tstop;
63✔
178
        tstop = term + *term;
63✔
179
        tstop -= ABS(tstop[-1]);
63✔
180
        t = term+1;
63✔
181
        while ( t < tstop ) {
138✔
182
                if ( *t == AR.PolyFun ) {
75✔
183
                        t[2] &= ~MUSTCLEANPRF;
30✔
184
                }
185
                t += t[1];
75✔
186
        }
187
}
63✔
188

189
/*
190
                 #] PolyFunClean : 
191
                 #[ Symmetrize :
192

193
                (Anti)Symmetrizes the arguments of a function. 
194
                Nlist tells of how many arguments are involved.
195
                Nlist == 0                All arguments must be sorted.
196
                Nlist > 0                Arguments mentioned are to be sorted, rest skipped.
197
                type = SYMMETRIC       Full symmetrization
198
                type = ANTISYMMETRIC:  Full symmetrization
199
                type = CYCLESYMMETRIC: Cyclic
200
                type = RCYCLESYMMETRIC:Cyclic or reverse
201
                Return value: OR of:
202
                        0 even, 1 odd
203
                        2 equal groups
204
                        4 there was a permutation.
205

206
                The information in Lijst tells what grouping is to be applied.
207
                The information is:
208
                ngroups number of groups
209
                gsize size of groups
210
                Lijst[0]....  The groups.
211
*/
212

213
WORD Symmetrize(PHEAD WORD *func, WORD *Lijst, WORD ngroups, WORD gsize,
1,178✔
214
                WORD type)
215
{
216
        GETBIDENTITY
217
        WORD **args,**arg,nargs;
1,178✔
218
        WORD *to, *r, *fstop;
1,178✔
219
        WORD i, j, k, ff, exch, nexch, neq;
1,178✔
220
        WORD *a1, *a2, *a3;
1,178✔
221
        WORD reverseorder;
1,178✔
222
        if ( ( type & REVERSEORDER ) != 0 ) reverseorder = -1;
1,178✔
223
        else                                reverseorder = 1;
1,178✔
224
        type &= ~REVERSEORDER;
1,178✔
225

226
        ff = ( *func > FUNCTION ) ? functions[*func-FUNCTION].spec: 0;
1,178✔
227

228
        if ( 2*func[1] > AN.arglistsize ) {
1,178✔
229
                if ( AN.arglist ) M_free(AN.arglist,"Symmetrize");
55✔
230
                AN.arglistsize = 2*func[1] + 8;
55✔
231
                AN.arglist = (WORD **)Malloc1(AN.arglistsize*sizeof(WORD *),"Symmetrize");
55✔
232
        }
233
        arg = args = AN.arglist;
1,178✔
234
        to = AT.WorkPointer;
1,178✔
235
        r = func;
1,178✔
236
        fstop = r + r[1];
1,178✔
237
        r += FUNHEAD;
1,178✔
238
        nargs = 0;
1,178✔
239
        while ( r < fstop ) {        /* Make list of arguments */
1,178✔
240
                *arg++ = r;
2,564✔
241
                nargs++;
2,564✔
242
                if ( ff ) {
2,564✔
243
                        if ( *r == FUNNYWILD ) r++;
×
244
                        r++;
×
245
                }
246
                else { NEXTARG(r); }
6,306✔
247
        }
248
        exch = 0;
1,178✔
249
        nexch = 0;
1,178✔
250
        neq = 0;
1,178✔
251
        a1 = Lijst;
1,178✔
252
        if ( type == SYMMETRIC || type == ANTISYMMETRIC ) {
1,178✔
253
        for ( i = 1; i < ngroups; i++ ) {
2,549✔
254
                a3 = a2 = a1 + gsize;
1,377✔
255
                k = reverseorder*CompGroup(BHEAD ff,args,a1,a2,gsize);
1,377✔
256
                if ( k < 0 ) {
1,377✔
257
                        j = i-1;
382✔
258
                        for(;;) {
1,092✔
259
                                for ( k = 0; k < gsize; k++ ) {
1,474✔
260
                                        r = args[a1[k]]; args[a1[k]] = args[a2[k]]; args[a2[k]] = r;
737✔
261
                                }
262
                                exch ^= 1;
737✔
263
                                nexch = 4;
737✔
264
                                if ( j <= 0 ) break;
737✔
265
                                a1 -= gsize;
484✔
266
                                a2 -= gsize;
484✔
267
                                k = reverseorder*CompGroup(BHEAD ff,args,a1,a2,gsize);
484✔
268
                                if ( k == 0 ) neq = 2;
484✔
269
                                if ( k >= 0 ) break;
484✔
270
                                j--;
355✔
271
                        }
272
                }
273
                else if ( k == 0 ) neq = 2;
995✔
274
                a1 = a3;
1,377✔
275
        }
276
        }
277
        else if ( type == CYCLESYMMETRIC || type == RCYCLESYMMETRIC ) {
6✔
278
                WORD rev = 0, jmin = 0, ii, iimin;
279
recycle:
6✔
280
                for ( j = 1; j < ngroups; j++ ) {
15✔
281
                        for ( i = 0; i < ngroups; i++ ) {
9✔
282
                                iimin = jmin + i;
9✔
283
                                if ( iimin >= ngroups ) iimin -= ngroups;
9✔
284
                                ii = j + i;
9✔
285
                                if ( ii >= ngroups ) ii -= ngroups;
9✔
286
                                k = reverseorder*CompGroup(BHEAD ff,args,Lijst+gsize*iimin,Lijst+gsize*ii,gsize);
9✔
287
                                if ( k > 0 ) break;
9✔
288
                                if ( k < 0 ) { jmin = j; nexch = 4; break; }
×
289
                        }
290
                }
291
                if ( type == RCYCLESYMMETRIC && rev == 0 && ngroups > 1 ) {
6✔
292
                        for ( j = 0; j < ngroups; j++ ) {
×
293
                                for ( i = 0; i < ngroups; i++ ) {
×
294
                                        iimin = jmin + i;
×
295
                                        if ( iimin >= ngroups ) iimin -= ngroups;
×
296
                                        ii = j - i;
×
297
                                        if ( ii < 0 ) ii += ngroups;
×
298
                                        k = reverseorder*CompGroup(BHEAD ff,args,Lijst+gsize*iimin,Lijst+gsize*ii,gsize);
×
299
                                        if ( k > 0 ) break;
×
300
                                        if ( k < 0 ) {
×
301
                                                nexch = 4;
×
302
                                                jmin = 0;
×
303
                                                a1 = Lijst;
×
304
                                                a2 = Lijst + gsize * (ngroups-1);
×
305
                                                while ( a2 > a1 ) {
×
306
                                                        for ( k = 0; k < gsize; k++ ) {
×
307
                                                                r = args[a1[k]];
×
308
                                                                args[a1[k]] = args[a2[k]];
×
309
                                                                args[a2[k]] = r;
×
310
                                                        }
311
                                                        a1 += gsize; a2 -= gsize;
×
312
                                                }
313
                                                rev = 1;
×
314
                                                goto recycle;
×
315
                                        }
316
                                }
317
                        }
318
                }
319
                if ( jmin != 0 ) {
6✔
320
                        arg = AN.arglist + func[1];
×
321
                        a1 = Lijst + gsize * jmin;
×
322
                        k = gsize * ngroups;
×
323
                        a2 = Lijst + k;
×
324
                        for ( i = 0; i < k; i++ ) {
×
325
                                if ( a1 >= a2 ) a1 = Lijst;
×
326
                                *arg++ = args[*a1++];
×
327
                        }
328
                        arg = AN.arglist + func[1];
×
329
                        a1 = Lijst;
×
330
                        for ( i = 0; i < k; i++ ) args[*a1++] = *arg++;
×
331
                }
332
        }
333
        r = func;
1,178✔
334
        i = FUNHEAD;
1,178✔
335
        NCOPY(to,r,i);
4,712✔
336
        for ( i = 0; i < nargs; i++ ) {
3,742✔
337
                if ( ff ) {
2,564✔
338
                        if ( *(args[i]) == FUNNYWILD ) {
×
339
                                *to++ = *(args[i]);
×
340
                                *to++ = args[i][1];
×
341
                        }
342
                        else *to++ = *(args[i]);
×
343
                }
344
                else if ( ( j = *args[i] ) < 0 ) {
2,564✔
345
                        *to++ = j;
2,521✔
346
                        if ( j > -FUNCTION ) *to++ = args[i][1];
2,521✔
347
                }
348
                else {
349
                        r = args[i];
350
                        NCOPY(to,r,j);
4,204✔
351
                }
352
        }
353
        i = func[1];
1,178✔
354
        to = func;
1,178✔
355
        r = AT.WorkPointer;
1,178✔
356
        NCOPY(to,r,i);
11,394✔
357
        return ( exch | nexch | neq );
1,178✔
358
}
359

360
/*
361
                 #] Symmetrize : 
362
                 #[ CompGroup :
363

364
                        Routine compares two groups of arguments
365
                        The arguments are in args[a1[i]] and args[a2[i]]
366
                        for i = 0 to num
367
                        type indicates the type of function.
368
                        return value: -1 if there should be an exchange
369
                        0 if they are equal
370
                        1 if they are OK.
371
*/
372

373
WORD CompGroup(PHEAD WORD type, WORD **args, WORD *a1, WORD *a2, WORD num)
1,870✔
374
{
375
        GETBIDENTITY
376
        WORD *t1, *t2, i1, i2, n, k;
1,870✔
377

378
        for ( n = 0; n < num; n++ ) {
2,423✔
379
                t1 = args[a1[n]]; t2 = args[a2[n]];
1,870✔
380
                if ( type >= TENSORFUNCTION ) {
1,870✔
381
                        if ( AR.Eside == LHSIDE || AR.Eside == LHSIDEX ) {
×
382
                                if ( *t1 == FUNNYWILD ) {
×
383
                                        if ( *t2 == FUNNYWILD ) {
×
384
                                                if ( t1[1] < t2[1] ) return(1);
×
385
                                                if ( t1[1] > t2[1] ) return(-1);
×
386
                                        }
387
                                        return(-1);
388
                                }
389
                                else if ( *t2 == FUNNYWILD ) {
×
390
                                        return(1);
391
                                }
392
                                else {
393
                                        if ( *t1 < *t2 ) return(1);
×
394
                                        if ( *t1 > *t2 ) return(-1);
×
395
                                }
396
                        }
397
                        else {
398
                                if ( *t1 < *t2 ) return(1);
×
399
                                if ( *t1 > *t2 ) return(-1);
×
400
                        }
401
                }
402
                else if ( type == 0 ) {
1,870✔
403
                        if ( AC.properorderflag ) {
1,870✔
404
                                k = CompArg(t1,t2);
×
405
                                if ( k < 0 ) return(1);
×
406
                                if ( k > 0 ) return(-1);
×
407
                                NEXTARG(t1)
×
408
                                NEXTARG(t2)
553✔
409
                        }
410
                        else {
411
                                if ( *t1 > 0 ) {
1,870✔
412
                                        i1 = *t1 - ARGHEAD - 1;
501✔
413
                                        t1 += ARGHEAD + 1;
501✔
414
                                        if ( *t2 > 0 ) {
501✔
415
                                                i2 = *t2 - ARGHEAD - 1;
47✔
416
                                                t2 += ARGHEAD + 1;
47✔
417
                                                while ( i1 > 0 && i2 > 0 ) {
257✔
418
                                                        if ( *t1 > *t2 ) return(-1);
255✔
419
                                                        else if ( *t1 < *t2 ) return(1);
230✔
420
                                                        i1--; i2--; t1++; t2++;
210✔
421
                                                }
422
                                                if ( i1 > 0 ) return(-1);
2✔
423
                                                else if ( i2 > 0 ) return(1);
2✔
424
                                        }
425
/*
426
                                        This seems to be a bug. Reported by Aneesh Monahar, 28-sep-2005
427
                                        else return(1);
428
*/
429
                                        else return(-1);
430
                                }
431
                                else if ( *t2 > 0 ) return(1);
1,369✔
432
                                else {
433
                                        if ( *t1 != *t2 ) {
1,364✔
434
                                                if ( *t1 <= -FUNCTION && *t2 <= -FUNCTION ) {
147✔
435
                                                        if ( *t1 < *t2 ) return(-1);
×
436
                                                        return(1);
×
437
                                                }
438
                                                else {
439
                                                        if ( *t1 < *t2 ) return(1);
147✔
440
                                                        return(-1);
12✔
441
                                                }
442
                                        }
443
                                        if ( *t1 > -FUNCTION ) {
1,217✔
444
                                                if ( t1[1] != t2[1] ) {
1,217✔
445
                                                        if ( t1[1] < t2[1] ) return(1);
666✔
446
                                                        return(-1);
246✔
447
                                                }
448
                                        }
449
                                }
450
                        }
451
                }
452
        }
453
        return(0);
454
}
455

456
/*
457
                 #] CompGroup : 
458
                 #[ FullSymmetrize :
459

460
                Relay function for Normalize to execute a full symmetrization
461
                of a function fun. It hooks into Symmetrize according to the
462
                calling conventions for it.
463
                type = 0: Symmetrize
464
                type = 1: AntiSymmetrize
465
                type = 2: CycleSymmetrize
466
                type = 3: RCycleSymmetrize
467
                Return values:
468
                bit 0: odd permutation
469
                bit 1: identical arguments
470
                bit 2: there was a permutation.
471
*/
472

473
int FullSymmetrize(PHEAD WORD *fun, int type)
2,853✔
474
{
475
        GETBIDENTITY
476
        WORD *Lijst, count = 0;
2,853✔
477
        WORD *t, *funstop, i;
2,853✔
478
        int retval;
2,853✔
479

480
        if ( functions[*fun-FUNCTION].spec > 0 ) {
2,853✔
481
                count = fun[1] - FUNHEAD;
×
482
                for ( i = fun[1]-1; i >= FUNHEAD; i-- ) {
×
483
                        if ( fun[i] == FUNNYWILD ) count--;
×
484
                }
485
        }
486
        else {
487
                funstop = fun + fun[1];
2,853✔
488
                t = fun + FUNHEAD;
2,853✔
489
                while ( t < funstop ) { count++; NEXTARG(t) }
6,939✔
490
        }
491
        if ( count < 2 ) {
2,853✔
492
                fun[2] &= ~DIRTYSYMFLAG;
1,698✔
493
                return(0);
1,698✔
494
        }
495
        Lijst = AT.WorkPointer;
1,155✔
496
        for ( i = 0; i < count; i++ ) Lijst[i] = i;
3,543✔
497
        AT.WorkPointer += count;
1,155✔
498
        retval = Symmetrize(BHEAD fun,Lijst,count,1,type);
1,155✔
499
        fun[2] &= ~DIRTYSYMFLAG;
1,155✔
500
        AT.WorkPointer = Lijst;
1,155✔
501
        return(retval);
1,155✔
502
}
503

504
/*
505
                 #] FullSymmetrize : 
506
                 #[ SymGen :
507

508
                Routine does the outer work in the symmetrization.
509
                It locates the function(s) and loads up the parameters.
510
                It also studies the result.
511

512
                if params[4] = -1 and no extra -> all
513
                                      extra -> strip groups with elements too large
514
                               0  -> if group with element too large: nofun
515
                                           >0 -> must have right number of arguments
516
*/
517

518
WORD SymGen(PHEAD WORD *term, WORD *params, WORD num, WORD level)
12✔
519
{
520
        GETBIDENTITY
521
        WORD *t, *r, *m;
12✔
522
        WORD i, j, k, c1, c2, ngroup;
12✔
523
        WORD *rstop, Nlist, *inLijst, *Lijst, sign = 1, sumch = 0, count;
12✔
524
        DUMMYUSE(num);
12✔
525
        c1 = params[3];                /* function number */
12✔
526
        c2 = FUNCTION + WILDOFFSET;
12✔
527
        Nlist = params[4];
12✔
528
        if ( Nlist < 0 ) Nlist = 0;
12✔
529
        else Nlist = params[0] - 7;
12✔
530
        t = term;
12✔
531
        m = t + *t;
12✔
532
        m -= ABS(m[-1]);
12✔
533
        t++;
12✔
534
        while ( t < m ) {
24✔
535
                if ( *t == c1 || c1 > c2 ) {        /* Candidate function */
12✔
536
                        if ( *t >= FUNCTION && functions[*t-FUNCTION].spec
12✔
537
                        >= TENSORFUNCTION ) {
538
                                count = t[1] - FUNHEAD;
×
539
                        }
540
                        else {
541
                                count = 0;
12✔
542
                                r = t;
12✔
543
                                rstop = t + t[1];
12✔
544
                                r += FUNHEAD;
12✔
545
                                while ( r < rstop ) { count++; NEXTARG(r) }
36✔
546
                        }
547
                        if ( ( j = params[4] ) > 0 && j != count ) goto NextFun;
12✔
548
                        if ( j == 0 ) {
12✔
549
                                inLijst = params+7;
12✔
550
                                for ( i = 0; i < Nlist; i++ )
12✔
551
                                        if ( inLijst[i] > count-1 ) goto NextFun;
×
552
                        }
553

554
                        if ( Nlist > (params[0] - 7) ) Nlist = params[0] - 7;
12✔
555
                        Lijst = AT.WorkPointer;
12✔
556
                        inLijst = params + 7;
12✔
557
                        ngroup = params[5];
12✔
558
                        if ( Nlist > 0 && j < 0 ) {
12✔
559
                                k = 0;
560
                                for ( i = 0; i < ngroup; i++ ) {
×
561
                                        for ( j = 0; j < params[6]; j++ ) {
×
562
                                                if ( inLijst[j] > count+1 ) {
×
563
                                                        inLijst += params[6];
×
564
                                                        goto NextGroup;
×
565
                                                }
566
                                        }
567
                                        j = params[6];
568
                                        NCOPY(Lijst,inLijst,j);
×
569
                                        k++;
×
570
NextGroup:;
×
571
                                }
572
                                if ( k <= 1 ) goto NextFun;
×
573
                                ngroup = k;
×
574
                                inLijst = AT.WorkPointer;
×
575
                                AT.WorkPointer = Lijst;
×
576
                                Lijst = inLijst;
×
577
                        }
578
                        else if ( Nlist == 0 ) {
12✔
579
                                for ( i = 0; i < count; i++ ) Lijst[i] = i;
36✔
580
                                AT.WorkPointer += count;
12✔
581
                                ngroup = count;
12✔
582
                        }
583
                        else {
584
                                for ( i = 0; i < Nlist; i++ ) Lijst[i] = inLijst[i];
×
585
                                AT.WorkPointer += Nlist;
×
586
                        }
587
                        j = Symmetrize(BHEAD t,Lijst,ngroup,params[6],params[2]);
12✔
588
                        AT.WorkPointer = Lijst;
12✔
589
                        if ( params[2] == 4 ) { /* antisymmetric */
12✔
590
                                if ( ( j & 1 ) != 0 ) sign = -sign;
×
591
                                if ( ( j & 2 ) != 0 ) return(0); /* equal arguments */
×
592
                        }
593
                        if ( ( j & 4 ) != 0 ) sumch++;
12✔
594
                        t[2] &= ~DIRTYSYMFLAG;
12✔
595
                }
596
NextFun:
×
597
                t += t[1];
12✔
598
        }
599
        if ( sign < 0 ) {
12✔
600
                t = term;
×
601
                t += *t - 1;
×
602
                *t = -*t;
×
603
        }
604
        if ( sumch ) {
12✔
605
                if ( Normalize(BHEAD term) ) {
6✔
606
                        MLOCK(ErrorMessageLock);
×
607
                        MesCall("SymGen");
×
608
                        MUNLOCK(ErrorMessageLock);
×
609
                        return(-1);
×
610
                }
611
                if ( !*term ) return(0);
6✔
612
                *AN.RepPoint = 1;
6✔
613
                AR.expchanged = 1;
6✔
614
                if ( AR.CurDum > AM.IndDum && AR.sLevel <= 0 ) ReNumber(BHEAD term);
6✔
615
        }
616
        return(Generator(BHEAD term,level));
12✔
617
}
618

619
/*
620
                 #] SymGen : 
621
                 #[ SymFind :
622

623
                There is a certain amount of double work here, as this routine
624
                finds the function to be treated, while the SymGen routine has
625
                to find it again. Note however that this way things remain
626
                uniform and simple. Moreover this avoids problems with actions
627
                on more than one function simultaneously.
628
                Output in AT.TMout:
629
                Number,sym/anti,fun,lenpar,ngroups,gsize,fields
630

631
*/
632

633
WORD SymFind(PHEAD WORD *term, WORD *params)
12✔
634
{
635
        GETBIDENTITY
636
        WORD *t, *r, *m;
12✔
637
        WORD j, c1, c2, count;
12✔
638
        WORD *rstop;
12✔
639
        c1 = params[4];                /* function number */
12✔
640
        c2 = FUNCTION + WILDOFFSET;
12✔
641
        t = term;
12✔
642
        m = t + *t;
12✔
643
        m -= ABS(m[-1]);
12✔
644
        t++;
12✔
645
        while ( t < m ) {
12✔
646
                if ( *t == c1 || c1 > c2 ) {        /* Candidate function */
12✔
647
                        if ( *t >= FUNCTION && functions[*t-FUNCTION].spec
12✔
648
                                >= TENSORFUNCTION ) { count = t[1] - FUNHEAD; }
×
649
                        else {
650
                                count = 0;
12✔
651
                                r = t;
12✔
652
                                rstop = t + t[1];
12✔
653
                                r += FUNHEAD;
12✔
654
                                while ( r < rstop ) { count++; NEXTARG(r) }
36✔
655
                        }
656
                        if ( ( j = params[5] ) > 0 && j != count ) goto NextFun;
12✔
657
                        if ( j == 0 ) {
12✔
658
                                r = params + 8;
12✔
659
                                rstop = params + params[1];
12✔
660
                                while ( r < rstop ) {
12✔
661
                                        if ( *r > count + 1 ) goto NextFun;
×
662
                                        r++;
×
663
                                }
664
                        }
665
                        
666
                        t = AT.TMout;
12✔
667
                        r = params;
12✔
668
                        j = r[1] - 1;
12✔
669
                        *t++ = j;
12✔
670
                        *t++ = SYMMETRIZE;
12✔
671
                        r += 3;
12✔
672
                        j--;
12✔
673
                        NCOPY(t,r,j);
84✔
674
                        return(1);
675
                }
676
NextFun:
×
677
                t += t[1];
×
678
        }
679
        return(0);
680
}
681

682
/*
683
                 #] SymFind : 
684
                 #[ ChainIn :
685

686
                Equivalent to repeat id f(?a)*f(?b) = f(?a,?b);
687

688
                This one always takes less space.
689
*/
690

691
int ChainIn(PHEAD WORD *term, WORD funnum)
123✔
692
{
693
        GETBIDENTITY
694
        WORD *t, *tend, *m, *tt, *ts;
123✔
695
        int action;
123✔
696
        if ( funnum < 0 ) {        /* Dollar to be expanded */
123✔
697
                funnum = DolToFunction(BHEAD -funnum);
×
698
                if ( AN.ErrorInDollar || funnum <= 0 ) {
×
699
                        MLOCK(ErrorMessageLock);
×
700
                        MesPrint("Dollar variable does not evaluate to function in ChainIn statement");
×
701
                        MUNLOCK(ErrorMessageLock);
×
702
                        return(-1);
×
703
                }
704
        }
705
        do {
210✔
706
                action = 0;
210✔
707
                tend = term+*term;
210✔
708
                tend -= ABS(tend[-1]);
210✔
709
                t = term+1;
210✔
710
                while ( t < tend ) {
453✔
711
                        if ( *t != funnum ) { t += t[1]; continue; }
330✔
712
                        m = t;
207✔
713
                        t += t[1];
207✔
714
                        tt = t;
207✔
715
                        if ( t >= tend || *t != funnum ) continue;
207✔
716
                        action = 1;
198✔
717
                        while ( t < tend && *t == funnum ) {
198✔
718
                                ts = t + t[1];
111✔
719
                                t += FUNHEAD;
111✔
720
                                while ( t < ts ) *tt++ = *t++;
333✔
721
                        }
722
                        m[1] = tt - m;
87✔
723
                        ts = term + *term;
87✔
724
                        while ( t < ts ) *tt++ = *t++;
1,338✔
725
                        *term = tt - term;
87✔
726
                        break;
87✔
727
                }
728
        } while ( action );
87✔
729
        return(0);
730
}
731

732
/*
733
                 #] ChainIn : 
734
                 #[ ChainOut :
735

736
                Equivalent to repeat id f(x1?,x2?,?a) = f(x1)*f(x2,?a);
737
*/
738

739
int ChainOut(PHEAD WORD *term, WORD funnum)
515✔
740
{
741
        GETBIDENTITY
742
        WORD *t, *tend, *tt, *ts, *w, *ws;
515✔
743
        int flag = 0, i;
515✔
744
        if ( funnum < 0 ) {        /* Dollar to be expanded */
515✔
745
                funnum = DolToFunction(BHEAD -funnum);
×
746
                if ( AN.ErrorInDollar || funnum <= 0 ) {
×
747
                        MLOCK(ErrorMessageLock);
×
748
                        MesPrint("Dollar variable does not evaluate to function in ChainOut statement");
×
749
                        MUNLOCK(ErrorMessageLock);
×
750
                        return(-1);
×
751
                }
752
        }
753
        tend = term+*term;
515✔
754
        if ( AT.WorkPointer < tend ) AT.WorkPointer = tend;
515✔
755
        tend -= ABS(tend[-1]);
515✔
756
        t = term+1; tt = term; w = AT.WorkPointer;
515✔
757
        while ( t < tend ) {
1,030✔
758
                if ( *t != funnum || t[1] == FUNHEAD ) { t += t[1]; continue; }
515✔
759
                flag = 1;
10✔
760
                while ( tt < t ) *w++ = *tt++;
10✔
761
                ts = t + t[1];
5✔
762
                t += FUNHEAD;
5✔
763
                while ( t < ts ) {
133✔
764
                        ws = w;
512✔
765
                        for ( i = 0; i < FUNHEAD; i++ ) *w++ = tt[i];
512✔
766
                        if ( functions[*tt-FUNCTION].spec >= TENSORFUNCTION ) {
128✔
767
                                *w++ = *t++;
×
768
                        }
769
                        else if ( *t < 0 ) {
128✔
770
                                if ( *t <= -FUNCTION ) *w++ = *t++;
109✔
771
                                else { *w++ = *t++; *w++ = *t++; }
109✔
772
                        }
773
                        else {
774
                                i = *t; NCOPY(w,t,i);
1,269✔
775
                        }
776
                        ws[1] = w - ws;
128✔
777
                }
778
                tt = t;
779
        }
780
        if ( flag == 1 ) {
515✔
781
                ts = term + *term;
5✔
782
                while ( tt < ts ) *w++ = *tt++;
20✔
783
                *AT.WorkPointer = w - AT.WorkPointer;
5✔
784
                t = term; w = AT.WorkPointer; i = *w;
5✔
785
                NCOPY(t,w,i)
1,877✔
786
                AT.WorkPointer = term + *term;
5✔
787
                Normalize(BHEAD term);
5✔
788
        }
789
        return(0);
790
}
791

792
/*
793
                 #] ChainOut : 
794
          #] Utilities : 
795
        #[ Patterns :
796
                 #[ MatchFunction :                        WORD MatchFunction(pattern,interm,wilds)
797

798
                The routine assumes that the function numbers are the same.
799
                The contents are compared and a possible wildcard assignment
800
                is made. Note that it may be necessary to use a wildcard
801
                assignment stack to do things right.
802
                The routine can become arbitrarily complicated as there is
803
                no end to the possible wildcarding.
804
                Examples:
805
                -        a:        No wildcarding -> straight match
806
                -        b:        Individual arguments (object -> object)
807
                -        c:        whole arguments (object to subexpression)
808
                -        d:        any argumentlist
809
                        e:        part of an argument (object inside subexpression)
810

811
                The ones with a minus sign in front have been implemented.
812

813
                Note: the argument wilds allows backtracking when multiple
814
                ?a,?b give a match that later turns out to be useless.
815
*/
816

817
WORD MatchFunction(PHEAD WORD *pattern, WORD *interm, WORD *wilds)
152,388✔
818
{
819
        GETBIDENTITY
820
        WORD *m, *t, *r, i;
152,388✔
821
        WORD *mstop = 0, *tstop = 0;
152,388✔
822
        WORD *argmstop, *argtstop;
152,388✔
823
        WORD *mtrmstop, *ttrmstop;
152,388✔
824
        WORD *msubstop, *mnextsub;
152,388✔
825
        WORD msizcoef, mcount, tcount, newvalue, j;
152,388✔
826
        WORD *oldm, *oldt;
152,388✔
827
        WORD *OldWork, numofwildarg;
152,388✔
828
        WORD nwstore, tobeeaten, reservevalue = 0, resernum = 0, withwild;
152,388✔
829
        WORD *wildargtaken;
152,388✔
830
        CBUF *C = cbuf+AT.ebufnum;
152,388✔
831
        int ntwa = AN.NumTotWildArgs;
152,388✔
832
        LONG oldcpointer = C->Pointer - C->Buffer;
152,388✔
833
/*
834
        Test first for a straight match
835
*/
836
        AN.RepFunList[AN.RepFunNum+1] = 0;
152,388✔
837
        if ( *wilds == 0 ) {
152,388✔
838
                m = pattern; t = interm;
152,382✔
839

840
                if ( *m != *t ) {
152,382✔
841
                        if ( *m < (FUNCTION + WILDOFFSET) ) return(0);
999✔
842
                        if ( *t < FUNCTION ) return(0);
999✔
843
                        if ( functions[*t-FUNCTION].spec !=
999✔
844
                        functions[*m-FUNCTION-WILDOFFSET].spec ) return(0);
999✔
845
                }
846
                i = m[1];
152,382✔
847
                if ( *m >= (FUNCTION + WILDOFFSET) ) { i--; m++; t++; }
152,382✔
848
                do { if ( *m++ != *t++ ) break; } while ( --i > 0 );
593,021✔
849
                if ( i <= 0 ) {                        /* Arguments match */
152,382✔
850
                        if ( AN.SignCheck && AN.ExpectedSign ) return(0);
36✔
851
                        i = *pattern - WILDOFFSET;
36✔
852
                        if ( i >= FUNCTION ) {
36✔
853
                                if ( *interm != GAMMA
×
854
#ifdef WITHFLOAT
855
                                && ( *interm != FLOATFUN )
×
856
#endif
857

858
                                && !CheckWild(BHEAD i,FUNTOFUN,*interm,&newvalue) ) {
×
859
                                        AddWild(BHEAD i,FUNTOFUN,newvalue);
×
860
                                        return(1);
×
861
                                }
862
                                return(0);
×
863
                        }
864
                        else return(1);
865
                }
866
        }
867
/*
868
        Store the current Wildcard assignments
869
*/
870
        t = wildargtaken = OldWork = AT.WorkPointer;
152,352✔
871
        t += ntwa;
152,352✔
872
        m = AN.WildValue;
152,352✔
873
        nwstore = i = (m[-SUBEXPSIZE+1]-SUBEXPSIZE)/4;
152,352✔
874
        if ( i > 0 ) {
152,352✔
875
                r = AT.WildMask;
152,168✔
876
                do {
165,944✔
877
                        *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *r++;
165,944✔
878
                } while ( --i > 0 );
165,944✔
879
                *t++ = C->numrhs;
152,168✔
880
        }
881
        if ( t >= AT.WorkTop ) {
152,352✔
882
                MLOCK(ErrorMessageLock);
×
883
                MesWork();
×
884
                MUNLOCK(ErrorMessageLock);
×
885
                Terminate(-1);
×
886
        }
887
        AT.WorkPointer = t;
152,352✔
888

889
        if ( *wilds ) {
152,352✔
890
                if ( *wilds == 1 ) goto endoloop;
6✔
891
                else               goto enloop;                        /* tensors = 2 */
×
892
        }
893
        m = pattern; t = interm;
152,346✔
894
/*
895
        Single out the specials
896
*/
897
        if ( *t == GAMMA ) {
152,346✔
898
/*
899
                 #[ GAMMA :
900

901
                For the gamma's we need to do two things:
902
                a:        Find that there is a match
903
                b:        Find where the match occurs in the string
904
                This last thing cannot be stored in the current conventions,
905
                but once the wildcard assignments have been made it is much
906
                easier to find it back.
907
                Alternative: replace the function number in the term temporarily
908
                by the offset inside the string. This makes things maybe easier.
909
*/
910
                if ( *m != GAMMA ) goto NoCaseB;
×
911
                i = t[1] - m[1];
×
912
                if ( m[1] == FUNHEAD+1 ) {
×
913
                        if ( i ) goto NoCaseB;
×
914
                        if ( m[FUNHEAD] < (AM.OffsetIndex+WILDOFFSET) ||
×
915
                        t[FUNHEAD] >= (AM.OffsetIndex+WILDOFFSET) ) goto NoCaseB;
×
916

917
                        if ( CheckWild(BHEAD m[FUNHEAD]-WILDOFFSET,INDTOIND,t[FUNHEAD],&newvalue) ) goto NoCaseB;
×
918
                        AddWild(BHEAD m[FUNHEAD]-WILDOFFSET,INDTOIND,newvalue);
×
919
                        
920
                        AT.WorkPointer = OldWork;
×
921
                        if ( AN.SignCheck && AN.ExpectedSign ) return(0);
×
922
                        return(1);                /* m was eaten. we have a match! */
×
923
                }
924
                if ( i < 0 ) goto NoCaseB;        /* Pattern longer than target */
×
925
                mstop = m + m[1];
×
926
                tstop = t + t[1];
×
927
                m += FUNHEAD; t += FUNHEAD;
×
928
                if ( *m >= (AM.OffsetIndex+WILDOFFSET) && *t < (AM.OffsetIndex+WILDOFFSET) ) {
×
929
                        if ( CheckWild(BHEAD *m-WILDOFFSET,INDTOIND,*t,&newvalue) ) goto NoCaseB;
×
930
                        reservevalue = newvalue;
×
931
                        withwild = 1;
×
932
                        resernum = *m-WILDOFFSET;
×
933
                        AddWild(BHEAD *m-WILDOFFSET,INDTOIND,newvalue);
×
934
                }
935
                else if ( *m != *t ) goto NoCaseB;
×
936
                else withwild = 0;
937
                m++; t++;
×
938
                oldm = m; argtstop = oldt = t;
×
939
                j = 0;                                        /* No wildcard assignments yet */
×
940
                while ( i >= 0 ) {
×
941
                        if ( *m == *t ) {
×
942
WithGamma:                m++; t++;
×
943
                                if ( m >= mstop ) {
×
944
                                        if ( t < tstop && mstop < AN.patstop ) {
×
945
                                                WORD k;
×
946
                                                mnextsub = pattern + pattern[1];
×
947
                                                k = *mnextsub;
×
948
                                                while ( k == GAMMA && mnextsub[FUNHEAD]
×
949
                                                != pattern[FUNHEAD] ) {
×
950
                                                        mnextsub += mnextsub[1];
×
951
                                                        if ( mnextsub >= AN.patstop ) goto FullOK;
×
952
                                                        k = *mnextsub;
×
953
                                                }
954
                                                if ( k >= FUNCTION ) {
×
955
                                                        if ( k > (FUNCTION + WILDOFFSET) ) k -= WILDOFFSET;
×
956
                                                        if ( functions[k-FUNCTION].commute ) goto NoGamma;
×
957
                                                }
958
                                        }
959
FullOK:                                if ( AN.SignCheck && AN.ExpectedSign ) goto NoGamma;
×
960
                                        AN.RepFunList[AN.RepFunNum+1] = WORDDIF(oldt,argtstop);
×
961
                                        return(1);
×
962
                                }
963
                                if ( t >= tstop ) goto NoCaseB;
×
964
                        }
965
                        else if ( *m >= (AM.OffsetIndex+WILDOFFSET)
×
966
                        && *m < (AM.OffsetIndex + (WILDOFFSET<<1)) && ( *t >= 0 ||
×
967
                        *t < MINSPEC ) ) {                        /* Wildcard index */
968
                                if ( !CheckWild(BHEAD *m-WILDOFFSET,INDTOIND,*t,&newvalue) ) {
×
969
                                        AddWild(BHEAD *m-WILDOFFSET,INDTOIND,newvalue);
×
970
                                        j = 1;
×
971
                                        goto WithGamma;
×
972
                                }
973
                                else goto NoGamma;
×
974
                        }
975
                        else if ( *m < MINSPEC && *m >= (AM.OffsetVector+WILDOFFSET)
×
976
                        && *t < MINSPEC ) {                        /* Wildcard vecor */
×
977
                                if ( !CheckWild(BHEAD *m-WILDOFFSET,VECTOVEC,*t,&newvalue) ) {
×
978
                                        AddWild(BHEAD *m-WILDOFFSET,VECTOVEC,newvalue);
×
979
                                        j = 1;
×
980
                                        goto WithGamma;
×
981
                                }
982
                                else goto NoGamma;
×
983
                        }
984
                        else {
985
NoGamma:
×
986
                                if ( j ) {                /* Undo wildcards */
×
987
                                        m = AN.WildValue;
×
988
                                        t = OldWork + AN.NumTotWildArgs; r = AT.WildMask; j = nwstore;
×
989
                                        if ( j > 0 ) {
×
990
                                                do {
×
991
                                                        *m++ = *t++; *m++ = *t++;
×
992
                                                        *m++ = *t++; *m++ = *t++; *r++ = *t++;
×
993
                                                } while ( --j > 0 );
×
994
                                                C->numrhs = *t++;
×
995
                                                C->Pointer = C->Buffer + oldcpointer;
×
996
                                        }
997
                                        j = 0;
998
                                }
999
                                m = oldm; t = ++oldt; i--;
×
1000
                                if ( withwild ) {
×
1001
                                        AddWild(BHEAD resernum,INDTOIND,reservevalue);
×
1002
                                }
1003
                        }
1004
                }
1005
                goto NoCaseB;
×
1006
/*
1007
                 #] GAMMA : 
1008
                 #[ Tensors :
1009
*/
1010
        }
1011
        else if ( *t >= FUNCTION && functions[*t-FUNCTION].spec >= TENSORFUNCTION ) {
152,346✔
1012
                mstop = m + m[1];
×
1013
                tstop = t + t[1];
×
1014
                mcount = 0;
×
1015
                m += FUNHEAD;
×
1016
                t += FUNHEAD;
×
1017
                AN.WildArgs = 0;
×
1018
                tcount = WORDDIF(tstop,t);
×
1019
                while ( m < mstop ) {
×
1020
                        if ( *m == FUNNYWILD ) { m++; AN.WildArgs++; }
×
1021
                        m++; mcount++;
×
1022
                }
1023
                tobeeaten = tcount - mcount + AN.WildArgs;
×
1024
                if ( tobeeaten ) {
×
1025
                        if ( tobeeaten < 0 || AN.WildArgs == 0 ) {
×
1026
                                AT.WorkPointer = OldWork;
×
1027
                                return(0);        /* Cannot match */
×
1028
                        }
1029
                }
1030
                AT.WildArgTaken[0] = AN.WildEat = tobeeaten;
×
1031
                for ( i = 1; i < AN.WildArgs; i++ ) AT.WildArgTaken[i] = 0;
×
1032
toploop:
×
1033
                numofwildarg = 0;
×
1034

1035
                m = pattern; t = interm;
×
1036
                mstop = m + m[1];
×
1037
                if ( *m != *t ) {
×
1038
                        i = *m - WILDOFFSET;
×
1039
                        if ( CheckWild(BHEAD i,FUNTOFUN,*t,&newvalue) ) goto NoCaseB;
×
1040
                        AddWild(BHEAD i,FUNTOFUN,newvalue);
×
1041
                }
1042
                m += FUNHEAD;
×
1043
                t += FUNHEAD;
×
1044
                while ( m < mstop ) {
×
1045
/*
1046
                        First test for an exact match
1047
*/
1048
                        if ( *m == *t ) { m++; t++; continue; }
×
1049
/*
1050
                        No exact match. Try ARGWILD
1051
*/
1052
                        AN.argaddress = t;
×
1053
                        if ( *m == FUNNYWILD ) {
×
1054
                                tobeeaten = AT.WildArgTaken[numofwildarg++];
×
1055
                                i = tobeeaten | EATTENSOR;
×
1056
                                if ( CheckWild(BHEAD m[1],ARGTOARG,i,t) ) goto endloop;
×
1057
                                AddWild(BHEAD m[1],ARGTOARG,i);
×
1058
                                m += 2;
×
1059
                                t += tobeeaten;
×
1060
                                continue;
×
1061
                        }
1062
/*
1063
                        Now the various cases:
1064
*/
1065
                        i = *m;
×
1066
                        if ( i < MINSPEC ) {
×
1067
                                if ( *t != i ) {
×
1068
                                        if ( *t >= MINSPEC ) goto endloop;
×
1069
                                        i -= WILDOFFSET;
×
1070
                                        if ( i < AM.OffsetVector ) goto endloop;
×
1071
                                        if ( CheckWild(BHEAD i,VECTOVEC,*t,&newvalue) )
×
1072
                                                goto endloop;
×
1073
                                        AddWild(BHEAD i,VECTOVEC,newvalue);
×
1074
                                }
1075
                        }
1076
                        else if ( i >= AM.OffsetIndex ) {                        /* Index */
×
1077
                                if ( i < ( AM.OffsetIndex + WILDOFFSET ) ) goto endloop;
×
1078
                                if ( i >= ( AM.OffsetIndex + (WILDOFFSET<<1) ) ) {
×
1079
                                                                                                /* Summed over index */
1080
                                        goto endloop;                                /* For the moment */
×
1081
                                }
1082
                                i -= WILDOFFSET;
×
1083
                                if ( CheckWild(BHEAD i,INDTOIND,*t,&newvalue) )
×
1084
                                        goto endloop;                /* Assignment not allowed */
×
1085
                                AddWild(BHEAD i,INDTOIND,newvalue);
×
1086
                        }
1087
                        else goto endloop;
×
1088
                        m++; t++;
×
1089
                }
1090
                if ( AN.SignCheck && AN.ExpectedSign ) goto endloop;
×
1091
                AT.WorkPointer = OldWork;
×
1092
                if ( AN.WildArgs > 1 ) *wilds = 2;
×
1093
                return(1);                /* m was eaten. we have a match! */
×
1094

1095
endloop:;
×
1096
/*
1097
        restore the current Wildcard assignments
1098
*/
1099
                i = nwstore;
×
1100
                if ( i > 0 ) {
×
1101
                        m = AN.WildValue;
×
1102
                        t = OldWork + ntwa; r = AT.WildMask;
×
1103
                        do {
×
1104
                                *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
×
1105
                        } while ( --i > 0 );
×
1106
                        C->numrhs = *t++;
×
1107
                        C->Pointer = C->Buffer + oldcpointer;
×
1108
                }
1109
enloop:;
×
1110
                i = AN.WildArgs - 1;
×
1111
                if ( i <= 0 ) {
×
1112
                        AT.WorkPointer = OldWork;
×
1113
                        return(0);
×
1114
                }
1115
                while ( --i >= 0 ) {
×
1116
                        if ( AT.WildArgTaken[i] == 0 ) {
×
1117
                                if ( i == 0 ) {
×
1118
                                        AT.WorkPointer = OldWork;
×
1119
                                        *wilds = 0;
×
1120
                                        return(0);
×
1121
                                }
1122
                        }
1123
                        else {
1124
                                (AT.WildArgTaken[i])--;
×
1125
                                numofwildarg = 0;
×
1126
                                for ( j = 0; j <= i; j++ ) {
×
1127
                                        numofwildarg += AT.WildArgTaken[j];
×
1128
                                }
1129
                                AT.WildArgTaken[j] = AN.WildEat-numofwildarg;
×
1130
                                for ( j++; j < AN.WildArgs; j++ ) AT.WildArgTaken[j] = 0;
×
1131
                                break;
1132
                        }
1133
                }
1134
                goto toploop;
×
1135
/*
1136
                 #] Tensors : 
1137
*/
1138
        }
1139
/*
1140
        Count the number of arguments. Either equal or an argument wildcard.
1141
*/
1142
        mstop = m + m[1];
152,346✔
1143
        tstop = t + t[1];
152,346✔
1144
        mcount = 0; tcount = 0;
152,346✔
1145
        m += FUNHEAD; t += FUNHEAD;
152,346✔
1146
        while ( t < tstop ) { tcount++; NEXTARG(t) }
562,371✔
1147
        AN.WildArgs = 0;
152,346✔
1148
        while ( m < mstop ) {
317,922✔
1149
                mcount++;
165,576✔
1150
                if ( *m == -ARGWILD ) AN.WildArgs++;
165,576✔
1151
                NEXTARG(m)
165,576✔
1152
        }
1153
        tobeeaten = tcount - mcount + AN.WildArgs;
152,346✔
1154
        if ( tobeeaten ) {
152,346✔
1155
                if ( tobeeaten < 0 || AN.WildArgs == 0 ) {
7,188✔
1156
                        AT.WorkPointer = OldWork;
36✔
1157
                        return(0);        /* Cannot match */
36✔
1158
                }
1159
        }
1160
/*
1161
        Set up the array AT.WildArgTaken for the number of arguments that each
1162
        wildarg eats.
1163
*/
1164
        AT.WildArgTaken[0] = AN.WildEat = tobeeaten;
152,310✔
1165
        for ( i = 1; i < AN.WildArgs; i++ ) AT.WildArgTaken[i] = 0;
158,508✔
1166
topofloop:
152,310✔
1167
        numofwildarg = 0;
2,989,908✔
1168
/*
1169
        Test for single wildcard object/argument
1170
*/
1171
        m = pattern; t = interm;
2,989,908✔
1172
        if ( *m != *t ) {
2,989,908✔
1173
                i = *m - WILDOFFSET;
999✔
1174
                if ( CheckWild(BHEAD i,FUNTOFUN,*t,&newvalue) ) goto NoCaseB;
999✔
1175
                AddWild(BHEAD i,FUNTOFUN,newvalue);
999✔
1176
        }
1177
        mstop = m + m[1];
2,989,908✔
1178
/*        tstop = t + t[1];  */
1179
        m += FUNHEAD;
2,989,908✔
1180
        t += FUNHEAD;
2,989,908✔
1181
        while ( m < mstop ) {
11,667,660✔
1182
                argmstop = oldm = m;
11,515,590✔
1183
                argtstop = oldt = t;
11,515,590✔
1184
                NEXTARG(argmstop)
11,515,590✔
1185
                NEXTARG(argtstop)
11,515,590✔
1186
                if ( t == tstop ) { /* This concerns a very rare bug */
11,515,590✔
1187
                        if ( *m == -ARGWILD ) goto ArgAll;
266✔
1188
                        goto endofloop;
×
1189
                }
1190
                if ( *m < 0 && *t < 0 ) {
11,515,340✔
1191
                        if ( *t <= -FUNCTION ) {
11,514,240✔
1192
                                if ( *t == *m ) {}
6✔
1193
                                else if ( *m <= -FUNCTION-WILDOFFSET
6✔
1194
                                && functions[-*t-FUNCTION].spec
×
1195
                                == functions[-*m-FUNCTION-WILDOFFSET].spec ) {
×
1196
                                        i = -*m - WILDOFFSET;
×
1197
                                        if ( CheckWild(BHEAD i,FUNTOFUN,-*t,&newvalue) ) goto endofloop;
×
1198
                                        AddWild(BHEAD i,FUNTOFUN,newvalue);
×
1199
                                }
1200
                                else if ( *m == -SYMBOL && m[1] >= 2*MAXPOWER ) {
6✔
1201
                                        i = m[1] - 2*MAXPOWER;
×
1202
                                        AN.argaddress = AT.FunArg;
×
1203
                                        AT.FunArg[ARGHEAD+1] = -*t;
×
1204
                                        if ( CheckWild(BHEAD i,SYMTOSUB,1,AN.argaddress) ) goto endofloop;
×
1205
                                        AddWild(BHEAD i,SYMTOSUB,0);
×
1206
                                }
1207
                                else if ( *m == -ARGWILD ) {
6✔
1208
ArgAll:                                i = AT.WildArgTaken[numofwildarg++];
6✔
1209
                                        AN.argaddress = t;
5,688,420✔
1210
                                        if ( CheckWild(BHEAD m[1],ARGTOARG,i,t) ) goto endofloop;
5,688,420✔
1211
                                        AddWild(BHEAD m[1],ARGTOARG,i);
5,688,420✔
1212
/*                                        m += 2; */
1213
                                        while ( --i >= 0 ) { NEXTARG(t) }
157,769,600✔
1214
                                        argtstop = t;
1215
                                }
1216
                                else goto endofloop;
×
1217
                        }
1218
                        else if ( *t == *m ) {
11,514,240✔
1219
                                if ( t[1] == m[1] ) {}
5,681,430✔
1220
                                else if ( *t == -SYMBOL ) {
5,681,280✔
1221
                                        j = SYMTOSYM;
1222
SymAll:
144,032✔
1223
                                        if ( ( i = m[1] - 2*MAXPOWER ) < 0 ) goto endofloop;
144,032✔
1224
                                        if ( CheckWild(BHEAD i,j,t[1],&newvalue) ) goto endofloop;
144,032✔
1225
                                        AddWild(BHEAD i,j,newvalue);
143,921✔
1226
                                }
1227
                                else if ( *t == -INDEX ) {
5,681,130✔
1228
IndAll:                                i = m[1] - WILDOFFSET;
18✔
1229
                                        if ( i < AM.OffsetIndex || i >= WILDOFFSET+AM.OffsetIndex )
834✔
1230
                                                                                                                        goto endofloop;
×
1231
                                                                /* We kill the summed over indices here */
1232
                                        if ( CheckWild(BHEAD i,INDTOIND,t[1],&newvalue) ) goto endofloop;
834✔
1233
                                        AddWild(BHEAD i,INDTOIND,newvalue);
810✔
1234
                                }
1235
                                else if ( *t == -VECTOR || *t == -MINVECTOR ) {
5,681,100✔
1236
                                        i = m[1] - WILDOFFSET;
5,681,070✔
1237
                                        if ( i < AM.OffsetVector ) goto endofloop;
5,681,070✔
1238
                                        if ( CheckWild(BHEAD i,VECTOVEC,t[1],&newvalue) ) goto endofloop;
5,681,070✔
1239
                                        AddWild(BHEAD i,VECTOVEC,newvalue);
2,843,543✔
1240
                                }
1241
                                else goto endofloop;
24✔
1242
                        }
1243
                        else if ( *m == -ARGWILD ) goto ArgAll;
5,832,810✔
1244
                        else if ( *m == -INDEX && m[1] >= AM.OffsetIndex+WILDOFFSET
144,794✔
1245
                        && m[1] < AM.OffsetIndex+(WILDOFFSET<<1) ) {
897✔
1246
                                if ( *t == -VECTOR ) goto IndAll;
897✔
1247
                                if ( *t == -SNUMBER && t[1] >= 0 && t[1] < AM.OffsetIndex ) goto IndAll;
891✔
1248
                                if ( *t == -MINVECTOR ) {
81✔
1249
                                        i = m[1] - WILDOFFSET;
×
1250
                                        AN.argaddress = AT.MinVecArg;
×
1251
                                        AT.MinVecArg[ARGHEAD+3] = t[1];
×
1252
                                        if ( CheckWild(BHEAD i,INDTOSUB,1,AN.argaddress) ) goto endofloop;
×
1253
                                        AddWild(BHEAD i,INDTOSUB,(WORD)0);
×
1254
                                }
1255
                                else goto endofloop;
81✔
1256
                        }
1257
                        else if ( *m == -SYMBOL && m[1] >= 2*MAXPOWER && *t == -SNUMBER ) {
143,897✔
1258
                                j = SYMTONUM;
143,870✔
1259
                                goto SymAll;
143,870✔
1260
                        }
1261
                        else if ( *m == -VECTOR && *t == -MINVECTOR &&
27✔
1262
                        ( i = m[1] - WILDOFFSET ) >= AM.OffsetVector ) {
15✔
1263
/*
1264
================================
1265
                                AN.argaddress = AT.MinVecArg;
1266
                                AT.MinVecArg[ARGHEAD+3] = t[1];
1267
                                if ( CheckWild(BHEAD i,VECTOSUB,1,AN.argaddress) ) goto endofloop;
1268
                                AddWild(BHEAD i,VECTOSUB,(WORD)0);
1269
================================
1270
*/
1271
                                if ( CheckWild(BHEAD i,VECTOMIN,t[1],&newvalue) ) goto endofloop;
15✔
1272
                                AddWild(BHEAD i,VECTOMIN,newvalue);
9✔
1273

1274
                        }
1275
                        else if ( *m == -MINVECTOR && *t == -VECTOR &&
12✔
1276
                        ( i = m[1] - WILDOFFSET ) >= AM.OffsetVector ) {
6✔
1277
/*
1278
================================
1279
                                AN.argaddress = AT.MinVecArg;
1280
                                AT.MinVecArg[ARGHEAD+3] = t[1];
1281
                                if ( CheckWild(BHEAD i,VECTOSUB,1,AN.argaddress) ) goto endofloop;
1282
                                AddWild(BHEAD i,VECTOSUB,(WORD)0);
1283
================================
1284
*/
1285
                                if ( CheckWild(BHEAD i,VECTOMIN,t[1],&newvalue) ) goto endofloop;
6✔
1286
                                AddWild(BHEAD i,VECTOMIN,newvalue);
×
1287
                        }
1288
                        else goto endofloop;
6✔
1289
                }
1290
                else if ( *t <= -FUNCTION && *m > 0 ) {
1,077✔
1291
                        if ( ( m[ARGHEAD]+ARGHEAD == *m ) && m[*m-1] == 3
18✔
1292
                        && m[*m-2] == 1 && m[*m-3] == 1 && m[ARGHEAD+1] >= FUNCTION
18✔
1293
                        && m[ARGHEAD+2] == *m-ARGHEAD-4 ) { /* Check for f(?a) etc */
18✔
1294
                                WORD *mmmst, *mmm;
18✔
1295
                                if ( m[ARGHEAD+1] >= FUNCTION+WILDOFFSET ) {
18✔
1296
/*                                        i = *m - WILDOFFSET; */
1297
                                        i = m[ARGHEAD+1] - WILDOFFSET;
18✔
1298
                                        if ( CheckWild(BHEAD i,FUNTOFUN,-*t,&newvalue) ) goto endofloop;
18✔
1299
                                        AddWild(BHEAD i,FUNTOFUN,newvalue);
18✔
1300
                                }
1301
                                else if ( m[ARGHEAD+1] != -*t ) goto endofloop;
×
1302
/*
1303
                                        Only arguments allowed are ?a etc.
1304
*/
1305
                                mmmst = m+*m-3;
18✔
1306
                                mmm = m + ARGHEAD + FUNHEAD + 1;
18✔
1307
                                while ( mmm < mmmst ) {
36✔
1308
                                        if ( *mmm != -ARGWILD ) goto endofloop;
18✔
1309
                                        i = 0;
18✔
1310
                                        AN.argaddress = t;
18✔
1311
                                        if ( CheckWild(BHEAD mmm[1],ARGTOARG,i,t) ) goto endofloop;
18✔
1312
                                        AddWild(BHEAD mmm[1],ARGTOARG,i);
18✔
1313
                                        mmm += 2;
18✔
1314
                                }
1315
                        }
1316
                        else goto endofloop;
×
1317
                }
1318
                else if ( *m < 0 && *t > 0 ) {
1,059✔
1319
                        if ( *m == -SYMBOL ) {                        /* SYMTOSUB */
492✔
1320
                                if ( m[1] < 2*MAXPOWER ) goto endofloop;
336✔
1321
                                i = m[1] - 2*MAXPOWER;
327✔
1322
                                AN.argaddress = t;
327✔
1323
                                if ( CheckWild(BHEAD i,SYMTOSUB,1,AN.argaddress) ) goto endofloop;
327✔
1324
                                AddWild(BHEAD i,SYMTOSUB,0);
318✔
1325
                        }
1326
                        else if ( *m == -VECTOR ) {
156✔
1327
                                if ( ( i = m[1] - WILDOFFSET ) < AM.OffsetVector )
×
1328
                                                                                                                        goto endofloop;
×
1329
                                AN.argaddress = t;
×
1330
                                if ( CheckWild(BHEAD i,VECTOSUB,1,t) ) goto endofloop;
×
1331
                                AddWild(BHEAD i,VECTOSUB,(WORD)0);
×
1332
                        }
1333
                        else if ( *m == -INDEX ) {
156✔
1334
                                if ( ( i = m[1] - WILDOFFSET ) < AM.OffsetIndex ) goto endofloop;
×
1335
                                if ( i >= AM.OffsetIndex + WILDOFFSET ) goto endofloop;
×
1336
                                AN.argaddress = t;
×
1337
                                if ( CheckWild(BHEAD i,INDTOSUB,1,AN.argaddress) ) goto endofloop;
×
1338
                                AddWild(BHEAD i,INDTOSUB,(WORD)0);
×
1339
                        }
1340
                        else if ( *m == -ARGWILD ) goto ArgAll;
156✔
1341
                        else goto endofloop;
18✔
1342
                }
1343
                else if ( *m > 0 && *t > 0 ) {
567✔
1344
                        WORD ii = *t-*m;
873✔
1345
                        i = *m;
873✔
1346
                        do { if ( *m++ != *t++ ) break; } while ( --i > 0 );
873✔
1347
                        if ( i == 1 && ii == 0 ) {        /* sign difference */
567✔
1348
                                goto endofloop;
3✔
1349
                        }
1350
                        else if ( i > 0 ) {
564✔
1351
                                WORD *cto, *cfrom, *csav, ci;
564✔
1352
                                WORD oRepFunNum;
564✔
1353
                                WORD *oRepFunList;
564✔
1354
                                WORD *oterstart,*oterstop,*opatstop;
564✔
1355
                                WORD oExpectedSign;
564✔
1356
                                WORD wildargs, wildeat;
564✔
1357
/*
1358
                                Not an exact match here.
1359
                                We have to hope that the pattern contains a composite wildcard.
1360
*/
1361
                                m = oldm; t = oldt;
564✔
1362
                                m += ARGHEAD; t += ARGHEAD;                        /* Point at (first?) term */
564✔
1363
                                mtrmstop = m + *m;
564✔
1364
                                ttrmstop = t + *t;
564✔
1365
                                if ( mtrmstop < argmstop ) goto endofloop;/* More than one term */
564✔
1366
                                msizcoef = mtrmstop[-1];
564✔
1367
                                if ( msizcoef < 0 ) msizcoef = -msizcoef;
564✔
1368
                                msubstop = mtrmstop - msizcoef;
564✔
1369
                                m++;
564✔
1370
                                if ( m >= msubstop ) goto endofloop;        /* Only coefficient */
564✔
1371
/*
1372
                                Here we have a composite term. It can match provided it
1373
                                matches the entire argument. This argument must be a
1374
                                single term also and the coefficients should match
1375
                                (more or less).
1376
                                The matching takes:
1377
                                1:        Match the functions etc. Nothing can be left.
1378
                                2:        Match dotproducts and symbols. ONLY must match
1379
                                        and nothing may be left.
1380
                                For safety it is best to take the term out and put it
1381
                                in workspace.
1382
*/
1383

1384
                                if ( argtstop > ttrmstop ) goto endofloop;
564✔
1385
                                m--;
564✔
1386
                                oterstart = AN.terstart;
564✔
1387
                                oterstop = AN.terstop;
564✔
1388
                                opatstop = AN.patstop;
564✔
1389
                                oRepFunList = AN.RepFunList;
564✔
1390
                                oRepFunNum = AN.RepFunNum;
564✔
1391
                                AN.RepFunNum = 0;
564✔
1392
                                AN.RepFunList = AT.WorkPointer;
564✔
1393
                        AT.WorkPointer = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
564✔
1394
                                if ( AT.WorkPointer+*t+5 > AT.WorkTop ) {
564✔
1395
                                        MLOCK(ErrorMessageLock);
×
1396
                                        MesWork();
×
1397
                                        MUNLOCK(ErrorMessageLock);
×
1398
                                        return(-1);
×
1399
                                }
1400
                                csav = cto = AT.WorkPointer;
12,288✔
1401
                                cfrom = t;
1402
                                ci = *t;
1403
                                while ( --ci >= 0 ) *cto++ = *cfrom++;
12,288✔
1404
                                AT.WorkPointer = cto;
564✔
1405
                                ci = msizcoef;
564✔
1406
                                cfrom = mtrmstop;
564✔
1407
                                --ci;
564✔
1408
                                if ( abs(*--cfrom) != abs(*--cto) ) {
564✔
1409
                                        AT.WorkPointer = csav;
×
1410
                                        AN.RepFunList = oRepFunList;
×
1411
                                        AN.RepFunNum = oRepFunNum;
×
1412
                                        AN.terstart = oterstart;
×
1413
                                        AN.terstop = oterstop;
×
1414
                                        AN.patstop = opatstop;
×
1415
                                        goto endofloop;
×
1416
                                }
1417
                                i = (*cfrom != *cto) ? 1 : 0; /* buffer AN.ExpectedSign until we are beyond the goto */
564✔
1418
                                while ( --ci >= 0 ) {
1,692✔
1419
                                        if ( *--cfrom != *--cto ) {
1,128✔
1420
                                                AT.WorkPointer = csav;
×
1421
                                                AN.RepFunList = oRepFunList;
×
1422
                                                AN.RepFunNum = oRepFunNum;
×
1423
                                                AN.terstart = oterstart;
×
1424
                                                AN.terstop = oterstop;
×
1425
                                                AN.patstop = opatstop;
×
1426
                                                goto endofloop;
×
1427
                                        }
1428
                                }
1429
                                oExpectedSign =  AN.ExpectedSign; /* buffer AN.ExpectedSign until we are beyond FindRest/FindOnly */
564✔
1430
                                AN.ExpectedSign = i;
564✔
1431
                                *m -= msizcoef;
564✔
1432
                                wildargs = AN.WildArgs;
564✔
1433
                                wildeat = AN.WildEat;
564✔
1434
                                for ( i = 0; i < wildargs; i++ ) wildargtaken[i] = AT.WildArgTaken[i];
564✔
1435
                                AN.ForFindOnly = 0; AN.UseFindOnly = 1;
564✔
1436
                                AN.nogroundlevel++;
564✔
1437
                                if ( FindRest(BHEAD csav,m) && ( AN.UsedOtherFind || FindOnly(BHEAD csav,m) ) ) {}
564✔
1438
                                else {
1439
nomatch:
6✔
1440
                                        *m += msizcoef;
6✔
1441
                                        AT.WorkPointer = csav;
6✔
1442
                                        AN.RepFunList = oRepFunList;
6✔
1443
                                        AN.RepFunNum = oRepFunNum;
6✔
1444
                                        AN.terstart = oterstart;
6✔
1445
                                        AN.terstop = oterstop;
6✔
1446
                                        AN.patstop = opatstop;
6✔
1447
                                        AN.WildArgs = wildargs;
6✔
1448
                                        AN.WildEat = wildeat;
6✔
1449
                                        AN.ExpectedSign = oExpectedSign;
6✔
1450
                                        AN.nogroundlevel--;
6✔
1451
                                        for ( i = 0; i < wildargs; i++ ) AT.WildArgTaken[i] = wildargtaken[i];
6✔
1452
                                        goto endofloop;
6✔
1453
                                }
1454
/*                                if ( *m == 1 || m[1] < FUNCTION || functions[m[1]-FUNCTION].spec >= TENSORFUNCTION ) { */
1455
                                if ( *m == 1 || m[1] < FUNCTION ) {
558✔
1456
                                        if ( AN.ExpectedSign ) goto nomatch;
×
1457
                                }
1458
                                else {
1459
                                        if ( m[1] > FUNCTION + WILDOFFSET ) {
558✔
1460
                                                if ( functions[m[1]-FUNCTION-WILDOFFSET].spec >= TENSORFUNCTION ) {
552✔
1461
                                                        if ( AN.ExpectedSign != AN.RepFunList[AN.RepFunNum-1] ) goto nomatch;
×
1462
                                                }
1463
                                        }
1464
                             else {
1465
                                                if ( AN.ExpectedSign != AN.RepFunList[AN.RepFunNum-1] ) goto nomatch;
6✔
1466
/*
1467
                                                if ( functions[m[1]-FUNCTION].spec >= TENSORFUNCTION ) {
1468
                                                        if ( AN.ExpectedSign != AN.RepFunList[AN.RepFunNum-1] ) goto nomatch;
1469
                                                }
1470
*/
1471
                                        }
1472
                                }
1473
                                AN.nogroundlevel--;
558✔
1474
                                AN.ExpectedSign = oExpectedSign;
558✔
1475
                                AN.WildArgs = wildargs;
558✔
1476
                                AN.WildEat = wildeat;
558✔
1477
                                for ( i = 0; i < wildargs; i++ ) AT.WildArgTaken[i] = wildargtaken[i];
558✔
1478
                                Substitute(BHEAD csav,m,1);
558✔
1479
                                cto = csav;
558✔
1480
                                cfrom = cto + *cto - msizcoef;
558✔
1481
                                cto++;
558✔
1482
                                *m += msizcoef;
558✔
1483
                                AT.WorkPointer = csav;
558✔
1484
                                AN.RepFunList = oRepFunList;
558✔
1485
                                AN.RepFunNum = oRepFunNum;
558✔
1486
                                AN.terstart = oterstart;
558✔
1487
                                AN.terstop = oterstop;
558✔
1488
                                AN.patstop = opatstop;
558✔
1489
                                if ( *cto != SUBEXPRESSION ) goto endofloop;
558✔
1490
                                cto += cto[1];
558✔
1491
                                if ( cto < cfrom ) goto endofloop;
558✔
1492
                        }
1493
                }
1494
                else goto endofloop;
×
1495

1496
                t = argtstop;                                                /* Next argument */
1497
                m = argmstop;
1498
        }
1499
        if ( AN.SignCheck && AN.ExpectedSign ) goto endofloop;
152,070✔
1500
        AT.WorkPointer = OldWork;
152,070✔
1501
        if ( AN.WildArgs > 1 ) *wilds = 1;
152,070✔
1502
        if ( AN.SignCheck && AN.ExpectedSign ) return(0);
152,070✔
1503
        return(1);                /* m was eaten. we have a match! */
1504

1505
endofloop:;
2,837,840✔
1506
/*
1507
        restore the current Wildcard assignments
1508
*/
1509
        i = nwstore;
2,837,840✔
1510
        if ( i > 0 ) {
2,837,840✔
1511
                m = AN.WildValue;
2,837,786✔
1512
                t = OldWork + ntwa; r = AT.WildMask;
2,837,786✔
1513
                do {
11,350,920✔
1514
                        *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
11,350,920✔
1515
                } while ( --i > 0 );
11,350,920✔
1516
                C->numrhs = *t++;
2,837,786✔
1517
                C->Pointer = C->Buffer + oldcpointer;
2,837,786✔
1518
        }
1519

1520
endoloop:;
54✔
1521
        i = AN.WildArgs-1;
2,837,846✔
1522
        if ( i <= 0 ) {
2,837,846✔
1523
                AT.WorkPointer = OldWork;
177✔
1524
                return(0);
177✔
1525
        }
1526
        while ( --i >= 0 ) {
2,963,102✔
1527
                if ( AT.WildArgTaken[i] == 0 ) {
2,963,102✔
1528
                        if ( i == 0 ) {
125,502✔
1529
                                AT.WorkPointer = OldWork;
69✔
1530
                                return(0);
69✔
1531
                        }
1532
                }
1533
                else {
1534
                        (AT.WildArgTaken[i])--;
2,837,600✔
1535
                        numofwildarg = 0;
2,837,600✔
1536
                        for ( j = 0; j <= i; j++ ) {
8,387,300✔
1537
                                numofwildarg += AT.WildArgTaken[j];
5,549,710✔
1538
                        }
1539
                        AT.WildArgTaken[j] = AN.WildEat-numofwildarg;
2,837,600✔
1540
/* ----> bug to be replaced in other source code */
1541
                        for ( j++; j < AN.WildArgs; j++ ) AT.WildArgTaken[j] = 0;
2,962,973✔
1542
                        break;
1543
                }
1544
        }
1545
        goto topofloop;
2,837,600✔
1546
NoCaseB:
×
1547
/*
1548
        Restore the old Wildcard assignments
1549
*/
1550
        i = nwstore;
×
1551
        if ( i > 0 ) {
×
1552
                m = AN.WildValue;
×
1553
                t = OldWork + ntwa; r = AT.WildMask;
×
1554
                do {
×
1555
                        *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
×
1556
                } while ( --i > 0 );
×
1557
                C->numrhs = *t++;
×
1558
                C->Pointer = C->Buffer + oldcpointer;
×
1559
        }
1560
        AT.WorkPointer = OldWork;
×
1561
        return(0);                /* no match */
×
1562
}
1563

1564
/*
1565
                 #] MatchFunction : 
1566
                 #[ ScanFunctions :                        WORD ScanFunctions(inpat,inter,par)
1567

1568
                Finds in which functions to look for a match.
1569
                inpat is the start of the pattern still to be matched.
1570
                inter is the start of the term still to be matched.
1571
                par gives information about commutativity.
1572
                        par = 0: nothing special
1573
                        par = 1: regular noncommuting function
1574
                        par = 2: GAMMA function
1575

1576
                AN.patstop: end of the functions field in the search pattern
1577
                AN.terstop: end of the functions field in the target pattern
1578
                AN.terstart: address of entire term;
1579

1580
                The actual matching of the functions and their arguments is done
1581
                in a number of different routines. Mainly MatchFunction when there
1582
                are no symmetry properties.
1583
                Also: MatchE
1584
                      MatchCy
1585
                      FunMatchSy
1586
                      FunMatchCy
1587

1588
                The main problem here is backtracking, ie continuing with wildcard
1589
                possibilities when a first assignment doesn't work.
1590
                Important note: this was completely forgotten in the symmetric
1591
                functions till 6-jan-2009. As of the moment this still has to
1592
                be fixed.  ??????21-mar-2023????? Is this still unfixed?????
1593

1594
                Functions inside functions can cause problems when antisymmetric
1595
                functions are involved. The sign of the term may be at stake.
1596
                At the lowest level this is no problem but in f(-fas(n2,n1)) this
1597
                plays a role. Next is when we have a product of functions inside
1598
                an argument. The strategy must be that we test the sign only at the
1599
                last function. Hence, when inpat+inpat[1] >= AN.patstop.
1600
                We might relax that to the last antisymmetric function at a later stage.
1601

1602
        New scheme to be implemented for non-commuting objects:
1603
        When we are matching a second (or higher) function, any match can only
1604
        be directly after the last matched non-commuting function or a commuting
1605
        function. This will take care of whatever happens in MatchE etc.
1606
*/
1607

1608
WORD ScanFunctions(PHEAD WORD *inpat, WORD *inter, WORD par)
199,817✔
1609
{
1610
        GETBIDENTITY
1611
        WORD i, *m, *t, *r, sym, psym;
199,817✔
1612
        WORD *newpat, *newter, *instart, *oinpat = 0, *ointer = 0;
199,817✔
1613
        WORD nwstore, offset, *OldWork, SetStop = 0, oRepFunNum = AN.RepFunNum;
199,817✔
1614
        WORD wilds, wildargs = 0, wildeat = 0, *wildargtaken;
199,817✔
1615
        WORD *Oterfirstcomm = AN.terfirstcomm;
199,817✔
1616
        CBUF *C = cbuf+AT.ebufnum;
199,817✔
1617
        int ntwa = AN.NumTotWildArgs;
199,817✔
1618
        LONG oldcpointer = C->Pointer - C->Buffer;
199,817✔
1619
        WORD oldSignCheck = AN.SignCheck;
199,817✔
1620
        instart = inter;
199,817✔
1621
/*
1622
        Only active for the last function in the pattern.
1623
        The actual test on the sign is in MatchFunction or the symmetric functions
1624
*/
1625
        if ( AN.nogroundlevel ) {
199,817✔
1626
                AN.SignCheck = ( inpat + inpat[1] >= AN.patstop ) ? 1 : 0;
558✔
1627
        }
1628
        else {
1629
                AN.SignCheck = 0;
199,259✔
1630
        }
1631
/*
1632
                        Store the current Wildcard assignments
1633
*/
1634
        t = wildargtaken = OldWork = AT.WorkPointer;
199,817✔
1635
        t += ntwa;
199,817✔
1636
        m = AN.WildValue;
199,817✔
1637
        nwstore = i = (m[-SUBEXPSIZE+1]-SUBEXPSIZE)/4;
199,817✔
1638
        if ( i > 0 ) {
199,817✔
1639
                r = AT.WildMask;
199,634✔
1640
                do {
222,926✔
1641
                        *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *r++;
222,926✔
1642
                } while ( --i > 0 );
222,926✔
1643
                *t++ = C->numrhs;
199,634✔
1644
        }
1645
        if ( t >= AT.WorkTop ) {
199,817✔
1646
                MLOCK(ErrorMessageLock);
×
1647
                MesWork();
×
1648
                MUNLOCK(ErrorMessageLock);
×
1649
                Terminate(-1);
×
1650
        }
1651
        AT.WorkPointer = t;
199,817✔
1652
        do {
246,384✔
1653
#ifndef NEWCOMMUTE
1654
/*
1655
                Find an eligible unsubstituted function
1656
*/
1657
                if ( AN.RepFunNum > 0 ) {
246,384✔
1658
/*
1659
                        First try a non-commuting function, just after the last
1660
                        substituted non-commuting function.
1661
*/
1662
                        if ( *inter >= FUNCTION && functions[*inter-FUNCTION].commute ) {
339✔
1663
                                do {
3✔
1664
                                        offset = WORDDIF(inter,AN.terstart);
3✔
1665
                                        for ( i = 0; i < AN.RepFunNum; i += 2 ) {
6✔
1666
                                                if ( AN.RepFunList[i] >= offset ) break;
3✔
1667
                                        }
1668
                                        if ( i >= AN.RepFunNum ) break;
3✔
1669
                                        inter += inter[1];
×
1670
                                } while ( inter < AN.terfirstcomm );
×
1671
                                if ( inter < AN.terfirstcomm ) { /* Check that it is directly after */
3✔
1672
                                        for ( i = 0; i < AN.RepFunNum; i += 2 ) {
3✔
1673
                                                if ( functions[AN.terstart[AN.RepFunList[i]]-FUNCTION].commute
3✔
1674
                                                && AN.RepFunList[i]+AN.terstart[AN.RepFunList[i]+1] == offset ) break;
3✔
1675
                                        }
1676
                                        if ( i < AN.RepFunNum ) goto trythis;
3✔
1677
                                }
1678
                                inter = AN.terfirstcomm;
1679
                        }
1680
/*
1681
                        Now try one of the commuting functions
1682
*/
1683
                        while ( inter < AN.terstop ) {
675✔
1684
                                offset = WORDDIF(inter,AN.terstart);
669✔
1685
                                for ( i = 0; i < AN.RepFunNum; i += 2 ) {
1,197✔
1686
                                        if ( AN.RepFunList[i] == offset ) break;
867✔
1687
                                }
1688
                                if ( i >= AN.RepFunNum ) break;
669✔
1689
                                inter += inter[1];
339✔
1690
                        }
1691
                        if ( inter >= AN.terstop ) goto Failure;
336✔
1692
trythis:;
330✔
1693
                }
1694
                else {
1695
/*
1696
                        The first function can be anywhere. We have no problems.
1697
*/
1698
                        offset = WORDDIF(inter,AN.terstart);
246,045✔
1699
                }
1700
#else
1701
                /* first find an unsubstituted function */
1702
                do {
1703
                        offset = WORDDIF(inter,AN.terstart);
1704
                        for ( i = 0; i < AN.RepFunNum; i += 2 ) {
1705
                                if ( AN.RepFunList[i] == offset ) break;
1706
                        }
1707
                        if ( i >= AN.RepFunNum ) break;
1708
                        inter += inter[1];
1709
                } while ( inter < AN.terstop );
1710
                if ( inter >= AN.terstop ) goto Failure;
1711
#endif
1712
                wilds = 0;
246,378✔
1713
                /* We found one */
1714
                if ( *inter >= FUNCTION && *inpat >= FUNCTION ) {
246,378✔
1715
                        if ( *inpat == *inter || *inpat >= FUNCTION + WILDOFFSET ) {
223,228✔
1716
/*
1717
                                if ( inter[1] == FUNHEAD ) goto rewild;
1718
*/
1719
                                if ( functions[*inter-FUNCTION].spec >= TENSORFUNCTION
153,455✔
1720
                                && ( *inter == *inpat ||
×
1721
                                functions[*inpat-FUNCTION-WILDOFFSET].spec >= TENSORFUNCTION ) ) {
×
1722
                                        sym = functions[*inter-FUNCTION].symmetric & ~REVERSEORDER;
×
1723
                                        if ( *inpat == *inter ) psym = sym;
×
1724
                                        else psym = functions[*inpat-FUNCTION-WILDOFFSET].symmetric & ~REVERSEORDER;
×
1725
                                        if ( sym == ANTISYMMETRIC || sym == SYMMETRIC
×
1726
                                        || psym == SYMMETRIC || psym == ANTISYMMETRIC ) {
×
1727
                                                if ( sym == ANTISYMMETRIC && psym == SYMMETRIC ) goto rewild;
×
1728
                                                if ( sym == SYMMETRIC && psym == ANTISYMMETRIC ) goto rewild;
×
1729
/*
1730
                                                Special function call for (anti)symmetric tensors
1731
*/
1732
                                                if ( MatchE(BHEAD inpat,inter,instart,par) ) goto OnSuccess;
×
1733
                                        }
1734
                                        else if ( sym == CYCLESYMMETRIC || sym == RCYCLESYMMETRIC
×
1735
                                        || psym == CYCLESYMMETRIC || psym == RCYCLESYMMETRIC ) {
×
1736
/*
1737
                                                Special function call for (r)cyclic tensors
1738
*/
1739
                                                if ( MatchCy(BHEAD inpat,inter,instart,par) ) goto OnSuccess;
×
1740
                                        }
1741
                                        else goto rewild;
×
1742
                                }
1743
                                else if ( functions[*inter-FUNCTION].spec <= 0
153,455✔
1744
                                && ( *inter == *inpat ||
153,455✔
1745
                                functions[*inpat-FUNCTION-WILDOFFSET].spec <= 0 ) ) {
2,322✔
1746
                                        sym = functions[*inter-FUNCTION].symmetric & ~REVERSEORDER;
153,455✔
1747
                                        if ( *inpat == *inter ) psym = sym;
153,455✔
1748
                                        else psym = functions[*inpat-FUNCTION-WILDOFFSET].symmetric & ~REVERSEORDER;
2,322✔
1749
                                        if ( psym == SYMMETRIC || sym == SYMMETRIC
153,455✔
1750
/*
1751
                                        The next statement was commented out. Why????
1752
                                        Werkt nog niet. Teken wordt nog niet bijgehouden.
1753
                                        5-nov-2001
1754
*/
1755
                                        || psym == ANTISYMMETRIC || sym == ANTISYMMETRIC
151,388✔
1756
                                        ) {
1757
                                                if ( sym == ANTISYMMETRIC && psym == SYMMETRIC ) goto rewild;
2,073✔
1758
                                                if ( sym == SYMMETRIC && psym == ANTISYMMETRIC ) goto rewild;
1,632✔
1759
                                                if ( FunMatchSy(BHEAD inpat,inter,instart,par) ) goto OnSuccess;
1,632✔
1760
                                        }
1761
                                        else
1762
                                                if ( sym == CYCLESYMMETRIC || sym == RCYCLESYMMETRIC
151,382✔
1763
                                        || psym == CYCLESYMMETRIC || psym == RCYCLESYMMETRIC ) {
151,382✔
1764
                                                if ( FunMatchCy(BHEAD inpat,inter,instart,par) ) goto OnSuccess;
×
1765
                                        }
1766
                                        else goto rewild;
151,382✔
1767
                                }
1768
                                else goto rewild;
×
1769
                                AN.terfirstcomm = Oterfirstcomm;
375✔
1770
                        }
1771
                        else if ( par > 0 ) { SetStop = 1; goto maybenext; }
69,773✔
1772
                }
1773
                else {
1774
rewild:
23,150✔
1775
                AN.terfirstcomm = Oterfirstcomm;
174,979✔
1776
                if ( *inter != SUBEXPRESSION && MatchFunction(BHEAD inpat,inter,&wilds) ) {
174,979✔
1777
                        AN.terfirstcomm = Oterfirstcomm;
151,547✔
1778
                        if ( wilds ) {
151,547✔
1779
/*
1780
                                Store wildcards to continue in MatchFunction if the current
1781
                                wildcards do not work out.
1782
*/
1783
                                wildargs = AN.WildArgs;
3,075✔
1784
                                wildeat = AN.WildEat;
3,075✔
1785
                                for ( i = 0; i < wildargs; i++ ) wildargtaken[i] = AT.WildArgTaken[i];
12,225✔
1786
                                oinpat = inpat; ointer = inter;
1787
                        }
1788
                        if ( par && *inter == GAMMA && AN.RepFunList[AN.RepFunNum+1] ) {
151,547✔
1789
                                SetStop = 1; goto NoMat;
×
1790
                        }
1791
                        if ( par == 2 ) {
151,547✔
1792
                                if ( *inter < FUNCTION || functions[*inter-FUNCTION].commute ) {
×
1793
                                        goto NoMat;
×
1794
                                }
1795
                                par = 1;
1796
                        }
1797
                        AN.RepFunList[AN.RepFunNum] = offset;
151,547✔
1798
                        AN.RepFunNum += 2;
151,547✔
1799
                        newpat = inpat + inpat[1];
151,547✔
1800
                        if ( newpat >= AN.patstop ) {
151,547✔
1801
                                if ( AN.UseFindOnly == 0 ) {
151,334✔
1802
                                        if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
18✔
1803
                                                AN.UsedOtherFind = 1;
18✔
1804
                                                goto OnSuccess;
18✔
1805
                                        }
1806
                                        AN.RepFunNum -= 2;
×
1807
                                        goto NoMat;
×
1808
                                }
1809
                                goto OnSuccess;
151,316✔
1810
                        }
1811
                        if ( *inter < FUNCTION || functions[*inter-FUNCTION].commute ) {
213✔
1812
                                newter = inter + inter[1];
6✔
1813
                                if ( newter >= AN.terstop ) goto Failure;
6✔
1814
                                if ( *inter == GAMMA && inpat[1] <
6✔
1815
                                inter[1] - AN.RepFunList[AN.RepFunNum-1] ) {
×
1816
                                        if ( ScanFunctions(BHEAD newpat,newter,2) ) goto OnSuccess;
×
1817
                                        AN.terfirstcomm = Oterfirstcomm;
×
1818
                                }
1819
                                else if ( *newter ==  SUBEXPRESSION ) {}
6✔
1820
                                else if ( functions[*inter-FUNCTION].commute ) {
6✔
1821
                                        if ( ScanFunctions(BHEAD newpat,newter,1) ) goto OnSuccess;
6✔
1822
                                        AN.terfirstcomm = Oterfirstcomm;
×
1823
                                        if ( ( *newpat < (FUNCTION+WILDOFFSET)
×
1824
                                                && ( functions[*newpat-FUNCTION].commute == 0 ) ) ||
×
1825
                                                ( *newpat >= (FUNCTION+WILDOFFSET)
1826
                                                && ( functions[*newpat-FUNCTION-WILDOFFSET].commute == 0 ) ) ) {
×
1827
                                                newter = AN.terfirstcomm;
×
1828
                                                if ( newter < AN.terstop && ScanFunctions(BHEAD newpat,newter,1) ) goto OnSuccess;
×
1829
                                        }
1830
                                }
1831
                                else {
1832
                                        if ( ScanFunctions(BHEAD newpat,instart,1) ) goto OnSuccess;
×
1833
                                        AN.terfirstcomm = Oterfirstcomm;
×
1834
                                }
1835
                                SetStop = par;
1836
                        }
1837
                        else {
1838
/*
1839
                                Shouldn't this be newpat instead of inpat?????
1840
*/
1841
                                if ( par && inter > instart && ( ( *newpat < (FUNCTION+WILDOFFSET)
207✔
1842
                                && functions[*newpat-FUNCTION].commute ) ||
×
1843
                                ( *newpat >= (FUNCTION+WILDOFFSET)
1844
                                && functions[*newpat-FUNCTION-WILDOFFSET].commute ) ) ) {
×
1845
                                        SetStop = 1;
1846
                                }
1847
                                else {
1848
                                        newter = instart;
207✔
1849
                                        if ( ScanFunctions(BHEAD newpat,newter,par) ) goto OnSuccess;
207✔
1850
                                        AN.terfirstcomm = Oterfirstcomm;
18✔
1851
                                }
1852
                        }
1853
/*
1854
                        Restore the old Wildcard assignments
1855
*/
1856
NoMat:
36✔
1857
                        i = nwstore;
36✔
1858
                        if ( i > 0 ) {
36✔
1859
                                m = AN.WildValue;
36✔
1860
                                t = OldWork + ntwa; r = AT.WildMask;
36✔
1861
                                do {
174✔
1862
                                        *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
174✔
1863
                                } while ( --i > 0 );
174✔
1864
                                C->numrhs = *t++;
36✔
1865
                                C->Pointer = C->Buffer + oldcpointer;
36✔
1866
                        }
1867
/*                        AN.RepFunNum -= 2; */
1868
                        AN.RepFunNum = oRepFunNum;
36✔
1869
                        if ( wilds ) {
36✔
1870
                                inter = ointer; inpat = oinpat;
6✔
1871
                                AN.WildArgs = wildargs;
6✔
1872
                                AN.WildEat = wildeat;
6✔
1873
                                for ( i = 0; i < wildargs; i++ ) AT.WildArgTaken[i] = wildargtaken[i];
18✔
1874
                                goto rewild;
6✔
1875
                        }
1876
                        if ( SetStop ) break;
30✔
1877
                }
1878
                else if ( par ) {
23,432✔
1879
maybenext:
×
1880
                        if ( *inpat < (FUNCTION+WILDOFFSET) ) {
×
1881
                                if ( *inpat < FUNCTION ||
×
1882
                                functions[*inpat-FUNCTION].commute ) break;
×
1883
                        }
1884
                        else {
1885
                                if ( functions[*inpat-FUNCTION-WILDOFFSET].commute ) break;
×
1886
                        }
1887
                }}
1888
                inter += inter[1];
93,610✔
1889
        } while ( inter < AN.terstop );
93,610✔
1890
Failure:
47,043✔
1891
    AN.SignCheck = oldSignCheck;
47,049✔
1892
        AT.WorkPointer = OldWork;
47,049✔
1893
        return(0);
47,049✔
1894
OnSuccess:
152,786✔
1895
        if ( AT.idallflag && AN.nogroundlevel <= 0 ) {
152,786✔
1896
                if ( AT.idallmaxnum > 0 && AT.idallnum >= AT.idallmaxnum ) {
18✔
1897
                        AN.terfirstcomm = Oterfirstcomm;
×
1898
                    AN.SignCheck = oldSignCheck;
×
1899
                        AT.WorkPointer = OldWork;
×
1900
                        return(0);
×
1901
                }
1902
                SubsInAll(BHEAD0);
18✔
1903
                AT.idallnum++;
18✔
1904
                if ( AT.idallmaxnum == 0 || AT.idallnum < AT.idallmaxnum ) goto NoMat;
18✔
1905
        }
1906
        AN.terfirstcomm = Oterfirstcomm;
152,768✔
1907
    AN.SignCheck = oldSignCheck;
152,768✔
1908
/*
1909
        Now the disorder test
1910
*/
1911
        if ( AN.DisOrderFlag && AN.RepFunNum >= 4 ) {
152,768✔
1912
                WORD k, kk;
1913
                for ( i = 2; i < AN.RepFunNum; i += 2 ) {
×
1914
/*
1915
------------> We still have to copy the code from Normalize wrt properorderflag
1916
*/
1917
                        m = AN.terstart + AN.RepFunList[i-2];
×
1918
                        t = AN.terstart + AN.RepFunList[i];
×
1919
                        if ( *m != *t ) {
×
1920
                                if ( *m > *t ) continue;
×
1921
                                goto doesmatch;
×
1922
                        }
1923
                        if ( *m >= FUNCTION && functions[*m-FUNCTION].spec >=
×
1924
                                TENSORFUNCTION ) {
1925
                                k = m[1] - FUNHEAD;
×
1926
                                kk = t[1] - FUNHEAD;
×
1927
                                m += FUNHEAD;
×
1928
                                t += FUNHEAD;
×
1929
                        }
1930
                        else {
1931
                                k = m[1] - FUNHEAD;
×
1932
                                kk = t[1] - FUNHEAD;
×
1933
                                m += FUNHEAD;
×
1934
                                t += FUNHEAD;
×
1935
                        }
1936
                        while ( k > 0 && kk > 0 ) {
×
1937
                                if ( *m < *t ) goto NextFor;
×
1938
                                else if ( *m++ > *t++ ) goto doesmatch;
×
1939
                                k--; kk--;
×
1940
                        }
1941
                        if ( k > 0 ) goto doesmatch;
×
1942
NextFor:;
×
1943
                }
1944
                SetStop = 1;
×
1945
                goto NoMat;
×
1946
        }
1947
doesmatch:
152,768✔
1948
        AT.WorkPointer = OldWork;
152,768✔
1949
        return(1);
152,768✔
1950
}
1951

1952
/*
1953
                 #] ScanFunctions : 
1954
        #] Patterns :
1955
*/
STATUS · Troubleshooting · Open an Issue · Sales · Support · CAREERS · ENTERPRISE · START FREE · SCHEDULE DEMO
ANNOUNCEMENTS · TWITTER · TOS & SLA · Supported CI Services · What's a CI service? · Automated Testing

© 2026 Coveralls, Inc