FORM  4.2
symmetr.c
Go to the documentation of this file.
1 
6 /* #[ License : */
7 /*
8  * Copyright (C) 1984-2017 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 
56 WORD 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  }
292 NextWV:
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;
409 NoCaseB: 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 
443 WORD 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 
477 WORD 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 
509 WORD 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 
570 int 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 */
1038 NoSuccess:
1039  if ( oldwilval > 0 ) {
1040 nomatch:;
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 
1066 int 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 */
1497 NoSuccess:
1498  if ( oldwilval > 0 ) {
1499 nomatch:;
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 
1524 int 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 ) {
1590 quicky:
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;
1766 cat1:
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 */
1781 oneless:
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;
1831 nextjarg:;
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;
1852 nextargw:;
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;
1907 nextiraise:;
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  }
2028 NoSuccess:
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 
2051 int 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;
2094 SymAll: 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 ) {
2100 IndAll: 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 */
#define PHEAD
Definition: ftypes.h:56
Definition: structs.h:921
WORD * Pointer
Definition: structs.h:924
WORD * Buffer
Definition: structs.h:922