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

tueda / form / 9134714907

15 May 2024 01:24AM UTC coverage: 49.039% (+0.2%) from 48.84%
9134714907

push

github

tueda
more tests

40599 of 82790 relevant lines covered (49.04%)

606198.17 hits per line

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

67.5
/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)
1,790✔
140
{
141
        GETBIDENTITY
142
        WORD *t, *tstop, *endarg;
1,790✔
143
        tstop = term + *term;
1,790✔
144
        tstop -= ABS(tstop[-1]);
1,790✔
145
        t = term+1;
1,790✔
146
        while ( t < tstop ) {
5,278✔
147
                if ( *t == AR.PolyFun ) {
3,488✔
148
                        if ( AR.PolyFunType == 2 ) t[2] |= MUSTCLEANPRF;
873✔
149
                        endarg = t + t[1];
873✔
150
                        t[2] |= DIRTYFLAG;
873✔
151
                        t += FUNHEAD;
873✔
152
                        while ( t < endarg ) {
873✔
153
                                if ( *t > 0 ) {
1,746✔
154
                                        t[1] |= DIRTYFLAG;
1,617✔
155
                                }
156
                                NEXTARG(t);
4,365✔
157
                        }
158
                }
159
                else {
160
                        t += t[1];
2,615✔
161
                }
162
        }
163
}
1,790✔
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)
1,725✔
175
{
176
        GETBIDENTITY
177
        WORD *t, *tstop;
1,725✔
178
        tstop = term + *term;
1,725✔
179
        tstop -= ABS(tstop[-1]);
1,725✔
180
        t = term+1;
1,725✔
181
        while ( t < tstop ) {
5,955✔
182
                if ( *t == AR.PolyFun ) {
4,230✔
183
                        t[2] &= ~MUSTCLEANPRF;
1,692✔
184
                }
185
                t += t[1];
4,230✔
186
        }
187
}
1,725✔
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,226✔
214
                WORD type)
