FORM 4.3
symmetr.c
Go to the documentation of this file.
1
6/* #[ License : */
7/*
8 * Copyright (C) 1984-2022 J.A.M. Vermaseren
9 * When using this file you are requested to refer to the publication
10 * J.A.M.Vermaseren "New features of FORM" math-ph/0010025
11 * This is considered a matter of courtesy as the development was paid
12 * for by FOM the Dutch physics granting agency and we would like to
13 * be able to track its scientific use to convince FOM of its value
14 * for the community.
15 *
16 * This file is part of FORM.
17 *
18 * FORM is free software: you can redistribute it and/or modify it under the
19 * terms of the GNU General Public License as published by the Free Software
20 * Foundation, either version 3 of the License, or (at your option) any later
21 * version.
22 *
23 * FORM is distributed in the hope that it will be useful, but WITHOUT ANY
24 * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
25 * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
26 * details.
27 *
28 * You should have received a copy of the GNU General Public License along
29 * with FORM. If not, see <http://www.gnu.org/licenses/>.
30 */
31/* #] License : */
32/*
33 #[ Includes : function.c
34*/
35
36#include "form3.h"
37
38/*
39 #] Includes :
40 #[ MatchE : WORD MatchE(pattern,fun,inter,par)
41
42 Matches symmetric and antisymmetric tensors.
43 Pattern and fun point at a tensor.
44 Problem is the wildcarding and all its possible permutations.
45 This routine loops over all of them and calls for each
46 possible wildcarding the recursion in ScanFunctions.
47 Note that this can be very costly.
48
49 Originally this routine did only Levi Civita tensors and hence
50 it dealt only with commuting objects.
51 Because of the backtracking we cannot fall back to the calling
52 ScanFunctions routine and check the sequence of functions when
53 non-commuting objects are involved.
54*/
55
56WORD MatchE(PHEAD WORD *pattern, WORD *fun, WORD *inter, WORD par)
57{
58 GETBIDENTITY
59 WORD *m, *t, *r, i, retval;
60 WORD *mstop, *tstop, j, newvalue, newfun;
61 WORD fixvec[MAXMATCH],wcvec[MAXMATCH],fixind[MAXMATCH],wcind[MAXMATCH];
62 WORD tfixvec[MAXMATCH],tfixind[MAXMATCH];
63 WORD vwc,vfix,ifix,iwc,tvfix,tifix,nv,ni;
64 WORD sign = 0, *rstop, first1, first2, first3, funwild;
65 WORD *OldWork, nwstore, oRepFunNum;
66 PERM perm1,perm2;
67 DISTRIBUTE distr;
68 WORD *newpat, /* *newter, *instart, */ offset;
69/* instart = fun; */
70 offset = WORDDIF(fun,AN.terstart);
71 if ( pattern[1] != fun[1] ) return(0);
72 if ( *pattern >= FUNCTION+WILDOFFSET ) {
73 if ( CheckWild(BHEAD *pattern-WILDOFFSET,FUNTOFUN,*fun,&newfun) ) return(0);
74 funwild = 1;
75 }
76 else funwild = 0;
77 mstop = pattern + pattern[1];
78 tstop = fun + fun[1];
79 m = pattern + FUNHEAD;
80 t = fun + FUNHEAD;
81 while ( m < mstop ) {
82 if ( *m != *t ) break;
83 m++; t++;
84 }
85 if ( m >= mstop ) {
86 AN.RepFunList[AN.RepFunNum++] = offset;
87 AN.RepFunList[AN.RepFunNum++] = 0;
88 newpat = pattern + pattern[1];
89 if ( funwild ) {
90 m = AN.WildValue;
91 t = OldWork = AT.WorkPointer;
92 nwstore = i = (m[-SUBEXPSIZE+1]-SUBEXPSIZE)/4;
93 r = AT.WildMask;
94 if ( i > 0 ) {
95 do {
96 *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *r++;
97 } while ( --i > 0 );
98 }
99 if ( t >= AT.WorkTop ) {
100 MLOCK(ErrorMessageLock);
101 MesWork();
102 MUNLOCK(ErrorMessageLock);
103 return(-1);
104 }
105 AT.WorkPointer = t;
106 AddWild(BHEAD *pattern-WILDOFFSET,FUNTOFUN,newfun);
107 if ( newpat >= AN.patstop ) {
108 if ( AN.UseFindOnly == 0 ) {
109 if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
110 AN.UsedOtherFind = 1;
111 return(1);
112 }
113 retval = 0;
114 }
115 else return(1);
116 }
117 else {
118/* newter = instart; */
119 retval = ScanFunctions(BHEAD newpat,inter,par);
120 }
121 if ( retval == 0 ) {
122 m = AN.WildValue;
123 t = OldWork; r = AT.WildMask; i = nwstore;
124 if ( i > 0 ) {
125 do {
126 *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
127 } while ( --i > 0 );
128 }
129 }
130 AT.WorkPointer = OldWork;
131 return(retval);
132 }
133 else {
134 if ( newpat >= AN.patstop ) {
135 if ( AN.UseFindOnly == 0 ) {
136 if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
137 AN.UsedOtherFind = 1;
138 return(1);
139 }
140 else return(0);
141 }
142 else return(1);
143 }
144/* newter = instart; */
145 i = ScanFunctions(BHEAD newpat,inter,par);
146 return(i);
147 }
148/*
149 Now the recursion
150*/
151 }
152/*
153 Strategy:
154 1: match the fixed arguments
155 2: match, permuting the wildcards if needed.
156 3: keep track of sign.
157*/
158 vwc = 0;
159 vfix = 0;
160 ifix = 0;
161 iwc = 0;
162 r = pattern+FUNHEAD;
163 while ( r < mstop ) {
164 if ( *r < (AM.OffsetVector+WILDOFFSET) ) {
165 fixvec[vfix++] = *r; /* Fixed vectors */
166 sign += vwc + ifix + iwc;
167 }
168 else if ( *r < MINSPEC ) {
169 wcvec[vwc++] = *r; /* Wildcard vectors */
170 sign += ifix + iwc;
171 }
172 else if ( *r < (AM.OffsetIndex+WILDOFFSET) ) {
173 fixind[ifix++] = *r; /* Fixed indices */
174 sign += iwc;
175 }
176 else if ( *r < (AM.OffsetIndex+(WILDOFFSET<<1)) ) {
177 wcind[iwc++] = *r; /* Wildcard indices */
178 }
179 else {
180 fixind[ifix++] = *r; /* Generated indices ~ fixed */
181 sign += iwc;
182 }
183 r++;
184 }
185 if ( iwc == 0 && vwc == 0 ) return(0);
186 tvfix = tifix = 0;
187 t = fun + FUNHEAD;
188 m = fixvec;
189 mstop = m + vfix;
190 r = fixind;
191 rstop = r + ifix;
192 nv = 0; ni = 0;
193 while ( t < tstop ) {
194 if ( *t < 0 ) {
195 nv++;
196 if ( m < mstop && *t == *m ) {
197 m++;
198 }
199 else {
200 sign += WORDDIF(mstop,m);
201 tfixvec[tvfix++] = *t;
202 }
203 }
204 else {
205 ni++;
206 if ( r < rstop && *r == *t ) {
207 r++;
208 }
209 else {
210 sign += WORDDIF(rstop,r);
211 tfixind[tifix++] = *t;
212 }
213 }
214 t++;
215 }
216 if ( m < mstop || r < rstop ) return(0);
217 if ( tvfix < vwc || (tvfix+tifix) < (vwc+iwc) ) return(0);
218 sign += ( nv - vfix - vwc ) & ni;
219/*
220 Take now the wildcards that have an assignment already.
221 See whether they match.
222*/
223 {
224 WORD *wv, *wm, n;
225 wm = AT.WildMask;
226 wv = AN.WildValue;
227 n = AN.NumWild;
228 do {
229 if ( *wm ) {
230 if ( *wv == VECTOVEC ) {
231 for ( ni = 0; ni < vwc; ni++ ) {
232 if ( wcvec[ni]-WILDOFFSET == wv[2] ) { /* Has been assigned */
233 sign += ni;
234 vwc--;
235 while ( ni < vwc ) {
236 wcvec[ni] = wcvec[ni+1];
237 ni++;
238 }
239/* TryVect: */
240 for ( ni = 0; ni < tvfix; ni++ ) {
241 if ( tfixvec[ni] == wv[3] ) {
242 sign += ni;
243 tvfix--;
244 while ( ni < tvfix ) {
245 tfixvec[ni] = tfixvec[ni+1];
246 ni++;
247 }
248 goto NextWV;
249 }
250 }
251 return(0);
252 }
253 }
254 }
255 else if ( *wv == INDTOIND ) {
256 for ( ni = 0; ni < iwc; ni++ ) {
257 if ( wcind[ni]-WILDOFFSET == wv[2] ) { /* Has been assigned */
258 sign += ni;
259 iwc--;
260 while ( ni < iwc ) {
261 wcind[ni] = wcind[ni+1];
262 ni++;
263 }
264 for ( ni = 0; ni < tifix; ni++ ) {
265 if ( tfixind[ni] == wv[3] ) {
266 sign += ni;
267 tifix--;
268 while ( ni < tifix ) {
269 tfixind[ni] = tfixind[ni+1];
270 ni++;
271 }
272 goto NextWV;
273 }
274 }
275/* goto TryVect; */
276 return(0);
277
278 }
279 }
280 }
281 else if ( *wv == VECTOSUB ) {
282 for ( ni = 0; ni < vwc; ni++ ) {
283 if ( wcvec[ni]-WILDOFFSET == wv[2] ) return(0);
284 }
285 }
286 else if ( *wv == INDTOSUB ) {
287 for ( ni = 0; ni < iwc; ni++ ) {
288 if ( wcind[ni]-WILDOFFSET == wv[2] ) return(0);
289 }
290 }
291 }
292NextWV:
293 wm++;
294 wv += wv[1];
295 n--;
296 if ( n > 0 ) {
297 while ( n > 0 && ( *wv == FROMSET || *wv == SETTONUM
298 || *wv == LOADDOLLAR ) ) { wv += wv[1]; wm++; n--; }
299/*
300 Freak problem: doesn't test for n and ran into a reamining
301 code equal to SETTONUM followed by a big number and then
302 ran out of the memory.
303
304 while ( *wv == FROMSET || *wv == SETTONUM
305 || ( *wv == LOADDOLLAR && n > 0 ) ) { wv += wv[1]; wm++; n--; }
306*/
307 }
308 } while ( n > 0 );
309 }
310/*
311 Now there are only free wildcards left.
312 Possibly the assigned values ate too many vectors.
313 The rest has to be done the 'hard way' via permutations.
314 This is too bad when there are 10 indices.
315 This could cause 10! tries.
316 We try to avoid the worst case by using a very special
317 (somewhat slow) permutation routine that has as its worst
318 cases some rather unlikely configurations, rather than some
319 common ones (as would have been the case with the conventional
320 permuation routine).
321 assume:
322 vvvvvvvvvvvviiiiiii (tvfix in tfixvec and tifix in tfixind)
323 VVVVVVVVVIIIIIIIIII (vwc in wcvec and iwc in wcind)
324 Note: all further assignments are possible at this point!
325 Strategy:
326 permute v
327 permute i
328 loop over the ordered distribution of the leftover v's
329 through the i's.
330*/
331 if ( tvfix < vwc ) { return(0); }
332 perm1.n = tvfix;
333 perm1.sign = 0;
334 perm1.objects = tfixvec;
335 perm2.n = tifix;
336 perm2.sign = 0;
337 perm2.objects = tfixind;
338 distr.n1 = tvfix - vwc;
339 distr.n2 = tifix;
340 distr.obj1 = tfixvec + vwc;
341 distr.obj2 = tfixind;
342 distr.out = fixvec; /* For scratch */
343 first1 = 1;
344/*
345 Store the current Wildcard assignments
346*/
347 m = AN.WildValue;
348 t = OldWork = AT.WorkPointer;
349 nwstore = i = (m[-SUBEXPSIZE+1]-SUBEXPSIZE)/4;
350 r = AT.WildMask;
351 if ( i > 0 ) {
352 do {
353 *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *r++;
354 } while ( --i > 0 );
355 }
356 if ( t >= AT.WorkTop ) {
357 MLOCK(ErrorMessageLock);
358 MesWork();
359 MUNLOCK(ErrorMessageLock);
360 return(-1);
361 }
362 AT.WorkPointer = t;
363 while ( (first1 = Permute(&perm1,first1) ) == 0 ) {
364 first2 = 1;
365 while ( (first2 = Permute(&perm2,first2) ) == 0 ) {
366 first3 = 1;
367 while ( (first3 = Distribute(&distr,first3) ) == 0 ) {
368/*
369 Make now the wildcard assignments
370*/
371 for ( i = 0; i < vwc; i++ ) {
372 j = wcvec[i] - WILDOFFSET;
373 if ( CheckWild(BHEAD j,VECTOVEC,tfixvec[i],&newvalue) )
374 goto NoCaseB;
375 AddWild(BHEAD j,VECTOVEC,newvalue);
376 }
377 for ( i = 0; i < iwc; i++ ) {
378 j = wcind[i] - WILDOFFSET;
379 if ( CheckWild(BHEAD j,INDTOIND,fixvec[i],&newvalue) )
380 goto NoCaseB;
381 AddWild(BHEAD j,INDTOIND,newvalue);
382 }
383/*
384 Go into the recursion
385*/
386 oRepFunNum = AN.RepFunNum;
387 AN.RepFunList[AN.RepFunNum++] = offset;
388 AN.RepFunList[AN.RepFunNum++] =
389 ( perm1.sign + perm2.sign + distr.sign + sign ) & 1;
390 newpat = pattern + pattern[1];
391 if ( funwild ) AddWild(BHEAD *pattern-WILDOFFSET,FUNTOFUN,newfun);
392 if ( newpat >= AN.patstop ) {
393 if ( AN.UseFindOnly == 0 ) {
394 if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
395 AN.UsedOtherFind = 1;
396 return(1);
397 }
398 }
399 else return(1);
400 }
401 else {
402/* newter = instart; */
403 if ( ScanFunctions(BHEAD newpat,inter,par) ) { return(1); }
404 }
405/*
406 Restore the old Wildcard assignments
407*/
408 AN.RepFunNum = oRepFunNum;
409NoCaseB: m = AN.WildValue;
410 t = OldWork; r = AT.WildMask; i = nwstore;
411 if ( i > 0 ) {
412 do {
413 *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
414 } while ( --i > 0 );
415 }
416 AT.WorkPointer = t;
417 }
418 }
419 }
420 AT.WorkPointer = OldWork;
421 return(0);
422}
423
424/*
425 #] MatchE :
426 #[ Permute : WORD Permute(perm,first)
427
428 Special permutation function.
429 Works recursively.
430 The aim is to cycle through in as fast a way as possible,
431 to take care that each object hits the various positions
432 already early in the game.
433
434 Start at two: -> cycle of two
435 then three -> cycle of three
436 etc;
437 The innermost cycle is the longest. This is the opposite
438 of the usual way of generating permutations and it is
439 certainly not the fastest one. It allows for the fastest
440 hit in the assignment of wildcards though.
441*/
442
443WORD Permute(PERM *perm, WORD first)
444{
445 WORD *s, c, i, j;
446 if ( first ) {
447 perm->sign = ( perm->sign <= 1 ) ? 0: 1;
448 for ( i = 0; i < perm->n; i++ ) perm->cycle[i] = 0;
449 return(0);
450 }
451 i = perm->n;
452 while ( --i > 0 ) {
453 s = perm->objects;
454 c = s[0];
455 j = i;
456 while ( --j >= 0 ) { *s = s[1]; s++; }
457 *s = c;
458 if ( ( i & 1 ) != 0 ) perm->sign ^= 1;
459 if ( perm->cycle[i] < i ) {
460 (perm->cycle[i])++;
461 return(0);
462 }
463 else {
464 perm->cycle[i] = 0;
465 }
466 }
467 return(1);
468}
469
470/*
471 #] Permute :
472 #[ PermuteP : WORD PermuteP(perm,first)
473
474 Like Permute, but works on an array of pointers
475*/
476
477WORD PermuteP(PERMP *perm, WORD first)
478{
479 WORD **s, *c, i, j;
480 if ( first ) {
481 perm->sign = ( perm->sign <= 1 ) ? 0: 1;
482 for ( i = 0; i < perm->n; i++ ) perm->cycle[i] = 0;
483 return(0);
484 }
485 i = perm->n;
486 while ( --i > 0 ) {
487 s = perm->objects;
488 c = s[0];
489 j = i;
490 while ( --j >= 0 ) { *s = s[1]; s++; }
491 *s = c;
492 if ( ( i & 1 ) != 0 ) perm->sign ^= 1;
493 if ( perm->cycle[i] < i ) {
494 (perm->cycle[i])++;
495 return(0);
496 }
497 else {
498 perm->cycle[i] = 0;
499 }
500 }
501 return(1);
502}
503
504/*
505 #] PermuteP :
506 #[ Distribute :
507*/
508
509WORD Distribute(DISTRIBUTE *d, WORD first)
510{
511 WORD *to, *from, *inc, *from2, i, j;
512 if ( first ) {
513 d->n = d->n1 + d->n2;
514 to = d->out;
515 from = d->obj2;
516 for ( i = 0; i < d->n2; i++ ) {
517 d->cycle[i] = 0;
518 *to++ = *from++;
519 }
520 from = d->obj1;
521 while ( i < d->n ) {
522 d->cycle[i++] = 1;
523 *to++ = *from++;
524 }
525 d->sign = 0;
526 return(0);
527 }
528 if ( d->n1 == 0 || d->n2 == 0 ) return(1);
529 j = 0;
530 i = 0;
531 inc = d->cycle;
532 from = inc + d->n;
533 while ( *inc ) { j++; inc++; }
534 while ( !*inc && inc < from ) { i++; inc++; }
535 if ( inc >= from ) return(1);
536 d->sign ^= ((i&j)-j+1) & 1;
537 *inc = 0;
538 *--inc = 1;
539 while ( --j >= 0 ) *--inc = 1;
540 while ( --i > 0 ) *--inc = 0;
541 to = d->out;
542 from = d->obj1;
543 from2 = d->obj2;
544 for ( i = 0; i < d->n; i++ ) {
545 if ( *inc++ ) {
546 *to++ = *from++;
547 }
548 else {
549 *to++ = *from2++;
550 }
551 }
552 return(0);
553}
554
555/*
556 #] Distribute :
557 #[ MatchCy :
558
559 Matching of (r)cyclic tensors.
560 Parameters like in MatchE.
561 The structure of the routine is much simpler, because the number
562 of possibilities is much more limited.
563 The major complication is the ?a-type wildcards
564 We need a strategy for T(i1?,?a,i1?,?b). Which is the shorter
565 match: ?a or ?b ? (if possible of course)
566 This is also relevant in the case of the shortest match if there
567 is more than one choice for i1.
568*/
569
570int MatchCy(PHEAD WORD *pattern, WORD *fun, WORD *inter, WORD par)
571{
572 GETBIDENTITY
573 WORD *t, *tstop, *p, *pstop, *m, *r, *oldworkpointer = AT.WorkPointer;
574 WORD *thewildcards, *multiplicity, *renum, wc, newvalue, oldwilval = 0;
575 WORD *params, *lowlevel = 0;
576 int argcount = 0, funnycount = 0, tcount = fun[1] - FUNHEAD;
577 int type = 0, pnum, i, j, k, nwstore, iraise, itop, sumeat;
578 CBUF *C = cbuf+AT.ebufnum;
579 int ntwa = 3*AN.NumTotWildArgs+1;
580 LONG oldcpointer = C->Pointer - C->Buffer;
581 WORD offset = fun-AN.terstart, *newpat;
582
583 if ( (functions[fun[0]-FUNCTION].symmetric & ~REVERSEORDER) == RCYCLESYMMETRIC ) type = 1;
584 pnum = pattern[0];
585 nwstore = (AN.WildValue[-SUBEXPSIZE+1]-SUBEXPSIZE)/4;
586 if ( pnum > FUNCTION + WILDOFFSET ) {
587 pnum -= WILDOFFSET;
588 if ( CheckWild(BHEAD pnum,FUNTOFUN,fun[0],&newvalue) ) return(0);
589 oldwilval = 1;
590 t = lowlevel = AT.WorkPointer;
591 m = AN.WildValue;
592 i = nwstore;
593 r = AT.WildMask;
594 if ( i > 0 ) {
595 do {
596 *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *r++;
597 } while ( --i > 0 );
598 }
599 *t++ = C->numrhs;
600 if ( t >= AT.WorkTop ) {
601 MLOCK(ErrorMessageLock);
602 MesWork();
603 MUNLOCK(ErrorMessageLock);
604 return(-1);
605 }
606 AT.WorkPointer = t;
607 AddWild(BHEAD pnum,FUNTOFUN,newvalue);
608 }
609 if ( (functions[pnum-FUNCTION].symmetric & ~REVERSEORDER) == RCYCLESYMMETRIC ) type = 1;
610
611 /* First we have to make an inventory. Are there FUNNYWILD pointers? */
612
613 p = pattern + FUNHEAD;
614 pstop = pattern + pattern[1];
615 while ( p < pstop ) {
616 if ( *p == FUNNYWILD ) { p += 2; funnycount++; }
617 else { p++; argcount++; }
618 }
619 if ( argcount > tcount ) goto NoSuccess;
620 if ( argcount < tcount && funnycount == 0 ) goto NoSuccess;
621 if ( argcount == 0 && tcount == 0 && funnycount == 0 ) {
622 AN.RepFunList[AN.RepFunNum++] = offset;
623 AN.RepFunList[AN.RepFunNum++] = 0;
624 newpat = pattern + pattern[1];
625 if ( newpat >= AN.patstop ) {
626 if ( AN.UseFindOnly == 0 ) {
627 if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
628 AT.WorkPointer = oldworkpointer;
629 AN.UsedOtherFind = 1;
630 return(1);
631 }
632 j = 0;
633 }
634 else {
635 AT.WorkPointer = oldworkpointer;
636 return(1);
637 }
638 }
639 else j = ScanFunctions(BHEAD newpat,inter,par);
640 if ( j ) return(j);
641 goto NoSuccess;
642 }
643 tstop = fun + fun[1];
644
645 /* Store the wildcard assignments */
646
647 params = AT.WorkPointer;
648 thewildcards = t = params + tcount;
649 t += ntwa;
650 if ( oldwilval ) lowlevel = oldworkpointer;
651 else lowlevel = t;
652 m = AN.WildValue;
653 i = nwstore;
654 if ( i > 0 ) {
655 r = AT.WildMask;
656 do {
657 *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *r++;
658 } while ( --i > 0 );
659 *t++ = C->numrhs;
660 }
661 if ( t >= AT.WorkTop ) {
662 MLOCK(ErrorMessageLock);
663 MesWork();
664 MUNLOCK(ErrorMessageLock);
665 return(-1);
666 }
667 AT.WorkPointer = t;
668/*
669 #[ Case 1: no funnies or all funnies must be empty. We just cycle through.
670*/
671 if ( argcount == tcount ) {
672 if ( funnycount > 0 ) { /* Test all funnies first */
673 p = pattern + FUNHEAD;
674 t = fun + FUNHEAD;
675 while ( p < pstop ) {
676 if ( *p != FUNNYWILD ) { p++; continue; }
677 AN.argaddress = t;
678 if ( CheckWild(BHEAD p[1],ARGTOARG,0,t) ) goto nomatch;
679 AddWild(BHEAD p[1],ARGTOARG,0);
680 p += 2;
681 }
682 oldwilval = 1;
683 }
684 for ( k = 0; k <= type; k++ ) {
685 if ( k == 0 ) {
686 p = params; t = fun + FUNHEAD;
687 while ( t < tstop ) *p++ = *t++;
688 }
689 else {
690 p = params+tcount; t = fun + FUNHEAD;
691 while ( t < tstop ) *--p = *t++;
692 }
693 for ( i = 0; i < tcount; i++ ) { /* The various cycles */
694 p = pattern + FUNHEAD;
695 wc = 0;
696 for ( j = 0; j < tcount; j++, p++ ) { /* The arguments */
697 while ( *p == FUNNYWILD ) p += 2;
698 t = params + (i+j)%tcount;
699 if ( *t == *p ) continue;
700 if ( *p >= AM.OffsetIndex + WILDOFFSET
701 && *p < AM.OffsetIndex + 2*WILDOFFSET ) {
702
703 /* Test wildcard index */
704
705 wc = *p - WILDOFFSET;
706 if ( CheckWild(BHEAD wc,INDTOIND,*t,&newvalue) ) break;
707 AddWild(BHEAD wc,INDTOIND,newvalue);
708 }
709 else if ( *t < MINSPEC && p[j] < MINSPEC
710 && *p >= AM.OffsetVector + WILDOFFSET ) {
711
712 /* Test wildcard vector */
713
714 wc = *p - WILDOFFSET;
715 if ( CheckWild(BHEAD wc,VECTOVEC,*t,&newvalue) ) break;
716 AddWild(BHEAD wc,VECTOVEC,newvalue);
717 }
718 else break;
719 }
720 if ( j >= tcount ) { /* Match! */
721
722 /* Continue with other functions. Make sure of the funnies */
723
724 AN.RepFunList[AN.RepFunNum++] = offset;
725 AN.RepFunList[AN.RepFunNum++] = 0;
726
727 if ( funnycount > 0 ) {
728 p = pattern + FUNHEAD;
729 t = fun + FUNHEAD;
730 while ( p < pstop ) {
731 if ( *p != FUNNYWILD ) { p++; continue; }
732 AN.argaddress = t;
733 AddWild(BHEAD p[1],ARGTOARG,0);
734 p += 2;
735 }
736 }
737 newpat = pattern + pattern[1];
738 if ( newpat >= AN.patstop ) {
739 if ( AN.UseFindOnly == 0 ) {
740 if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
741 AT.WorkPointer = oldworkpointer;
742 AN.UsedOtherFind = 1;
743 return(1);
744 }
745 j = 0;
746 }
747 else {
748 AT.WorkPointer = oldworkpointer;
749 return(1);
750 }
751 }
752 else j = ScanFunctions(BHEAD newpat,inter,par);
753 if ( j ) {
754 AT.WorkPointer = oldworkpointer;
755 return(j); /* Full match. Return our success */
756 }
757 AN.RepFunNum -= 2;
758 }
759
760 /* No (deeper) match. -> reset wildcards and continue */
761
762 if ( wc && nwstore > 0 ) {
763 j = nwstore;
764 m = AN.WildValue;
765 t = thewildcards + ntwa; r = AT.WildMask;
766 if ( j > 0 ) {
767 do {
768 *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
769 } while ( --j > 0 );
770 }
771 C->numrhs = *t++;
772 C->Pointer = C->Buffer + oldcpointer;
773 }
774 }
775 }
776 goto NoSuccess;
777 }
778/*
779 #] Case 1:
780 #[ Case 2: One FUNNYWILD. Fix its length.
781*/
782 if ( funnycount == 1 ) {
783 funnycount = tcount - argcount; /* Number or arguments to be eaten */
784 for ( k = 0; k <= type; k++ ) {
785 if ( k == 0 ) {
786 p = params; t = fun + FUNHEAD;
787 while ( t < tstop ) *p++ = *t++;
788 }
789 else {
790 p = params+tcount; t = fun + FUNHEAD;
791 while ( t < tstop ) *--p = *t++;
792 }
793 for ( i = 0; i < tcount; i++ ) { /* The various cycles */
794 p = pattern + FUNHEAD;
795 t = params;
796 wc = 0;
797 for ( j = 0; j < tcount; j++, p++, t++ ) { /* The arguments */
798 if ( *t == *p ) continue;
799 if ( *p == FUNNYWILD ) {
800 p++; wc = 1;
801 AN.argaddress = t;
802 if ( CheckWild(BHEAD *p,ARGTOARG,funnycount|EATTENSOR,t) ) break;
803 AddWild(BHEAD *p,ARGTOARG,funnycount|EATTENSOR);
804 j += funnycount-1; t += funnycount-1;
805 }
806 else if ( *p >= AM.OffsetIndex + WILDOFFSET
807 && *p < AM.OffsetIndex + 2*WILDOFFSET ) {
808
809 /* Test wildcard index */
810
811 wc = *p - WILDOFFSET;
812 if ( CheckWild(BHEAD wc,INDTOIND,*t,&newvalue) ) break;
813 AddWild(BHEAD wc,INDTOIND,newvalue);
814 }
815 else if ( *t < MINSPEC && *p < MINSPEC
816 && *p >= AM.OffsetVector + WILDOFFSET ) {
817
818 /* Test wildcard vector */
819
820 wc = *p - WILDOFFSET;
821 if ( CheckWild(BHEAD wc,VECTOVEC,*t,&newvalue) ) break;
822 AddWild(BHEAD wc,VECTOVEC,newvalue);
823 }
824 else break;
825 }
826 if ( j >= tcount ) { /* Match! */
827
828 /* Continue with other functions. Make sure of the funnies */
829
830 AN.RepFunList[AN.RepFunNum++] = offset;
831 AN.RepFunList[AN.RepFunNum++] = 0;
832 newpat = pattern + pattern[1];
833 if ( newpat >= AN.patstop ) {
834 if ( AN.UseFindOnly == 0 ) {
835 if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
836 AT.WorkPointer = oldworkpointer;
837 AN.UsedOtherFind = 1;
838 return(1);
839 }
840 j = 0;
841 }
842 else {
843 AT.WorkPointer = oldworkpointer;
844 return(1);
845 }
846 }
847 else j = ScanFunctions(BHEAD newpat,inter,par);
848 if ( j ) {
849 AT.WorkPointer = oldworkpointer;
850 return(j); /* Full match. Return our success */
851 }
852 AN.RepFunNum -= 2;
853 }
854
855 /* No (deeper) match. -> reset wildcards and continue */
856
857 if ( wc ) {
858 j = nwstore;
859 m = AN.WildValue;
860 t = thewildcards + ntwa; r = AT.WildMask;
861 if ( j > 0 ) {
862 do {
863 *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
864 } while ( --j > 0 );
865 }
866 C->numrhs = *t++;
867 C->Pointer = C->Buffer + oldcpointer;
868 }
869 t = params;
870 wc = *t;
871 for ( j = 1; j < tcount; j++ ) { *t = t[1]; t++; }
872 *t = wc;
873 }
874 }
875 goto NoSuccess;
876 }
877/*
878 #] Case 2:
879 #[ Case 3: More than one FUNNYWILD. Complicated.
880*/
881
882 sumeat = tcount - argcount; /* Total number to be eaten by Funnies */
883/*
884 In the first funnycount elements of 'thewildcards' we arrange
885 for the summing over the various possibilities.
886 The renumbering table is in thewildcards[2*funnycount]
887 The multiplicity table is in thewildcards[funnycount]
888 The number of arguments for each is in thewildcards[]
889*/
890 p = pattern+FUNHEAD;
891 for ( i = funnycount; i < ntwa; i++ ) thewildcards[i] = -1;
892 multiplicity = thewildcards + funnycount;
893 renum = multiplicity + funnycount;
894 j = 0;
895 while ( p < pstop ) {
896 if ( *p != FUNNYWILD ) { p++; continue; }
897 p++;
898 if ( renum[*p] < 0 ) {
899 renum[*p] = j;
900 multiplicity[j] = 1;
901 j++;
902 }
903 else multiplicity[renum[*p]]++;
904 p++;
905 }
906/*
907 Strategy: First 'declared' has a tendency to be smaller
908*/
909 for ( i = 1; i < AN.NumTotWildArgs; i++ ) {
910 if ( renum[i] < 0 ) continue;
911 for ( j = i+1; j <= AN.NumTotWildArgs; j++ ) {
912 if ( renum[j] < 0 ) continue;
913 if ( renum[i] < renum[j] ) continue;
914 k = multiplicity[renum[i]];
915 multiplicity[renum[i]] = multiplicity[renum[j]];
916 multiplicity[renum[j]] = k;
917 k = renum[i]; renum[i] = renum[j]; renum[j] = k;
918 }
919 }
920 for ( i = 0; i < funnycount; i++ ) thewildcards[i] = 0;
921 iraise = funnycount-1;
922 for ( ;; ) {
923 for ( i = 0, j = sumeat; i < iraise; i++ )
924 j -= thewildcards[i]*multiplicity[i];
925 if ( j < 0 || j % multiplicity[iraise] != 0 ) {
926 if ( j > 0 ) {
927 thewildcards[iraise-1]++;
928 continue;
929 }
930 itop = iraise-1;
931 while ( itop > 0 && j < 0 ) {
932 j += thewildcards[itop]*multiplicity[itop];
933 thewildcards[itop] = 0;
934 itop--;
935 }
936 if ( itop <= 0 && j <= 0 ) break;
937 thewildcards[itop]++;
938 continue;
939 }
940 thewildcards[iraise] = j / multiplicity[iraise];
941
942 for ( k = 0; k <= type; k++ ) {
943 if ( k == 0 ) {
944 p = params; t = fun + FUNHEAD;
945 while ( t < tstop ) *p++ = *t++;
946 }
947 else {
948 p = params+tcount; t = fun + FUNHEAD;
949 while ( t < tstop ) *--p = *t++;
950 }
951 for ( i = 0; i < tcount; i++ ) { /* The various cycles */
952 p = pattern + FUNHEAD;
953 t = params;
954 wc = 0;
955 for ( j = 0; j < tcount; j++, p++, t++ ) { /* The arguments */
956 if ( *t == *p ) continue;
957 if ( *p == FUNNYWILD ) {
958 p++; wc = thewildcards[renum[*p]];
959 AN.argaddress = t;
960 if ( CheckWild(BHEAD *p,ARGTOARG,wc|EATTENSOR,t) ) break;
961 AddWild(BHEAD *p,ARGTOARG,wc|EATTENSOR);
962 j += wc-1; t += wc-1; wc = 1;
963 }
964 else if ( *p >= AM.OffsetIndex + WILDOFFSET
965 && *p < AM.OffsetIndex + 2*WILDOFFSET ) {
966
967 /* Test wildcard index */
968
969 wc = *p - WILDOFFSET;
970 if ( CheckWild(BHEAD wc,INDTOIND,*t,&newvalue) ) break;
971 AddWild(BHEAD wc,INDTOIND,newvalue);
972 }
973 else if ( *t < MINSPEC && *p < MINSPEC
974 && *p >= AM.OffsetVector + WILDOFFSET ) {
975
976 /* Test wildcard vector */
977
978 wc = *p - WILDOFFSET;
979 if ( CheckWild(BHEAD wc,VECTOVEC,*t,&newvalue) ) break;
980 AddWild(BHEAD wc,VECTOVEC,newvalue);
981 }
982 else break;
983 }
984 if ( j >= tcount ) { /* Match! */
985
986 /* Continue with other functions. Make sure of the funnies */
987
988 AN.RepFunList[AN.RepFunNum++] = offset;
989 AN.RepFunList[AN.RepFunNum++] = 0;
990 newpat = pattern + pattern[1];
991 if ( newpat >= AN.patstop ) {
992 if ( AN.UseFindOnly == 0 ) {
993 if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
994 AT.WorkPointer = oldworkpointer;
995 AN.UsedOtherFind = 1;
996 return(1);
997 }
998 j = 0;
999 }
1000 else {
1001 AT.WorkPointer = oldworkpointer;
1002 return(1);
1003 }
1004 }
1005 else j = ScanFunctions(BHEAD newpat,inter,par);
1006 if ( j ) {
1007 AT.WorkPointer = oldworkpointer;
1008 return(j); /* Full match. Return our success */
1009 }
1010 AN.RepFunNum -= 2;
1011 }
1012
1013 /* No (deeper) match. -> reset wildcards and continue */
1014
1015 if ( wc ) {
1016 j = nwstore;
1017 m = AN.WildValue;
1018 t = thewildcards + ntwa; r = AT.WildMask;
1019 if ( j > 0 ) {
1020 do {
1021 *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
1022 } while ( --j > 0 );
1023 }
1024 C->numrhs = *t++;
1025 C->Pointer = C->Buffer + oldcpointer;
1026 }
1027 t = params;
1028 wc = *t;
1029 for ( j = 1; j < tcount; j++ ) { *t = t[1]; t++; }
1030 *t = wc;
1031 }
1032 }
1033 (thewildcards[iraise-1])++;
1034 }
1035/*
1036 #] Case 3:
1037*/
1038NoSuccess:
1039 if ( oldwilval > 0 ) {
1040nomatch:;
1041 j = nwstore;
1042 if ( j > 0 ) {
1043 m = AN.WildValue;
1044 t = lowlevel; r = AT.WildMask;
1045 if ( j > 0 ) {
1046 do {
1047 *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
1048 } while ( --j > 0 );
1049 }
1050 C->numrhs = *t++;
1051 C->Pointer = C->Buffer + oldcpointer;
1052 }
1053 }
1054 AT.WorkPointer = oldworkpointer;
1055 return(0);
1056}
1057
1058/*
1059 #] MatchCy :
1060 #[ FunMatchCy :
1061
1062 Matching of (r)cyclic functions.
1063 Like MatchCy, but now for general functions.
1064*/
1065
1066int FunMatchCy(PHEAD WORD *pattern, WORD *fun, WORD *inter, WORD par)
1067{
1068 GETBIDENTITY
1069 WORD *t, *tstop, *p, *pstop, *m, *r, *oldworkpointer = AT.WorkPointer;
1070 WORD **a, *thewildcards, *multiplicity, *renum, wc, wcc, oldwilval = 0;
1071 LONG oww = AT.pWorkPointer;
1072 WORD newvalue, *lowlevel = 0;
1073 int argcount = 0, funnycount = 0, tcount = 0;
1074 int type = 0, pnum, i, j, k, nwstore, iraise, itop, sumeat;
1075 CBUF *C = cbuf+AT.ebufnum;
1076 int ntwa = 3*AN.NumTotWildArgs+1;
1077 LONG oldcpointer = C->Pointer - C->Buffer;
1078 WORD offset = fun-AN.terstart, *newpat;
1079
1080 if ( (functions[fun[0]-FUNCTION].symmetric & ~REVERSEORDER) == RCYCLESYMMETRIC ) type = 1;
1081 pnum = pattern[0];
1082 nwstore = (AN.WildValue[-SUBEXPSIZE+1]-SUBEXPSIZE)/4;
1083 if ( pnum > FUNCTION + WILDOFFSET ) {
1084 pnum -= WILDOFFSET;
1085 if ( CheckWild(BHEAD pnum,FUNTOFUN,fun[0],&newvalue) ) return(0);
1086 oldwilval = 1;
1087 t = lowlevel = oldworkpointer;
1088 m = AN.WildValue;
1089 i = nwstore;
1090 r = AT.WildMask;
1091 if ( i > 0 ) {
1092 do {
1093 *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *r++;
1094 } while ( --i > 0 );
1095 }
1096 *t++ = C->numrhs;
1097 if ( t >= AT.WorkTop ) {
1098 MLOCK(ErrorMessageLock);
1099 MesWork();
1100 MUNLOCK(ErrorMessageLock);
1101 return(-1);
1102 }
1103 AT.WorkPointer = t;
1104 AddWild(BHEAD pnum,FUNTOFUN,newvalue);
1105 }
1106 if ( (functions[pnum-FUNCTION].symmetric & ~REVERSEORDER) == RCYCLESYMMETRIC ) type = 1;
1107
1108 /* First we have to make an inventory. Are there -ARGWILD pointers? */
1109
1110 p = pattern + FUNHEAD;
1111 pstop = pattern + pattern[1];
1112 while ( p < pstop ) {
1113 if ( *p == -ARGWILD ) { p += 2; funnycount++; }
1114 else { NEXTARG(p); argcount++; }
1115 }
1116 t = fun + FUNHEAD;
1117 tstop = fun + fun[1];
1118 while ( t < tstop ) { NEXTARG(t); tcount++; }
1119
1120 if ( argcount > tcount ) return(0);
1121 if ( argcount < tcount && funnycount == 0 ) return(0);
1122 if ( argcount == 0 && tcount == 0 && funnycount == 0 ) {
1123 AN.RepFunList[AN.RepFunNum++] = offset;
1124 AN.RepFunList[AN.RepFunNum++] = 0;
1125 newpat = pattern + pattern[1];
1126 if ( newpat >= AN.patstop ) {
1127 if ( AN.UseFindOnly == 0 ) {
1128 if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
1129 AT.WorkPointer = oldworkpointer;
1130 AN.UsedOtherFind = 1;
1131 return(1);
1132 }
1133 j = 0;
1134 }
1135 else {
1136 AT.WorkPointer = oldworkpointer;
1137 return(1);
1138 }
1139 }
1140 else j = ScanFunctions(BHEAD newpat,inter,par);
1141 if ( j ) return(j);
1142 goto NoSuccess;
1143 }
1144
1145 /* Store the wildcard assignments */
1146
1147 WantAddPointers(tcount);
1148 AT.pWorkPointer += tcount;
1149 thewildcards = t = AT.WorkPointer;
1150 t += ntwa;
1151 if ( oldwilval ) lowlevel = oldworkpointer;
1152 else lowlevel = t;
1153 m = AN.WildValue;
1154 i = nwstore;
1155 if ( i > 0 ) {
1156 r = AT.WildMask;
1157 do {
1158 *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *r++;
1159 } while ( --i > 0 );
1160 *t++ = C->numrhs;
1161 }
1162 if ( t >= AT.WorkTop ) {
1163 MLOCK(ErrorMessageLock);
1164 MesWork();
1165 MUNLOCK(ErrorMessageLock);
1166 return(-1);
1167 }
1168 AT.WorkPointer = t;
1169/*
1170 #[ Case 1: no funnies or all funnies must be empty. We just cycle through.
1171*/
1172 if ( argcount == tcount ) {
1173 if ( funnycount > 0 ) { /* Test all funnies first */
1174 p = pattern + FUNHEAD;
1175 t = fun + FUNHEAD;
1176 while ( p < pstop ) {
1177 if ( *p != -ARGWILD ) { p++; continue; }
1178 AN.argaddress = t;
1179 if ( CheckWild(BHEAD p[1],ARGTOARG,0,t) ) goto nomatch;
1180 AddWild(BHEAD p[1],ARGTOARG,0);
1181 p += 2;
1182 }
1183 oldwilval = 1;
1184 }
1185 for ( k = 0; k <= type; k++ ) {
1186 if ( k == 0 ) {
1187 a = AT.pWorkSpace+oww; t = fun + FUNHEAD;
1188 while ( t < tstop ) { *a++ = t; NEXTARG(t); }
1189 }
1190 else {
1191 a = AT.pWorkSpace+oww+tcount; t = fun + FUNHEAD;
1192 while ( t < tstop ) { *--a = t; NEXTARG(t); }
1193 }
1194 for ( i = 0; i < tcount; i++ ) { /* The various cycles */
1195 p = pattern + FUNHEAD;
1196 wc = 0;
1197 for ( j = 0; j < tcount; j++ ) { /* The arguments */
1198 while ( *p == -ARGWILD ) p += 2;
1199 t = AT.pWorkSpace[oww+((i+j)%tcount)];
1200 if ( ( wcc = MatchArgument(BHEAD t,p) ) == 0 ) break;
1201 if ( wcc > 1 ) wc = 1;
1202 NEXTARG(p);
1203 }
1204 if ( j >= tcount ) { /* Match! */
1205
1206 /* Continue with other functions. Make sure of the funnies */
1207
1208 AN.RepFunList[AN.RepFunNum++] = offset;
1209 AN.RepFunList[AN.RepFunNum++] = 0;
1210
1211 if ( funnycount > 0 ) {
1212 p = pattern + FUNHEAD;
1213 t = fun + FUNHEAD;
1214 while ( p < pstop ) {
1215 if ( *p != -ARGWILD ) { p++; continue; }
1216 AN.argaddress = t;
1217 AddWild(BHEAD p[1],ARGTOARG,0);
1218 p += 2;
1219 }
1220 }
1221 newpat = pattern + pattern[1];
1222 if ( newpat >= AN.patstop ) {
1223 if ( AN.UseFindOnly == 0 ) {
1224 if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
1225 AT.WorkPointer = oldworkpointer;
1226 AT.pWorkPointer = oww;
1227 AN.UsedOtherFind = 1;
1228 return(1);
1229 }
1230 j = 0;
1231 }
1232 else {
1233 AT.WorkPointer = oldworkpointer;
1234 AT.pWorkPointer = oww;
1235 return(1);
1236 }
1237 }
1238 else j = ScanFunctions(BHEAD newpat,inter,par);
1239 if ( j ) {
1240 AT.WorkPointer = oldworkpointer;
1241 AT.pWorkPointer = oww;
1242 return(j); /* Full match. Return our success */
1243 }
1244 AN.RepFunNum -= 2;
1245 }
1246
1247 /* No (deeper) match. -> reset wildcards and continue */
1248
1249 if ( wc && nwstore > 0 ) {
1250 j = nwstore;
1251 m = AN.WildValue;
1252 t = thewildcards + ntwa; r = AT.WildMask;
1253 if ( j > 0 ) {
1254 do {
1255 *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
1256 } while ( --j > 0 );
1257 }
1258 C->numrhs = *t++;
1259 C->Pointer = C->Buffer + oldcpointer;
1260 }
1261 }
1262 }
1263 goto NoSuccess;
1264 }
1265/*
1266 #] Case 1:
1267 #[ Case 2: One -ARGWILD. Fix its length.
1268*/
1269 if ( funnycount == 1 ) {
1270 funnycount = tcount - argcount; /* Number or arguments to be eaten */
1271 for ( k = 0; k <= type; k++ ) {
1272 if ( k == 0 ) {
1273 a = AT.pWorkSpace+oww; t = fun + FUNHEAD;
1274 while ( t < tstop ) { *a++ = t; NEXTARG(t); }
1275 }
1276 else {
1277 a = AT.pWorkSpace+oww+tcount; t = fun + FUNHEAD;
1278 while ( t < tstop ) { *--a = t; NEXTARG(t); }
1279 }
1280 for ( i = 0; i < tcount; i++ ) { /* The various cycles */
1281 p = pattern + FUNHEAD;
1282 a = AT.pWorkSpace+oww;
1283 wc = 0;
1284 for ( j = 0; j < tcount; j++, a++ ) { /* The arguments */
1285 t = *a;
1286 if ( *p == -ARGWILD ) {
1287 wc = 1;
1288 AN.argaddress = (WORD *)a;
1289 if ( CheckWild(BHEAD p[1],ARLTOARL,funnycount,(WORD *)a) ) break;
1290 AddWild(BHEAD p[1],ARLTOARL,funnycount);
1291 j += funnycount-1; a += funnycount-1;
1292 }
1293 else if ( MatchArgument(BHEAD t,p) == 0 ) break;
1294 NEXTARG(p);
1295 }
1296 if ( j >= tcount ) { /* Match! */
1297
1298 /* Continue with other functions. Make sure of the funnies */
1299
1300 AN.RepFunList[AN.RepFunNum++] = offset;
1301 AN.RepFunList[AN.RepFunNum++] = 0;
1302 newpat = pattern + pattern[1];
1303 if ( newpat >= AN.patstop ) {
1304 if ( AN.UseFindOnly == 0 ) {
1305 if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
1306 AT.WorkPointer = oldworkpointer;
1307 AT.pWorkPointer = oww;
1308 AN.UsedOtherFind = 1;
1309 return(1);
1310 }
1311 j = 0;
1312 }
1313 else {
1314 AT.WorkPointer = oldworkpointer;
1315 AT.pWorkPointer = oww;
1316 return(1);
1317 }
1318 }
1319 else j = ScanFunctions(BHEAD newpat,inter,par);
1320 if ( j ) {
1321 AT.WorkPointer = oldworkpointer;
1322 AT.pWorkPointer = oww;
1323 return(j); /* Full match. Return our success */
1324 }
1325 AN.RepFunNum -= 2;
1326 }
1327
1328 /* No (deeper) match. -> reset wildcards and continue */
1329
1330 if ( wc ) {
1331 j = nwstore;
1332 m = AN.WildValue;
1333 t = thewildcards + ntwa; r = AT.WildMask;
1334 if ( j > 0 ) {
1335 do {
1336 *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
1337 } while ( --j > 0 );
1338 }
1339 C->numrhs = *t++;
1340 C->Pointer = C->Buffer + oldcpointer;
1341 }
1342 a = AT.pWorkSpace+oww;
1343 t = *a;
1344 for ( j = 1; j < tcount; j++ ) { *a = a[1]; a++; }
1345 *a = t;
1346 }
1347 }
1348 goto NoSuccess;
1349 }
1350/*
1351 #] Case 2:
1352 #[ Case 3: More than one -ARGWILD. Complicated.
1353*/
1354
1355 sumeat = tcount - argcount; /* Total number to be eaten by Funnies */
1356/*
1357 In the first funnycount elements of 'thewildcards' we arrange
1358 for the summing over the various possibilities.
1359 The renumbering table is in thewildcards[2*funnycount]
1360 The multiplicity table is in thewildcards[funnycount]
1361 The number of arguments for each is in thewildcards[]
1362*/
1363 p = pattern+FUNHEAD;
1364 for ( i = funnycount; i < ntwa; i++ ) thewildcards[i] = -1;
1365 multiplicity = thewildcards + funnycount;
1366 renum = multiplicity + funnycount;
1367 j = 0;
1368 while ( p < pstop ) {
1369 if ( *p != -ARGWILD ) { p++; continue; }
1370 p++;
1371 if ( renum[*p] < 0 ) {
1372 renum[*p] = j;
1373 multiplicity[j] = 1;
1374 j++;
1375 }
1376 else multiplicity[renum[*p]]++;
1377 p++;
1378 }
1379/*
1380 Strategy: First 'declared' has a tendency to be smaller
1381*/
1382 for ( i = 1; i < AN.NumTotWildArgs; i++ ) {
1383 if ( renum[i] < 0 ) continue;
1384 for ( j = i+1; j <= AN.NumTotWildArgs; j++ ) {
1385 if ( renum[j] < 0 ) continue;
1386 if ( renum[i] < renum[j] ) continue;
1387 k = multiplicity[renum[i]];
1388 multiplicity[renum[i]] = multiplicity[renum[j]];
1389 multiplicity[renum[j]] = k;
1390 k = renum[i]; renum[i] = renum[j]; renum[j] = k;
1391 }
1392 }
1393 for ( i = 0; i < funnycount; i++ ) thewildcards[i] = 0;
1394 iraise = funnycount-1;
1395 for ( ;; ) {
1396 for ( i = 0, j = sumeat; i < iraise; i++ )
1397 j -= thewildcards[i]*multiplicity[i];
1398 if ( j < 0 || j % multiplicity[iraise] != 0 ) {
1399 if ( j > 0 ) {
1400 thewildcards[iraise-1]++;
1401 continue;
1402 }
1403 itop = iraise-1;
1404 while ( itop > 0 && j < 0 ) {
1405 j += thewildcards[itop]*multiplicity[itop];
1406 thewildcards[itop] = 0;
1407 itop--;
1408 }
1409 if ( itop <= 0 && j <= 0 ) break;
1410 thewildcards[itop]++;
1411 continue;
1412 }
1413 thewildcards[iraise] = j / multiplicity[iraise];
1414
1415 for ( k = 0; k <= type; k++ ) {
1416 if ( k == 0 ) {
1417 a = AT.pWorkSpace+oww; t = fun + FUNHEAD;
1418 while ( t < tstop ) { *a++ = t; NEXTARG(t); }
1419 }
1420 else {
1421 a = AT.pWorkSpace+oww+tcount; t = fun + FUNHEAD;
1422 while ( t < tstop ) { *--a = t; NEXTARG(t); }
1423 }
1424 for ( i = 0; i < tcount; i++ ) { /* The various cycles */
1425 p = pattern + FUNHEAD;
1426 a = AT.pWorkSpace+oww;
1427 wc = 0;
1428 for ( j = 0; j < tcount; j++, a++ ) { /* The arguments */
1429 t = *a;
1430 if ( *p == -ARGWILD ) {
1431 wc = thewildcards[renum[p[1]]];
1432 AN.argaddress = (WORD *)a;
1433 if ( CheckWild(BHEAD p[1],ARLTOARL,wc,(WORD *)a) ) break;
1434 AddWild(BHEAD p[1],ARLTOARL,wc);
1435 j += wc-1; a += wc-1; wc = 1;
1436 }
1437 else if ( MatchArgument(BHEAD t,p) == 0 ) break;
1438 NEXTARG(p);
1439 }
1440 if ( j >= tcount ) { /* Match! */
1441
1442 /* Continue with other functions. Make sure of the funnies */
1443
1444 AN.RepFunList[AN.RepFunNum++] = offset;
1445 AN.RepFunList[AN.RepFunNum++] = 0;
1446 newpat = pattern + pattern[1];
1447 if ( newpat >= AN.patstop ) {
1448 if ( AN.UseFindOnly == 0 ) {
1449 if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
1450 AT.WorkPointer = oldworkpointer;
1451 AT.pWorkPointer = oww;
1452 AN.UsedOtherFind = 1;
1453 return(1);
1454 }
1455 j = 0;
1456 }
1457 else {
1458 AT.WorkPointer = oldworkpointer;
1459 AT.pWorkPointer = oww;
1460 return(1);
1461 }
1462 }
1463 else j = ScanFunctions(BHEAD newpat,inter,par);
1464 if ( j ) {
1465 AT.WorkPointer = oldworkpointer;
1466 AT.pWorkPointer = oww;
1467 return(j); /* Full match. Return our success */
1468 }
1469 AN.RepFunNum -= 2;
1470 }
1471
1472 /* No (deeper) match. -> reset wildcards and continue */
1473
1474 if ( wc ) {
1475 j = nwstore;
1476 m = AN.WildValue;
1477 t = thewildcards + ntwa; r = AT.WildMask;
1478 if ( j > 0 ) {
1479 do {
1480 *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
1481 } while ( --j > 0 );
1482 }
1483 C->numrhs = *t++;
1484 C->Pointer = C->Buffer + oldcpointer;
1485 }
1486 a = AT.pWorkSpace+oww;
1487 t = *a;
1488 for ( j = 1; j < tcount; j++ ) { *a = a[1]; a++; }
1489 *a = t;
1490 }
1491 }
1492 (thewildcards[iraise-1])++;
1493 }
1494/*
1495 #] Case 3:
1496*/
1497NoSuccess:
1498 if ( oldwilval > 0 ) {
1499nomatch:;
1500 j = nwstore;
1501 m = AN.WildValue;
1502 t = lowlevel; r = AT.WildMask;
1503 if ( j > 0 ) {
1504 do {
1505 *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
1506 } while ( --j > 0 );
1507 }
1508 C->numrhs = *t++;
1509 C->Pointer = C->Buffer + oldcpointer;
1510 }
1511 AT.WorkPointer = oldworkpointer;
1512 AT.pWorkPointer = oww;
1513 return(0);
1514}
1515
1516/*
1517 #] FunMatchCy :
1518 #[ FunMatchSy :
1519
1520 Matching of (anti)symmetric functions.
1521 Like MatchE, but now for general functions.
1522*/
1523
1524int FunMatchSy(PHEAD WORD *pattern, WORD *fun, WORD *inter, WORD par)
1525{
1526 GETBIDENTITY
1527 WORD *t, *tstop, *p, *pstop, *m, *r, *oldworkpointer = AT.WorkPointer;
1528 WORD **a, *thewildcards, oldwilval = 0;
1529 WORD newvalue, *lowlevel = 0, num, assig;
1530 WORD *cycles;
1531 LONG oww = AT.pWorkPointer, lhpars, lhfunnies;
1532 int argcount = 0, funnycount = 0, tcount = 0, signs = 0, signfun = 0, signo;
1533 int type = 0, pnum, i, j, k, nwstore, iraise, cou2;
1534 CBUF *C = cbuf+AT.ebufnum;
1535 int ntwa = 3*AN.NumTotWildArgs+1;
1536 LONG oldcpointer = C->Pointer - C->Buffer;
1537 WORD offset = fun-AN.terstart, *newpat;
1538
1539 if ( (functions[fun[0]-FUNCTION].symmetric & ~REVERSEORDER) == RCYCLESYMMETRIC ) type = 1;
1540 pnum = pattern[0];
1541 nwstore = (AN.WildValue[-SUBEXPSIZE+1]-SUBEXPSIZE)/4;
1542 if ( pnum > FUNCTION + WILDOFFSET ) {
1543 pnum -= WILDOFFSET;
1544 if ( CheckWild(BHEAD pnum,FUNTOFUN,fun[0],&newvalue) ) return(0);
1545 oldwilval = 1;
1546 t = lowlevel = oldworkpointer;
1547 m = AN.WildValue;
1548 i = nwstore;
1549 r = AT.WildMask;
1550 if ( i > 0 ) {
1551 do {
1552 *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *r++;
1553 } while ( --i > 0 );
1554 }
1555 *t++ = C->numrhs;
1556 if ( t >= AT.WorkTop ) {
1557 MLOCK(ErrorMessageLock);
1558 MesWork();
1559 MUNLOCK(ErrorMessageLock);
1560 return(-1);
1561 }
1562 AT.WorkPointer = t;
1563 AddWild(BHEAD pnum,FUNTOFUN,newvalue);
1564 }
1565 if ( (functions[pnum-FUNCTION].symmetric & ~REVERSEORDER) == RCYCLESYMMETRIC ) type = 1;
1566
1567 /* Try for a straight match. After all, both have been normalized */
1568
1569 if ( fun[1] == pattern[1] ) {
1570 i = fun[1]-FUNHEAD; p = pattern+FUNHEAD; t = fun + FUNHEAD;
1571 while ( --i >= 0 ) { if ( *p++ != *t++ ) break; }
1572 if ( i < 0 ) goto quicky;
1573 }
1574
1575 /* First we have to make an inventory. Are there -ARGWILD pointers? */
1576
1577 p = pattern + FUNHEAD;
1578 pstop = pattern + pattern[1];
1579 while ( p < pstop ) {
1580 if ( *p == -ARGWILD ) { p += 2; funnycount++; }
1581 else { NEXTARG(p); argcount++; }
1582 }
1583 t = fun + FUNHEAD;
1584 tstop = fun + fun[1];
1585 while ( t < tstop ) { NEXTARG(t); tcount++; }
1586
1587 if ( argcount > tcount ) return(0);
1588 if ( argcount < tcount && funnycount == 0 ) return(0);
1589 if ( argcount == 0 && tcount == 0 && funnycount == 0 ) {
1590quicky:
1591 if ( AN.SignCheck && signs != AN.ExpectedSign ) goto NoSuccess;
1592 AN.RepFunList[AN.RepFunNum++] = offset;
1593 AN.RepFunList[AN.RepFunNum++] = signs;
1594 newpat = pattern + pattern[1];
1595 if ( newpat >= AN.patstop ) {
1596 if ( AN.UseFindOnly == 0 ) {
1597 if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
1598 AT.WorkPointer = oldworkpointer;
1599 AN.UsedOtherFind = 1;
1600 return(1);
1601 }
1602 j = 0;
1603 }
1604 else {
1605 AT.WorkPointer = oldworkpointer;
1606 return(1);
1607 }
1608 }
1609 else j = ScanFunctions(BHEAD newpat,inter,par);
1610 if ( j ) {
1611 AT.WorkPointer = oldworkpointer;
1612 return(j);
1613 }
1614 goto NoSuccess;
1615 }
1616
1617 /* Store the wildcard assignments */
1618
1619 WantAddPointers(tcount+argcount+funnycount);
1620 AT.pWorkPointer += tcount+argcount+funnycount;
1621 thewildcards = t = AT.WorkPointer;
1622 t += ntwa;
1623 if ( oldwilval ) lowlevel = oldworkpointer;
1624 else lowlevel = t;
1625 m = AN.WildValue;
1626 i = nwstore; assig = 0;
1627 if ( i > 0 ) {
1628 r = AT.WildMask;
1629 do {
1630 assig += *r;
1631 *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *r++;
1632 } while ( --i > 0 );
1633 *t++ = C->numrhs;
1634 }
1635 if ( t >= AT.WorkTop ) {
1636 MLOCK(ErrorMessageLock);
1637 MesWork();
1638 MUNLOCK(ErrorMessageLock);
1639 return(-1);
1640 }
1641 AT.WorkPointer = t;
1642
1643 /* Store pointers to the arguments */
1644
1645 t = fun + FUNHEAD; a = AT.pWorkSpace+oww;
1646 while ( t < tstop ) { *a++ = t; NEXTARG(t) }
1647 lhpars = a-AT.pWorkSpace;
1648 t = pattern + FUNHEAD;
1649 while ( t < pstop ) {
1650 if ( *t != -ARGWILD ) *a++ = t;
1651 NEXTARG(t)
1652 }
1653 lhfunnies = a-AT.pWorkSpace;
1654 t = pattern + FUNHEAD; cou2 = 0;
1655 while ( t < pstop ) {
1656 cou2++;
1657 if ( *t == -ARGWILD ) {
1658 *a++ = t;
1659/*
1660 signfun: last ?a: tcount-argcount: number of arguments in ?a (assume one ?a)
1661 argcount+funnycount-cou2: arguments after ?a.
1662 Together tells whether moving ?a to end of list is even or odd
1663*/
1664 signfun = ((argcount+funnycount-cou2)*(tcount-argcount)) & 1;
1665 }
1666 NEXTARG(t)
1667 }
1668 signs += signfun;
1669 if ( funnycount > 0 ) {
1670 if ( ( (functions[fun[0]-FUNCTION].symmetric & ~REVERSEORDER) == SYMMETRIC )
1671 || ( (functions[fun[0]-FUNCTION].symmetric & ~REVERSEORDER) == ANTISYMMETRIC )
1672 || ( (functions[pnum-FUNCTION].symmetric & ~REVERSEORDER) == SYMMETRIC )
1673 || ( (functions[pnum-FUNCTION].symmetric & ~REVERSEORDER) == ANTISYMMETRIC ) ) {
1674 AT.WorkPointer = oldworkpointer;
1675 AT.pWorkPointer = oww;
1676 MLOCK(ErrorMessageLock);
1677 MesPrint("Sorry: no argument field wildcards yet in (anti)symmetric functions");
1678 MUNLOCK(ErrorMessageLock);
1679 Terminate(-1);
1680 }
1681 }
1682/*
1683 Sort the regular arguments by
1684 1: no wildcards, fast.
1685 2: wildcards that have been assigned.
1686 3: general arguments.
1687 4: wildcards without an assignment.
1688*/
1689 iraise = argcount;
1690 for ( i = 0; i < iraise; i++ ) {
1691 t = AT.pWorkSpace[i+lhpars];
1692 if ( *t > 0 ) { /* Category 3: general argument */
1693 continue;
1694 }
1695 else if ( *t <= -FUNCTION ) {
1696 if ( *t > -FUNCTION - WILDOFFSET ) goto cat1;
1697 type = FUNTOFUN; num = -*t - WILDOFFSET;
1698 }
1699 else if ( *t == -SYMBOL ) {
1700 if ( t[1] < 2*MAXPOWER ) goto cat1;
1701 type = SYMTOSYM; num = t[1] - 2*MAXPOWER;
1702 }
1703 else if ( *t == -INDEX ) {
1704 if ( t[1] < AM.OffsetIndex + WILDOFFSET ) goto cat1;
1705 type = INDTOIND; num = t[1] - WILDOFFSET;
1706 }
1707 else if ( *t == -VECTOR || *t == -MINVECTOR ) {
1708 if ( t[1] < AM.OffsetVector + WILDOFFSET ) goto cat1;
1709 type = VECTOVEC; num = t[1] - WILDOFFSET;
1710 }
1711 else goto cat1; /* Things like -SNUMBER etc. */
1712/*
1713 Now we have a wildcard and have to see whether it was assigned
1714*/
1715 m = AN.WildValue;
1716 j = nwstore;
1717 r = AT.WildMask;
1718 while ( --j >= 0 ) {
1719 if ( m[2] == num && *r ) {
1720 if ( type == *m ) break;
1721 if ( type == SYMTOSYM ) {
1722 if ( *m == SYMTONUM || *m == SYMTOSUB ) break;
1723 }
1724 else if ( type == INDTOIND ) {
1725 if ( *m == INDTOSUB ) break;
1726 }
1727 else if ( type == VECTOVEC ) {
1728 if ( *m == VECTOMIN || *m == VECTOSUB ) break;
1729 }
1730 }
1731 m += 4; r++;
1732 }
1733 if ( j < 0 ) { /* Category 4: Wildcard that was not assigned */
1734 a = AT.pWorkSpace+lhpars;
1735 iraise--;
1736 if ( iraise != i ) signs++;
1737 m = a[iraise];
1738 a[iraise] = a[i];
1739 a[i] = m; i--;
1740 }
1741 else { /* Category 2: Wildcard that was assigned */
1742 for ( j = 0; j < tcount; j++ ) {
1743 if ( MatchArgument(BHEAD AT.pWorkSpace[oww+j],t) ) {
1744 k = nwstore;
1745 r = AT.WildMask;
1746 num = 0;
1747 while ( --k >= 0 ) num += *r++;
1748 if ( num == assig ) { /* no wildcards were changed */
1749 goto oneless;
1750 }
1751 break;
1752 }
1753 }
1754 if ( j >= tcount ) goto NoSuccess;
1755 j = nwstore;
1756 m = AN.WildValue;
1757 t = thewildcards + ntwa; r = AT.WildMask;
1758 if ( j > 0 ) {
1759 do { /* undo assignment */
1760 *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
1761 } while ( --j > 0 );
1762 }
1763 C->numrhs = *t++;
1764 }
1765 continue;
1766cat1:
1767 for ( j = 0; j < tcount; j++ ) {
1768 m = AT.pWorkSpace[j+oww];
1769 if ( *t != *m ) continue;
1770 if ( *t < 0 ) {
1771 if ( *t <= -FUNCTION ) break;
1772 if ( t[1] == m[1] ) break;
1773 }
1774 else {
1775 k = *t; r = t;
1776 while ( --k >= 0 && *m++ == *r++ ) {}
1777 if ( k < 0 ) break;
1778 }
1779 }
1780 if ( j >= tcount ) goto NoSuccess; /* Even the fixed ones don't match */
1781oneless:
1782 signs += j - i;
1783/*
1784 The next statements replace the one that is commented out
1785*/
1786 tcount--;
1787 while ( j < tcount ) {
1788 AT.pWorkSpace[oww+j] = AT.pWorkSpace[oww+j+1]; j++;
1789 }
1790/*
1791 AT.pWorkSpace[oww+j] = AT.pWorkSpace[oww+(--tcount)];
1792*/
1793 argcount--; j = i;
1794 while ( j < argcount ) {
1795 AT.pWorkSpace[lhpars+j] = AT.pWorkSpace[lhpars+j+1]; j++;
1796 }
1797 iraise--; i--;
1798 }
1799/*
1800 Now we see whether there are any ARGWILD objects that have been
1801 assigned already. In that case the work simplifies considerably.
1802 Currently (12-nov-2001) only in (R)CYCLIC functions; hence we do not
1803 test the sign!
1804*/
1805 for ( i = 0; i < funnycount; i++ ) {
1806 k = AT.pWorkSpace[lhfunnies+i][1];
1807 m = AN.WildValue;
1808 j = nwstore;
1809 r = AT.WildMask;
1810 while ( --j >= 0 ) {
1811 if ( *m == ARGTOARG && m[2] == k ) break;
1812 m += 4; r++;
1813 }
1814 if ( *r == 0 ) continue; /* not assigned yet */
1815 m = cbuf[AT.ebufnum].rhs[m[3]];
1816 if ( *m > 0 ) { /* Tensor arguments */
1817 j = *m;
1818 if ( j > tcount - argcount ) goto NoSuccess;
1819 while ( --j >= 0 ) {
1820 m++;
1821 if ( *m < 0 ) type = -VECTOR;
1822 else if ( *m < AM.OffsetIndex ) type = -SNUMBER;
1823 else type = -INDEX;
1824 a = AT.pWorkSpace+oww;
1825 for ( k = 0; k < tcount; k++ ) {
1826 if ( a[k][0] != type || a[k][1] != *m ) continue;
1827 a[k] = a[--tcount];
1828 goto nextjarg;
1829 }
1830 goto NoSuccess;
1831nextjarg:;
1832 }
1833 }
1834 else {
1835 m++;
1836 while ( *m ) {
1837 for ( k = 0; k < tcount; k++ ) {
1838 t = AT.pWorkSpace[oww+k];
1839 if ( *t != *m ) continue;
1840 r = m;
1841 if ( *r < 0 ) {
1842 if ( *r < -FUNCTION ) goto nextargw;
1843 else if ( r[1] == t[1] ) goto nextargw;
1844 }
1845 else {
1846 j = *r;
1847 while ( --j >= 0 && *r++ == *t++ ) {}
1848 if ( j < 0 ) goto nextargw;
1849 }
1850 }
1851 goto NoSuccess;
1852nextargw:;
1853 AT.pWorkSpace[oww+k] = AT.pWorkSpace[oww+(--tcount)];
1854 NEXTARG(m)
1855 }
1856 }
1857 AT.pWorkSpace[lhfunnies+i] = AT.pWorkSpace[lhfunnies+(--funnycount)];
1858 }
1859 if ( tcount == 0 ) {
1860 if ( argcount > 0 ) goto NoSuccess;
1861 for ( i = 0; i < funnycount; i++ ) {
1862 AddWild(BHEAD AT.pWorkSpace[lhfunnies+i][1],ARGTOARG,0);
1863 }
1864 goto quicky;
1865 }
1866/*
1867 We have now in lhpars first iraise elements with a dubious nature.
1868 Then argcount-iraise wildcards that have not been assigned.
1869 In lhfunnies we have funnycount ARGTOARG objects. ( (R)CyCLIC only )
1870
1871 First work our way through the 'dubious' objects
1872 We check whether assig changes.
1873*/
1874 for ( i = 0; i < iraise; i++ ) {
1875 for ( j = 0; j < tcount; j++ ) {
1876 if ( MatchArgument(BHEAD AT.pWorkSpace[oww+j],AT.pWorkSpace[lhpars+i]) ) {
1877 k = nwstore;
1878 r = AT.WildMask;
1879 num = 0;
1880 while ( --k >= 0 ) num += *r++;
1881 if ( num == assig ) { /* no wildcards were changed */
1882 signs += j-i;
1883 AT.pWorkSpace[oww+j] = AT.pWorkSpace[oww+(--tcount)];
1884 if ( tcount > j ) signs += tcount-j-1;
1885 argcount--;
1886 a = AT.pWorkSpace + lhpars;
1887 for ( j = i; j < argcount; j++ ) a[j] = a[j+1];
1888 iraise--;
1889 goto nextiraise;
1890 }
1891 else { /* We cannot use this yet */
1892 j = nwstore;
1893 m = AN.WildValue;
1894 t = thewildcards + ntwa; r = AT.WildMask;
1895 if ( j > 0 ) {
1896 do { /* undo assignment */
1897 *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
1898 } while ( --j > 0 );
1899 }
1900 C->numrhs = *t++;
1901 C->Pointer = C->Buffer + oldcpointer;
1902 goto nextiraise;
1903 }
1904 }
1905 }
1906 goto NoSuccess;
1907nextiraise:;
1908 }
1909/*
1910 Now all leftover patterns have unassigned wildcards in them.
1911 From now on we are in potential factorial territory.
1912
1913 Strategy:
1914 1: cycle through the regular objects.
1915 2: save wildcard settings
1916 3: divide the ARGWILDs
1917 4: make permutations of leftover arguments
1918 5: try them all
1919*/
1920 cycles = AT.WorkPointer;
1921 for ( i = 0; i < tcount; i++ ) cycles[i] = tcount-i;
1922 AT.WorkPointer += tcount;
1923 signo = 0;
1924/*MesPrint("<1> signs = %d",signs);*/
1925 for (;;) {
1926 WORD oRepFunNum = AN.RepFunNum;
1927 for ( j = 0; j < argcount; j++ ) {
1928 if ( MatchArgument(BHEAD AT.pWorkSpace[oww+j],AT.pWorkSpace[lhpars+j]) == 0 ) {
1929 break;
1930 }
1931 }
1932 if ( j >= argcount ) {
1933/*
1934 Thus far we have a match. Now the funnies
1935*/
1936 if ( funnycount ) {
1937 AT.WorkPointer = oldworkpointer;
1938 AT.pWorkPointer = oww;
1939 MLOCK(ErrorMessageLock);
1940 MesPrint("Sorry: no argument field wildcards yet in (anti)symmetric functions");
1941 MUNLOCK(ErrorMessageLock);
1942/*
1943 Bugfix 31-oct-2001, reported by Kasper Peeters
1944 We returned here with value -1 but that is not caught.
1945 Extra note (12-nov-2001): the sign becomes a bit problematic
1946 if we have funnies. No more than one allowed in antisymmetric
1947 functions, or we have serious problems.
1948*/
1949 Terminate(-1);
1950 }
1951
1952 AN.RepFunList[AN.RepFunNum++] = offset;
1953 if ( ( (functions[fun[0]-FUNCTION].symmetric & ~REVERSEORDER) == ANTISYMMETRIC )
1954 || ( (functions[pnum-FUNCTION].symmetric & ~REVERSEORDER) == ANTISYMMETRIC ) ) {
1955 AN.RepFunList[AN.RepFunNum++] = ( signs + signo ) & 1;
1956 }
1957 else {
1958 AN.RepFunList[AN.RepFunNum++] = 0;
1959 }
1960 newpat = pattern + pattern[1];
1961 if ( newpat >= AN.patstop ) {
1962 WORD countsgn, sgn = 0;
1963 for ( countsgn = oRepFunNum+1; countsgn < AN.RepFunNum; countsgn += 2 ) {
1964 if ( AN.RepFunList[countsgn] ) sgn ^= 1;
1965 }
1966 if ( AN.SignCheck == 0 || sgn == AN.ExpectedSign ) {
1967 AT.WorkPointer = oldworkpointer;
1968 AT.pWorkPointer = oww;
1969 return(1);
1970 }
1971 if ( AN.UseFindOnly == 0 ) {
1972 if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
1973 AT.WorkPointer = oldworkpointer;
1974 AT.pWorkPointer = oww;
1975 AN.UsedOtherFind = 1;
1976 return(1);
1977 }
1978 }
1979 j = 0;
1980 }
1981 else j = ScanFunctions(BHEAD newpat,inter,par);
1982 if ( j ) {
1983 WORD countsgn, sgn = 0;
1984 for ( countsgn = oRepFunNum+1; countsgn < AN.RepFunNum; countsgn += 2 ) {
1985 if ( AN.RepFunList[countsgn] ) sgn ^= 1;
1986 }
1987 if ( AN.SignCheck == 0 || sgn == AN.ExpectedSign ) {
1988 AT.WorkPointer = oldworkpointer;
1989 AT.pWorkPointer = oww;
1990 return(j);
1991 }
1992 }
1993 AN.RepFunNum = oRepFunNum;
1994 i = argcount - 1;
1995 }
1996 else i = j;
1997 j = nwstore;
1998 m = AN.WildValue;
1999 t = thewildcards + ntwa; r = AT.WildMask;
2000 if ( j > 0 ) {
2001 do {
2002 *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
2003 } while ( --j > 0 );
2004 }
2005 C->numrhs = *t++;
2006 C->Pointer = C->Buffer + oldcpointer;
2007/*
2008 On to the next cycle
2009*/
2010 a = AT.pWorkSpace + oww;
2011 for ( j = i+1, t = a[i]; j < tcount; j++ ) a[j-1] = a[j];
2012 a[tcount-1] = t; cycles[i]--;
2013 signo += tcount - i - 1;
2014 while ( cycles[i] <= 0 ) {
2015 cycles[i] = tcount - i;
2016 i--;
2017 if ( i < 0 ) goto NoSuccess;
2018/*
2019 MLOCK(ErrorMessageLock);
2020 MesPrint("Cycle i = %d",i);
2021 MUNLOCK(ErrorMessageLock);
2022*/
2023 for ( j = i+1, t = a[i]; j < tcount; j++ ) a[j-1] = a[j];
2024 a[tcount-1] = t; cycles[i]--;
2025 signo += tcount - i - 1;
2026 }
2027 }
2028NoSuccess:
2029 if ( oldwilval > 0 ) {
2030 j = nwstore;
2031 m = AN.WildValue;
2032 t = lowlevel; r = AT.WildMask;
2033 if ( j > 0 ) {
2034 do {
2035 *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
2036 } while ( --j > 0 );
2037 }
2038 C->numrhs = *t++;
2039 C->Pointer = C->Buffer + oldcpointer;
2040 }
2041 AT.WorkPointer = oldworkpointer;
2042 AT.pWorkPointer = oww;
2043 return(0);
2044}
2045
2046/*
2047 #] FunMatchSy :
2048 #[ MatchArgument :
2049*/
2050
2051int MatchArgument(PHEAD WORD *arg, WORD *pat)
2052{
2053 GETBIDENTITY
2054 WORD *m = pat, *t = arg, i, j, newvalue;
2055 WORD *argmstop = pat, *argtstop = arg;
2056 WORD *cto, *cfrom, *csav, ci;
2057 WORD oRepFunNum, *oRepFunList;
2058 WORD *oterstart,*oterstop,*opatstop;
2059 WORD wildargs, wildeat;
2060 WORD *mtrmstop, *ttrmstop, *msubstop, msizcoef;
2061 WORD *wildargtaken;
2062 int wc = 1;
2063
2064 NEXTARG(argmstop);
2065 NEXTARG(argtstop);
2066/*
2067 #[ Both fast :
2068*/
2069 if ( *m < 0 && *t < 0 ) {
2070 if ( *t <= -FUNCTION ) {
2071 if ( *t == *m ) {}
2072 else if ( *m <= -FUNCTION-WILDOFFSET
2073 && functions[-*t-FUNCTION].spec
2074 == functions[-*m-FUNCTION-WILDOFFSET].spec ) {
2075 i = -*m - WILDOFFSET; wc = 2;
2076 if ( CheckWild(BHEAD i,FUNTOFUN,-*t,&newvalue) ) {
2077 return(0);
2078 }
2079 AddWild(BHEAD i,FUNTOFUN,newvalue);
2080 }
2081 else if ( *m == -SYMBOL && m[1] >= 2*MAXPOWER ) {
2082 i = m[1] - 2*MAXPOWER;
2083 AN.argaddress = AT.FunArg;
2084 AT.FunArg[ARGHEAD+1] = -*t;
2085 if ( CheckWild(BHEAD i,SYMTOSUB,1,AN.argaddress) ) return(0);
2086 AddWild(BHEAD i,SYMTOSUB,0);
2087 }
2088 else return(0);
2089 }
2090 else if ( *t == *m ) {
2091 if ( t[1] == m[1] ) {}
2092 else if ( *t == -SYMBOL ) {
2093 j = SYMTOSYM;
2094SymAll: if ( ( i = m[1] - 2*MAXPOWER ) < 0 ) return(0);
2095 wc = 2;
2096 if ( CheckWild(BHEAD i,j,t[1],&newvalue) ) return(0);
2097 AddWild(BHEAD i,j,newvalue);
2098 }
2099 else if ( *t == -INDEX ) {
2100IndAll: i = m[1] - WILDOFFSET;
2101 if ( i < AM.OffsetIndex || i >= WILDOFFSET+AM.OffsetIndex )
2102 return(0);
2103 /* We kill the summed over indices here */
2104 wc = 2;
2105 if ( CheckWild(BHEAD i,INDTOIND,t[1],&newvalue) ) return(0);
2106 AddWild(BHEAD i,INDTOIND,newvalue);
2107 }
2108 else if ( *t == -VECTOR || *t == -MINVECTOR ) {
2109 i = m[1] - WILDOFFSET;
2110 if ( i < AM.OffsetVector ) return(0);
2111 wc = 2;
2112 if ( CheckWild(BHEAD i,VECTOVEC,t[1],&newvalue) ) return(0);
2113 AddWild(BHEAD i,VECTOVEC,newvalue);
2114 }
2115 else return(0);
2116 }
2117 else if ( *m == -INDEX && m[1] >= AM.OffsetIndex+WILDOFFSET
2118 && m[1] < AM.OffsetIndex+(WILDOFFSET<<1) ) {
2119 if ( *t == -VECTOR ) goto IndAll;
2120 if ( *t == -SNUMBER && t[1] >= 0 && t[1] < AM.OffsetIndex ) goto IndAll;
2121 if ( *t == -MINVECTOR ) {
2122 i = m[1] - WILDOFFSET;
2123 AN.argaddress = AT.MinVecArg;
2124 AT.MinVecArg[ARGHEAD+3] = t[1];
2125 wc = 2;
2126 if ( CheckWild(BHEAD i,INDTOSUB,1,AN.argaddress) ) return(0);
2127 AddWild(BHEAD i,INDTOSUB,(WORD)0);
2128 }
2129 else return(0);
2130 }
2131 else if ( *m == -SYMBOL && m[1] >= 2*MAXPOWER && *t == -SNUMBER ) {
2132 j = SYMTONUM;
2133 goto SymAll;
2134 }
2135 else if ( *m == -VECTOR && *t == -MINVECTOR &&
2136 ( i = m[1] - WILDOFFSET ) >= AM.OffsetVector ) {
2137 wc = 2;
2138/*
2139 AN.argaddress = AT.MinVecArg;
2140 AT.MinVecArg[ARGHEAD+3] = t[1];
2141 if ( CheckWild(BHEAD i,VECTOSUB,1,AN.argaddress) ) return(0);
2142 AddWild(BHEAD i,VECTOSUB,(WORD)0);
2143*/
2144 if ( CheckWild(BHEAD i,VECTOMIN,t[1],&newvalue) ) return(0);
2145 AddWild(BHEAD i,VECTOMIN,newvalue);
2146
2147 }
2148 else if ( *m == -MINVECTOR && *t == -VECTOR &&
2149 ( i = m[1] - WILDOFFSET ) >= AM.OffsetVector ) {
2150 wc = 2;
2151/*
2152 AN.argaddress = AT.MinVecArg;
2153 AT.MinVecArg[ARGHEAD+3] = t[1];
2154 if ( CheckWild(BHEAD i,VECTOSUB,1,AN.argaddress) ) return(0);
2155 AddWild(BHEAD i,VECTOSUB,(WORD)0);
2156*/
2157 if ( CheckWild(BHEAD i,VECTOMIN,t[1],&newvalue) ) return(0);
2158 AddWild(BHEAD i,VECTOMIN,newvalue);
2159 }
2160 else return(0);
2161 }
2162/*
2163 #] Both fast :
2164 #[ Fast arg :
2165*/
2166 else if ( *m > 0 && *t <= -FUNCTION ) {
2167 if ( ( m[ARGHEAD]+ARGHEAD == *m ) && m[*m-1] == 3
2168 && m[*m-2] == 1 && m[*m-3] == 1 && m[ARGHEAD+1] >= FUNCTION
2169 && m[ARGHEAD+2] == *m-ARGHEAD-4 ) { /* Check for f(?a) etc */
2170 WORD *mmmst, *mmm, mmmi;
2171 if ( m[ARGHEAD+1] >= FUNCTION+WILDOFFSET ) {
2172 mmmi = *m - WILDOFFSET;
2173 wc = 2;
2174 if ( CheckWild(BHEAD mmmi,FUNTOFUN,-*t,&newvalue) ) return(0);
2175 AddWild(BHEAD mmmi,FUNTOFUN,newvalue);
2176 }
2177 else if ( m[ARGHEAD+1] != -*t ) return(0);
2178/*
2179 Only arguments allowed are ?a etc.
2180*/
2181 mmmst = m+*m-3;
2182 mmm = m + ARGHEAD + FUNHEAD + 1;
2183 while ( mmm < mmmst ) {
2184 if ( *mmm != -ARGWILD ) return(0);
2185 mmmi = 0;
2186 AN.argaddress = t; wc = 2;
2187 if ( CheckWild(BHEAD mmm[1],ARGTOARG,mmmi,t) ) return(0);
2188 AddWild(BHEAD mmm[1],ARGTOARG,mmmi);
2189 mmm += 2;
2190 }
2191 }
2192 else return(0);
2193 }
2194/*
2195 #] Fast arg :
2196 #[ Fast pat :
2197*/
2198 else if ( *m < 0 && *t > 0 ) {
2199 if ( *m == -SYMBOL ) { /* SYMTOSUB */
2200 if ( m[1] < 2*MAXPOWER ) return(0);
2201 i = m[1] - 2*MAXPOWER;
2202 AN.argaddress = t; wc = 2;
2203 if ( CheckWild(BHEAD i,SYMTOSUB,1,AN.argaddress) ) return(0);
2204 AddWild(BHEAD i,SYMTOSUB,0);
2205 }
2206 else if ( *m == -VECTOR ) {
2207 if ( ( i = m[1] - WILDOFFSET ) < AM.OffsetVector ) return(0);
2208 AN.argaddress = t; wc = 2;
2209 if ( CheckWild(BHEAD i,VECTOSUB,1,t) ) return(0);
2210 AddWild(BHEAD i,VECTOSUB,(WORD)0);
2211 }
2212 else if ( *m == -INDEX ) {
2213 if ( ( i = m[1] - WILDOFFSET ) < AM.OffsetIndex ) return(0);
2214 if ( i >= AM.OffsetIndex + WILDOFFSET ) return(0);
2215 AN.argaddress = t; wc = 2;
2216 if ( CheckWild(BHEAD i,INDTOSUB,1,AN.argaddress) ) return(0);
2217 AddWild(BHEAD i,INDTOSUB,(WORD)0);
2218 }
2219 else return(0);
2220 }
2221/*
2222 #] Fast pat :
2223 #[ Both general :
2224*/
2225 else if ( *m > 0 && *t > 0 ) {
2226 i = *m;
2227 do { if ( *m++ != *t++ ) break; } while ( --i > 0 );
2228 if ( i > 0 ) {
2229/*
2230 Not an exact match here.
2231 We have to hope that the pattern contains a composite wildcard.
2232*/
2233 m = pat; t = arg;
2234 m += ARGHEAD; t += ARGHEAD; /* Point at (first?) term */
2235 mtrmstop = m + *m;
2236 ttrmstop = t + *t;
2237 if ( mtrmstop < argmstop ) return(0);/* More than one term */
2238 msizcoef = mtrmstop[-1];
2239 if ( msizcoef < 0 ) msizcoef = -msizcoef;
2240 msubstop = mtrmstop - msizcoef;
2241 m++;
2242 if ( m >= msubstop ) return(0); /* Only coefficient */
2243/*
2244 Here we have a composite term. It can match provided it
2245 matches the entire argument. This argument must be a
2246 single term also and the coefficients should match
2247 (more or less).
2248 The matching takes:
2249 1: Match the functions etc. Nothing can be left.
2250 2: Match dotproducts and symbols. ONLY must match
2251 and nothing may be left.
2252 For safety it is best to take the term out and put it
2253 in workspace.
2254*/
2255 if ( argtstop > ttrmstop ) return(0);
2256 m--;
2257
2258 oterstart = AN.terstart;
2259 oterstop = AN.terstop;
2260 opatstop = AN.patstop;
2261 oRepFunList = AN.RepFunList;
2262 oRepFunNum = AN.RepFunNum;
2263 AN.RepFunNum = 0;
2264 wildargtaken = AT.WorkPointer;
2265 AN.RepFunList = wildargtaken + AN.NumTotWildArgs;
2266 AT.WorkPointer = (WORD *)(((UBYTE *)(AN.RepFunList)) + AM.MaxTer/2);
2267 csav = cto = AT.WorkPointer;
2268 cfrom = t;
2269 ci = *t;
2270 while ( --ci >= 0 ) *cto++ = *cfrom++;
2271 AT.WorkPointer = cto;
2272 ci = msizcoef;
2273 cfrom = mtrmstop;
2274 while ( --ci >= 0 ) {
2275 if ( *--cfrom != *--cto ) {
2276 AT.WorkPointer = wildargtaken;
2277 AN.RepFunList = oRepFunList;
2278 AN.RepFunNum = oRepFunNum;
2279 AN.terstart = oterstart;
2280 AN.terstop = oterstop;
2281 AN.patstop = opatstop;
2282 return(0);
2283 }
2284 }
2285 *m -= msizcoef;
2286 wildargs = AN.WildArgs;
2287 wildeat = AN.WildEat;
2288 for ( i = 0; i < wildargs; i++ ) wildargtaken[i] = AT.WildArgTaken[i];
2289 AN.ForFindOnly = 0; AN.UseFindOnly = 1;
2290 AN.nogroundlevel++;
2291 if ( FindRest(BHEAD csav,m) && ( AN.UsedOtherFind || FindOnly(BHEAD csav,m) ) ) { }
2292 else {
2293 *m += msizcoef;
2294 AT.WorkPointer = wildargtaken;
2295 AN.RepFunList = oRepFunList;
2296 AN.RepFunNum = oRepFunNum;
2297 AN.terstart = oterstart;
2298 AN.terstop = oterstop;
2299 AN.patstop = opatstop;
2300 AN.WildArgs = wildargs;
2301 AN.WildEat = wildeat;
2302 AN.nogroundlevel--;
2303 for ( i = 0; i < wildargs; i++ ) AT.WildArgTaken[i] = wildargtaken[i];
2304 return(0);
2305 }
2306 AN.nogroundlevel--;
2307 AN.WildArgs = wildargs;
2308 AN.WildEat = wildeat;
2309 for ( i = 0; i < wildargs; i++ ) AT.WildArgTaken[i] = wildargtaken[i];
2310 Substitute(BHEAD csav,m,1);
2311 cto = csav;
2312 cfrom = cto + *cto - msizcoef;
2313 cto++;
2314 *m += msizcoef;
2315 AT.WorkPointer = wildargtaken;
2316 AN.RepFunList = oRepFunList;
2317 AN.RepFunNum = oRepFunNum;
2318 AN.terstart = oterstart;
2319 AN.terstop = oterstop;
2320 AN.patstop = opatstop;
2321 if ( *cto != SUBEXPRESSION ) return(0);
2322 cto += cto[1];
2323 if ( cto < cfrom ) return(0);
2324 }
2325 }
2326/*
2327 #] Both general :
2328*/
2329 else return(0);
2330/*
2331 And now the success: (wc = 2 means that there was a wildcard involved)
2332*/
2333 return(wc);
2334}
2335
2336/*
2337 #] MatchArgument :
2338*/
WORD * Buffer
Definition structs.h:939
WORD * Pointer
Definition structs.h:941