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