215
{
216
        GETBIDENTITY
217
        WORD **args,**arg,nargs;
1,226✔
218
        WORD *to, *r, *fstop;
1,226✔
219
        WORD i, j, k, ff, exch, nexch, neq;
1,226✔
220
        WORD *a1, *a2, *a3;
1,226✔
221
        WORD reverseorder;
1,226✔
222
        if ( ( type & REVERSEORDER ) != 0 ) reverseorder = -1;
1,226✔
223
        else                                reverseorder = 1;
1,226✔
224
        type &= ~REVERSEORDER;
1,226✔
225

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

228
        if ( 2*func[1] > AN.arglistsize ) {
1,226✔
229
                if ( AN.arglist ) M_free(AN.arglist,"Symmetrize");
69✔
230
                AN.arglistsize = 2*func[1] + 8;
69✔
231
                AN.arglist = (WORD **)Malloc1(AN.arglistsize*sizeof(WORD *),"Symmetrize");
69✔
232
        }
233
        arg = args = AN.arglist;
1,226✔
234
        to = AT.WorkPointer;
1,226✔
235
        r = func;
1,226✔
236
        fstop = r + r[1];
1,226✔
237
        r += FUNHEAD;
1,226✔
238
        nargs = 0;
1,226✔
239
        while ( r < fstop ) {        /* Make list of arguments */
1,226✔
240
                *arg++ = r;
2,702✔
241
                nargs++;
2,702✔
242
                if ( ff ) {
2,702✔
243
                        if ( *r == FUNNYWILD ) r++;
138✔
244
                        r++;
138✔
245
                }
246
                else { NEXTARG(r); }
6,492✔
247
        }
248
        exch = 0;
1,226✔
249
        nexch = 0;
1,226✔
250
        neq = 0;
1,226✔
251
        a1 = Lijst;
1,226✔
252
        if ( type == SYMMETRIC || type == ANTISYMMETRIC ) {
1,226✔
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 ) {
54✔
278
                WORD rev = 0, jmin = 0, ii, iimin;
279
recycle:
54✔
280
                for ( j = 1; j < ngroups; j++ ) {
153✔
281
                        for ( i = 0; i < ngroups; i++ ) {
99✔
282
                                iimin = jmin + i;
99✔
283
                                if ( iimin >= ngroups ) iimin -= ngroups;
99✔
284
                                ii = j + i;
99✔
285
                                if ( ii >= ngroups ) ii -= ngroups;
99✔
286
                                k = reverseorder*CompGroup(BHEAD ff,args,Lijst+gsize*iimin,Lijst+gsize*ii,gsize);
99✔
287
                                if ( k > 0 ) break;
99✔
288
                                if ( k < 0 ) { jmin = j; nexch = 4; break; }
×
289
                        }
290
                }
291
                if ( type == RCYCLESYMMETRIC && rev == 0 && ngroups > 1 ) {
54✔
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 ) {
54✔
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,226✔
334
        i = FUNHEAD;
1,226✔
335
        NCOPY(to,r,i);
4,904✔
336
        for ( i = 0; i < nargs; i++ ) {
3,928✔
337
                if ( ff ) {
2,702✔
338
                        if ( *(args[i]) == FUNNYWILD ) {
138✔
339
                                *to++ = *(args[i]);
36✔
340
                                *to++ = args[i][1];
36✔
341
                        }
342
                        else *to++ = *(args[i]);
102✔
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,342✔
351
                }
352
        }
353
        i = func[1];
1,226✔
354
        to = func;
1,226✔
355
        r = AT.WorkPointer;
1,226✔
356
        NCOPY(to,r,i);
11,760✔
357
        return ( exch | nexch | neq );
1,226✔
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,960✔
374
{
375
        GETBIDENTITY
376
        WORD *t1, *t2, i1, i2, n, k;
1,960✔
377

378
        for ( n = 0; n < num; n++ ) {
2,513✔
379
                t1 = args[a1[n]]; t2 = args[a2[n]];
1,960✔
380
                if ( type >= TENSORFUNCTION ) {
1,960✔
381
                        if ( AR.Eside == LHSIDE || AR.Eside == LHSIDEX ) {
90✔
382
                                if ( *t1 == FUNNYWILD ) {
48✔
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 ) {
48✔
390
                                        return(1);
391
                                }
392
                                else {
393
                                        if ( *t1 < *t2 ) return(1);
12✔
394
                                        if ( *t1 > *t2 ) return(-1);
×
395
                                }
396
                        }
397
                        else {
398
                                if ( *t1 < *t2 ) return(1);
42✔
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,901✔
474
{
475
        GETBIDENTITY
476
        WORD *Lijst, count = 0;
2,901✔
477
        WORD *t, *funstop, i;
2,901✔
478
        int retval;
2,901✔
479

480
        if ( functions[*fun-FUNCTION].spec > 0 ) {
2,901✔
481
                count = fun[1] - FUNHEAD;
48✔
482
                for ( i = fun[1]-1; i >= FUNHEAD; i-- ) {
222✔
483
                        if ( fun[i] == FUNNYWILD ) count--;
174✔
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,901✔
492
                fun[2] &= ~DIRTYSYMFLAG;
1,698✔
493
                return(0);
1,698✔
494
        }
495
        Lijst = AT.WorkPointer;
1,203✔
496
        for ( i = 0; i < count; i++ ) Lijst[i] = i;
3,729✔
497
        AT.WorkPointer += count;
1,203✔
498
        retval = Symmetrize(BHEAD fun,Lijst,count,1,type);
1,203✔
499
        fun[2] &= ~DIRTYSYMFLAG;
1,203✔
500
        AT.WorkPointer = Lijst;
1,203✔
501
        return(retval);
1,203✔
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)
923,499✔
818
{
819
        GETBIDENTITY
820
        WORD *m, *t, *r, i;
923,499✔
821
        WORD *mstop = 0, *tstop = 0;
923,499✔
822
        WORD *argmstop, *argtstop;
923,499✔
823
        WORD *mtrmstop, *ttrmstop;
923,499✔
824
        WORD *msubstop, *mnextsub;
923,499✔
825
        WORD msizcoef, mcount, tcount, newvalue, j;
923,499✔
826
        WORD *oldm, *oldt;
923,499✔
827
        WORD *OldWork, numofwildarg;
923,499✔
828
        WORD nwstore, tobeeaten, reservevalue = 0, resernum = 0, withwild;
923,499✔
829
        WORD *wildargtaken;
923,499✔
830
        CBUF *C = cbuf+AT.ebufnum;
923,499✔
831
        int ntwa = AN.NumTotWildArgs;
923,499✔
832
        LONG oldcpointer = C->Pointer - C->Buffer;
923,499✔
833
/*
834
        Test first for a straight match
835
*/
836
        AN.RepFunList[AN.RepFunNum+1] = 0;
923,499✔
837
        if ( *wilds == 0 ) {
923,499✔
838
                m = pattern; t = interm;
923,493✔
839

840
                if ( *m != *t ) {
923,493✔
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];
923,493✔
847
                if ( *m >= (FUNCTION + WILDOFFSET) ) { i--; m++; t++; }
923,493✔
848
                do { if ( *m++ != *t++ ) break; } while ( --i > 0 );
2,165,543✔
849
                if ( i <= 0 ) {                        /* Arguments match */
923,493✔
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;
923,463✔
871
        t += ntwa;
923,463✔
872
        m = AN.WildValue;
923,463✔
873
        nwstore = i = (m[-SUBEXPSIZE+1]-SUBEXPSIZE)/4;
923,463✔
874
        if ( i > 0 ) {
923,463✔
875
                r = AT.WildMask;
923,279✔
876
                do {
940,682✔
877
                        *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *r++;
940,682✔
878
                } while ( --i > 0 );
940,682✔
879
                *t++ = C->numrhs;
923,279✔
880
        }
881
        if ( t >= AT.WorkTop ) {
923,463✔
882
                MLOCK(ErrorMessageLock);
×
883
                MesWork();
×
884
                MUNLOCK(ErrorMessageLock);
×
885
                Terminate(-1);
×
886
        }
887
        AT.WorkPointer = t;
923,463✔
888

889
        if ( *wilds ) {
923,463✔
890
                if ( *wilds == 1 ) goto endoloop;
6✔
891
                else               goto enloop;                        /* tensors = 2 */
×
892
        }
893
        m = pattern; t = interm;
923,457✔
894
/*
895
        Single out the specials
896
*/
897
        if ( *t == GAMMA ) {
923,457✔
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 vector */
×
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 ) {
923,457✔
1012
                mstop = m + m[1];
6✔
1013
                tstop = t + t[1];
6✔
1014
                mcount = 0;
6✔
1015
                m += FUNHEAD;
6✔
1016
                t += FUNHEAD;
6✔
1017
                AN.WildArgs = 0;
6✔
1018
                tcount = WORDDIF(tstop,t);
6✔
1019
                while ( m < mstop ) {
18✔
1020
                        if ( *m == FUNNYWILD ) { m++; AN.WildArgs++; }
12✔
1021
                        m++; mcount++;
12✔
1022
                }
1023
                tobeeaten = tcount - mcount + AN.WildArgs;
6✔
1024
                if ( tobeeaten ) {
6✔
1025
                        if ( tobeeaten < 0 || AN.WildArgs == 0 ) {
6✔
1026
                                AT.WorkPointer = OldWork;
×
1027
                                return(0);        /* Cannot match */
×
1028
                        }
1029
                }
1030
                AT.WildArgTaken[0] = AN.WildEat = tobeeaten;
6✔
1031
                for ( i = 1; i < AN.WildArgs; i++ ) AT.WildArgTaken[i] = 0;
6✔
1032
toploop:
6✔
1033
                numofwildarg = 0;
6✔
1034

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

1953
/*
1954
                 #] ScanFunctions : 
1955
        #] Patterns :
1956
*/
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