FORM  4.1
symmetr.c
Go to the documentation of this file.
1 
6 /* #[ License : */
7 /*
8  * Copyright (C) 1984-2013 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  #[ Distribute :
473 */
474 
475 WORD Distribute(DISTRIBUTE *d, WORD first)
476 {
477  WORD *to, *from, *inc, *from2, i, j;
478  if ( first ) {
479  d->n = d->n1 + d->n2;
480  to = d->out;
481  from = d->obj2;
482  for ( i = 0; i < d->n2; i++ ) {
483  d->cycle[i] = 0;
484  *to++ = *from++;
485  }
486  from = d->obj1;
487  while ( i < d->n ) {
488  d->cycle[i++] = 1;
489  *to++ = *from++;
490  }
491  d->sign = 0;
492  return(0);
493  }
494  if ( d->n1 == 0 || d->n2 == 0 ) return(1);
495  j = 0;
496  i = 0;
497  inc = d->cycle;
498  from = inc + d->n;
499  while ( *inc ) { j++; inc++; }
500  while ( !*inc && inc < from ) { i++; inc++; }
501  if ( inc >= from ) return(1);
502  d->sign ^= ((i&j)-j+1) & 1;
503  *inc = 0;
504  *--inc = 1;
505  while ( --j >= 0 ) *--inc = 1;
506  while ( --i > 0 ) *--inc = 0;
507  to = d->out;
508  from = d->obj1;
509  from2 = d->obj2;
510  for ( i = 0; i < d->n; i++ ) {
511  if ( *inc++ ) {
512  *to++ = *from++;
513  }
514  else {
515  *to++ = *from2++;
516  }
517  }
518  return(0);
519 }
520 
521 /*
522  #] Distribute :
523  #[ MatchCy :
524 
525  Matching of (r)cyclic tensors.
526  Parameters like in MatchE.
527  The structure of the routine is much simpler, because the number
528  of possibilities is much more limited.
529  The major complication is the ?a-type wildcards
530  We need a strategy for T(i1?,?a,i1?,?b). Which is the shorter
531  match: ?a or ?b ? (if possible of course)
532  This is also relevant in the case of the shortest match if there
533  is more than one choice for i1.
534 */
535 
536 int MatchCy(PHEAD WORD *pattern, WORD *fun, WORD *inter, WORD par)
537 {
538  GETBIDENTITY
539  WORD *t, *tstop, *p, *pstop, *m, *r, *oldworkpointer = AT.WorkPointer;
540  WORD *thewildcards, *multiplicity, *renum, wc, newvalue, oldwilval = 0;
541  WORD *params, *lowlevel = 0;
542  int argcount = 0, funnycount = 0, tcount = fun[1] - FUNHEAD;
543  int type = 0, pnum, i, j, k, nwstore, iraise, itop, sumeat;
544  CBUF *C = cbuf+AT.ebufnum;
545  int ntwa = 3*AN.NumTotWildArgs+1;
546  LONG oldcpointer = C->Pointer - C->Buffer;
547  WORD offset = fun-AN.terstart, *newpat;
548 
549  if ( (functions[fun[0]-FUNCTION].symmetric & ~REVERSEORDER) == RCYCLESYMMETRIC ) type = 1;
550  pnum = pattern[0];
551  nwstore = (AN.WildValue[-SUBEXPSIZE+1]-SUBEXPSIZE)/4;
552  if ( pnum > FUNCTION + WILDOFFSET ) {
553  pnum -= WILDOFFSET;
554  if ( CheckWild(BHEAD pnum,FUNTOFUN,fun[0],&newvalue) ) return(0);
555  oldwilval = 1;
556  t = lowlevel = AT.WorkPointer;
557  m = AN.WildValue;
558  i = nwstore;
559  r = AT.WildMask;
560  if ( i > 0 ) {
561  do {
562  *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *r++;
563  } while ( --i > 0 );
564  }
565  *t++ = C->numrhs;
566  if ( t >= AT.WorkTop ) {
567  MLOCK(ErrorMessageLock);
568  MesWork();
569  MUNLOCK(ErrorMessageLock);
570  return(-1);
571  }
572  AT.WorkPointer = t;
573  AddWild(BHEAD pnum,FUNTOFUN,newvalue);
574  }
575  if ( (functions[pnum-FUNCTION].symmetric & ~REVERSEORDER) == RCYCLESYMMETRIC ) type = 1;
576 
577  /* First we have to make an inventory. Are there FUNNYWILD pointers? */
578 
579  p = pattern + FUNHEAD;
580  pstop = pattern + pattern[1];
581  while ( p < pstop ) {
582  if ( *p == FUNNYWILD ) { p += 2; funnycount++; }
583  else { p++; argcount++; }
584  }
585  if ( argcount > tcount ) goto NoSuccess;
586  if ( argcount < tcount && funnycount == 0 ) goto NoSuccess;
587  if ( argcount == 0 && tcount == 0 && funnycount == 0 ) {
588  AN.RepFunList[AN.RepFunNum++] = offset;
589  AN.RepFunList[AN.RepFunNum++] = 0;
590  newpat = pattern + pattern[1];
591  if ( newpat >= AN.patstop ) {
592  if ( AN.UseFindOnly == 0 ) {
593  if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
594  AT.WorkPointer = oldworkpointer;
595  AN.UsedOtherFind = 1;
596  return(1);
597  }
598  j = 0;
599  }
600  else {
601  AT.WorkPointer = oldworkpointer;
602  return(1);
603  }
604  }
605  else j = ScanFunctions(BHEAD newpat,inter,par);
606  if ( j ) return(j);
607  goto NoSuccess;
608  }
609  tstop = fun + fun[1];
610 
611  /* Store the wildcard assignments */
612 
613  params = AT.WorkPointer;
614  thewildcards = t = params + tcount;
615  t += ntwa;
616  if ( oldwilval ) lowlevel = oldworkpointer;
617  else lowlevel = t;
618  m = AN.WildValue;
619  i = nwstore;
620  if ( i > 0 ) {
621  r = AT.WildMask;
622  do {
623  *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *r++;
624  } while ( --i > 0 );
625  *t++ = C->numrhs;
626  }
627  if ( t >= AT.WorkTop ) {
628  MLOCK(ErrorMessageLock);
629  MesWork();
630  MUNLOCK(ErrorMessageLock);
631  return(-1);
632  }
633  AT.WorkPointer = t;
634 /*
635  #[ Case 1: no funnies or all funnies must be empty. We just cycle through.
636 */
637  if ( argcount == tcount ) {
638  if ( funnycount > 0 ) { /* Test all funnies first */
639  p = pattern + FUNHEAD;
640  t = fun + FUNHEAD;
641  while ( p < pstop ) {
642  if ( *p != FUNNYWILD ) { p++; continue; }
643  AN.argaddress = t;
644  if ( CheckWild(BHEAD p[1],ARGTOARG,0,t) ) goto nomatch;
645  AddWild(BHEAD p[1],ARGTOARG,0);
646  p += 2;
647  }
648  oldwilval = 1;
649  }
650  for ( k = 0; k <= type; k++ ) {
651  if ( k == 0 ) {
652  p = params; t = fun + FUNHEAD;
653  while ( t < tstop ) *p++ = *t++;
654  }
655  else {
656  p = params+tcount; t = fun + FUNHEAD;
657  while ( t < tstop ) *--p = *t++;
658  }
659  for ( i = 0; i < tcount; i++ ) { /* The various cycles */
660  p = pattern + FUNHEAD;
661  wc = 0;
662  for ( j = 0; j < tcount; j++, p++ ) { /* The arguments */
663  while ( *p == FUNNYWILD ) p += 2;
664  t = params + (i+j)%tcount;
665  if ( *t == *p ) continue;
666  if ( *p >= AM.OffsetIndex + WILDOFFSET
667  && *p < AM.OffsetIndex + 2*WILDOFFSET ) {
668 
669  /* Test wildcard index */
670 
671  wc = *p - WILDOFFSET;
672  if ( CheckWild(BHEAD wc,INDTOIND,*t,&newvalue) ) break;
673  AddWild(BHEAD wc,INDTOIND,newvalue);
674  }
675  else if ( *t < MINSPEC && p[j] < MINSPEC
676  && *p >= AM.OffsetVector + WILDOFFSET ) {
677 
678  /* Test wildcard vector */
679 
680  wc = *p - WILDOFFSET;
681  if ( CheckWild(BHEAD wc,VECTOVEC,*t,&newvalue) ) break;
682  AddWild(BHEAD wc,VECTOVEC,newvalue);
683  }
684  else break;
685  }
686  if ( j >= tcount ) { /* Match! */
687 
688  /* Continue with other functions. Make sure of the funnies */
689 
690  AN.RepFunList[AN.RepFunNum++] = offset;
691  AN.RepFunList[AN.RepFunNum++] = 0;
692 
693  if ( funnycount > 0 ) {
694  p = pattern + FUNHEAD;
695  t = fun + FUNHEAD;
696  while ( p < pstop ) {
697  if ( *p != FUNNYWILD ) { p++; continue; }
698  AN.argaddress = t;
699  AddWild(BHEAD p[1],ARGTOARG,0);
700  p += 2;
701  }
702  }
703  newpat = pattern + pattern[1];
704  if ( newpat >= AN.patstop ) {
705  if ( AN.UseFindOnly == 0 ) {
706  if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
707  AT.WorkPointer = oldworkpointer;
708  AN.UsedOtherFind = 1;
709  return(1);
710  }
711  j = 0;
712  }
713  else {
714  AT.WorkPointer = oldworkpointer;
715  return(1);
716  }
717  }
718  else j = ScanFunctions(BHEAD newpat,inter,par);
719  if ( j ) {
720  AT.WorkPointer = oldworkpointer;
721  return(j); /* Full match. Return our success */
722  }
723  AN.RepFunNum -= 2;
724  }
725 
726  /* No (deeper) match. -> reset wildcards and continue */
727 
728  if ( wc && nwstore > 0 ) {
729  j = nwstore;
730  m = AN.WildValue;
731  t = thewildcards + ntwa; r = AT.WildMask;
732  if ( j > 0 ) {
733  do {
734  *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
735  } while ( --j > 0 );
736  }
737  C->numrhs = *t++;
738  C->Pointer = C->Buffer + oldcpointer;
739  }
740  }
741  }
742  goto NoSuccess;
743  }
744 /*
745  #] Case 1:
746  #[ Case 2: One FUNNYWILD. Fix its length.
747 */
748  if ( funnycount == 1 ) {
749  funnycount = tcount - argcount; /* Number or arguments to be eaten */
750  for ( k = 0; k <= type; k++ ) {
751  if ( k == 0 ) {
752  p = params; t = fun + FUNHEAD;
753  while ( t < tstop ) *p++ = *t++;
754  }
755  else {
756  p = params+tcount; t = fun + FUNHEAD;
757  while ( t < tstop ) *--p = *t++;
758  }
759  for ( i = 0; i < tcount; i++ ) { /* The various cycles */
760  p = pattern + FUNHEAD;
761  t = params;
762  wc = 0;
763  for ( j = 0; j < tcount; j++, p++, t++ ) { /* The arguments */
764  if ( *t == *p ) continue;
765  if ( *p == FUNNYWILD ) {
766  p++; wc = 1;
767  AN.argaddress = t;
768  if ( CheckWild(BHEAD *p,ARGTOARG,funnycount|EATTENSOR,t) ) break;
769  AddWild(BHEAD *p,ARGTOARG,funnycount|EATTENSOR);
770  j += funnycount-1; t += funnycount-1;
771  }
772  else if ( *p >= AM.OffsetIndex + WILDOFFSET
773  && *p < AM.OffsetIndex + 2*WILDOFFSET ) {
774 
775  /* Test wildcard index */
776 
777  wc = *p - WILDOFFSET;
778  if ( CheckWild(BHEAD wc,INDTOIND,*t,&newvalue) ) break;
779  AddWild(BHEAD wc,INDTOIND,newvalue);
780  }
781  else if ( *t < MINSPEC && *p < MINSPEC
782  && *p >= AM.OffsetVector + WILDOFFSET ) {
783 
784  /* Test wildcard vector */
785 
786  wc = *p - WILDOFFSET;
787  if ( CheckWild(BHEAD wc,VECTOVEC,*t,&newvalue) ) break;
788  AddWild(BHEAD wc,VECTOVEC,newvalue);
789  }
790  else break;
791  }
792  if ( j >= tcount ) { /* Match! */
793 
794  /* Continue with other functions. Make sure of the funnies */
795 
796  AN.RepFunList[AN.RepFunNum++] = offset;
797  AN.RepFunList[AN.RepFunNum++] = 0;
798  newpat = pattern + pattern[1];
799  if ( newpat >= AN.patstop ) {
800  if ( AN.UseFindOnly == 0 ) {
801  if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
802  AT.WorkPointer = oldworkpointer;
803  AN.UsedOtherFind = 1;
804  return(1);
805  }
806  j = 0;
807  }
808  else {
809  AT.WorkPointer = oldworkpointer;
810  return(1);
811  }
812  }
813  else j = ScanFunctions(BHEAD newpat,inter,par);
814  if ( j ) {
815  AT.WorkPointer = oldworkpointer;
816  return(j); /* Full match. Return our success */
817  }
818  AN.RepFunNum -= 2;
819  }
820 
821  /* No (deeper) match. -> reset wildcards and continue */
822 
823  if ( wc ) {
824  j = nwstore;
825  m = AN.WildValue;
826  t = thewildcards + ntwa; r = AT.WildMask;
827  if ( j > 0 ) {
828  do {
829  *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
830  } while ( --j > 0 );
831  }
832  C->numrhs = *t++;
833  C->Pointer = C->Buffer + oldcpointer;
834  }
835  t = params;
836  wc = *t;
837  for ( j = 1; j < tcount; j++ ) { *t = t[1]; t++; }
838  *t = wc;
839  }
840  }
841  goto NoSuccess;
842  }
843 /*
844  #] Case 2:
845  #[ Case 3: More than one FUNNYWILD. Complicated.
846 */
847 
848  sumeat = tcount - argcount; /* Total number to be eaten by Funnies */
849 /*
850  In the first funnycount elements of 'thewildcards' we arrange
851  for the summing over the various possibilities.
852  The renumbering table is in thewildcards[2*funnycount]
853  The multiplicity table is in thewildcards[funnycount]
854  The number of arguments for each is in thewildcards[]
855 */
856  p = pattern+FUNHEAD;
857  for ( i = funnycount; i < ntwa; i++ ) thewildcards[i] = -1;
858  multiplicity = thewildcards + funnycount;
859  renum = multiplicity + funnycount;
860  j = 0;
861  while ( p < pstop ) {
862  if ( *p != FUNNYWILD ) { p++; continue; }
863  p++;
864  if ( renum[*p] < 0 ) {
865  renum[*p] = j;
866  multiplicity[j] = 1;
867  j++;
868  }
869  else multiplicity[renum[*p]]++;
870  p++;
871  }
872 /*
873  Strategy: First 'declared' has a tendency to be smaller
874 */
875  for ( i = 1; i < AN.NumTotWildArgs; i++ ) {
876  if ( renum[i] < 0 ) continue;
877  for ( j = i+1; j <= AN.NumTotWildArgs; j++ ) {
878  if ( renum[j] < 0 ) continue;
879  if ( renum[i] < renum[j] ) continue;
880  k = multiplicity[renum[i]];
881  multiplicity[renum[i]] = multiplicity[renum[j]];
882  multiplicity[renum[j]] = k;
883  k = renum[i]; renum[i] = renum[j]; renum[j] = k;
884  }
885  }
886  for ( i = 0; i < funnycount; i++ ) thewildcards[i] = 0;
887  iraise = funnycount-1;
888  for ( ;; ) {
889  for ( i = 0, j = sumeat; i < iraise; i++ )
890  j -= thewildcards[i]*multiplicity[i];
891  if ( j < 0 || j % multiplicity[iraise] != 0 ) {
892  if ( j > 0 ) {
893  thewildcards[iraise-1]++;
894  continue;
895  }
896  itop = iraise-1;
897  while ( itop > 0 && j < 0 ) {
898  j += thewildcards[itop]*multiplicity[itop];
899  thewildcards[itop] = 0;
900  itop--;
901  }
902  if ( itop <= 0 && j <= 0 ) break;
903  thewildcards[itop]++;
904  continue;
905  }
906  thewildcards[iraise] = j / multiplicity[iraise];
907 
908  for ( k = 0; k <= type; k++ ) {
909  if ( k == 0 ) {
910  p = params; t = fun + FUNHEAD;
911  while ( t < tstop ) *p++ = *t++;
912  }
913  else {
914  p = params+tcount; t = fun + FUNHEAD;
915  while ( t < tstop ) *--p = *t++;
916  }
917  for ( i = 0; i < tcount; i++ ) { /* The various cycles */
918  p = pattern + FUNHEAD;
919  t = params;
920  wc = 0;
921  for ( j = 0; j < tcount; j++, p++, t++ ) { /* The arguments */
922  if ( *t == *p ) continue;
923  if ( *p == FUNNYWILD ) {
924  p++; wc = thewildcards[renum[*p]];
925  AN.argaddress = t;
926  if ( CheckWild(BHEAD *p,ARGTOARG,wc|EATTENSOR,t) ) break;
927  AddWild(BHEAD *p,ARGTOARG,wc|EATTENSOR);
928  j += wc-1; t += wc-1; wc = 1;
929  }
930  else if ( *p >= AM.OffsetIndex + WILDOFFSET
931  && *p < AM.OffsetIndex + 2*WILDOFFSET ) {
932 
933  /* Test wildcard index */
934 
935  wc = *p - WILDOFFSET;
936  if ( CheckWild(BHEAD wc,INDTOIND,*t,&newvalue) ) break;
937  AddWild(BHEAD wc,INDTOIND,newvalue);
938  }
939  else if ( *t < MINSPEC && *p < MINSPEC
940  && *p >= AM.OffsetVector + WILDOFFSET ) {
941 
942  /* Test wildcard vector */
943 
944  wc = *p - WILDOFFSET;
945  if ( CheckWild(BHEAD wc,VECTOVEC,*t,&newvalue) ) break;
946  AddWild(BHEAD wc,VECTOVEC,newvalue);
947  }
948  else break;
949  }
950  if ( j >= tcount ) { /* Match! */
951 
952  /* Continue with other functions. Make sure of the funnies */
953 
954  AN.RepFunList[AN.RepFunNum++] = offset;
955  AN.RepFunList[AN.RepFunNum++] = 0;
956  newpat = pattern + pattern[1];
957  if ( newpat >= AN.patstop ) {
958  if ( AN.UseFindOnly == 0 ) {
959  if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
960  AT.WorkPointer = oldworkpointer;
961  AN.UsedOtherFind = 1;
962  return(1);
963  }
964  j = 0;
965  }
966  else {
967  AT.WorkPointer = oldworkpointer;
968  return(1);
969  }
970  }
971  else j = ScanFunctions(BHEAD newpat,inter,par);
972  if ( j ) {
973  AT.WorkPointer = oldworkpointer;
974  return(j); /* Full match. Return our success */
975  }
976  AN.RepFunNum -= 2;
977  }
978 
979  /* No (deeper) match. -> reset wildcards and continue */
980 
981  if ( wc ) {
982  j = nwstore;
983  m = AN.WildValue;
984  t = thewildcards + ntwa; r = AT.WildMask;
985  if ( j > 0 ) {
986  do {
987  *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
988  } while ( --j > 0 );
989  }
990  C->numrhs = *t++;
991  C->Pointer = C->Buffer + oldcpointer;
992  }
993  t = params;
994  wc = *t;
995  for ( j = 1; j < tcount; j++ ) { *t = t[1]; t++; }
996  *t = wc;
997  }
998  }
999  (thewildcards[iraise-1])++;
1000  }
1001 /*
1002  #] Case 3:
1003 */
1004 NoSuccess:
1005  if ( oldwilval > 0 ) {
1006 nomatch:;
1007  j = nwstore;
1008  if ( j > 0 ) {
1009  m = AN.WildValue;
1010  t = lowlevel; r = AT.WildMask;
1011  if ( j > 0 ) {
1012  do {
1013  *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
1014  } while ( --j > 0 );
1015  }
1016  C->numrhs = *t++;
1017  C->Pointer = C->Buffer + oldcpointer;
1018  }
1019  }
1020  AT.WorkPointer = oldworkpointer;
1021  return(0);
1022 }
1023 
1024 /*
1025  #] MatchCy :
1026  #[ FunMatchCy :
1027 
1028  Matching of (r)cyclic functions.
1029  Like MatchCy, but now for general functions.
1030 */
1031 
1032 int FunMatchCy(PHEAD WORD *pattern, WORD *fun, WORD *inter, WORD par)
1033 {
1034  GETBIDENTITY
1035  WORD *t, *tstop, *p, *pstop, *m, *r, *oldworkpointer = AT.WorkPointer;
1036  WORD **a, *thewildcards, *multiplicity, *renum, wc, wcc, oldwilval = 0;
1037  LONG oww = AT.pWorkPointer;
1038  WORD newvalue, *lowlevel = 0;
1039  int argcount = 0, funnycount = 0, tcount = 0;
1040  int type = 0, pnum, i, j, k, nwstore, iraise, itop, sumeat;
1041  CBUF *C = cbuf+AT.ebufnum;
1042  int ntwa = 3*AN.NumTotWildArgs+1;
1043  LONG oldcpointer = C->Pointer - C->Buffer;
1044  WORD offset = fun-AN.terstart, *newpat;
1045 
1046  if ( (functions[fun[0]-FUNCTION].symmetric & ~REVERSEORDER) == RCYCLESYMMETRIC ) type = 1;
1047  pnum = pattern[0];
1048  nwstore = (AN.WildValue[-SUBEXPSIZE+1]-SUBEXPSIZE)/4;
1049  if ( pnum > FUNCTION + WILDOFFSET ) {
1050  pnum -= WILDOFFSET;
1051  if ( CheckWild(BHEAD pnum,FUNTOFUN,fun[0],&newvalue) ) return(0);
1052  oldwilval = 1;
1053  t = lowlevel = oldworkpointer;
1054  m = AN.WildValue;
1055  i = nwstore;
1056  r = AT.WildMask;
1057  if ( i > 0 ) {
1058  do {
1059  *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *r++;
1060  } while ( --i > 0 );
1061  }
1062  *t++ = C->numrhs;
1063  if ( t >= AT.WorkTop ) {
1064  MLOCK(ErrorMessageLock);
1065  MesWork();
1066  MUNLOCK(ErrorMessageLock);
1067  return(-1);
1068  }
1069  AT.WorkPointer = t;
1070  AddWild(BHEAD pnum,FUNTOFUN,newvalue);
1071  }
1072  if ( (functions[pnum-FUNCTION].symmetric & ~REVERSEORDER) == RCYCLESYMMETRIC ) type = 1;
1073 
1074  /* First we have to make an inventory. Are there -ARGWILD pointers? */
1075 
1076  p = pattern + FUNHEAD;
1077  pstop = pattern + pattern[1];
1078  while ( p < pstop ) {
1079  if ( *p == -ARGWILD ) { p += 2; funnycount++; }
1080  else { NEXTARG(p); argcount++; }
1081  }
1082  t = fun + FUNHEAD;
1083  tstop = fun + fun[1];
1084  while ( t < tstop ) { NEXTARG(t); tcount++; }
1085 
1086  if ( argcount > tcount ) return(0);
1087  if ( argcount < tcount && funnycount == 0 ) return(0);
1088  if ( argcount == 0 && tcount == 0 && funnycount == 0 ) {
1089  AN.RepFunList[AN.RepFunNum++] = offset;
1090  AN.RepFunList[AN.RepFunNum++] = 0;
1091  newpat = pattern + pattern[1];
1092  if ( newpat >= AN.patstop ) {
1093  if ( AN.UseFindOnly == 0 ) {
1094  if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
1095  AT.WorkPointer = oldworkpointer;
1096  AN.UsedOtherFind = 1;
1097  return(1);
1098  }
1099  j = 0;
1100  }
1101  else {
1102  AT.WorkPointer = oldworkpointer;
1103  return(1);
1104  }
1105  }
1106  else j = ScanFunctions(BHEAD newpat,inter,par);
1107  if ( j ) return(j);
1108  goto NoSuccess;
1109  }
1110 
1111  /* Store the wildcard assignments */
1112 
1113  WantAddPointers(tcount);
1114  AT.pWorkPointer += tcount;
1115  thewildcards = t = AT.WorkPointer;
1116  t += ntwa;
1117  if ( oldwilval ) lowlevel = oldworkpointer;
1118  else lowlevel = t;
1119  m = AN.WildValue;
1120  i = nwstore;
1121  if ( i > 0 ) {
1122  r = AT.WildMask;
1123  do {
1124  *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *r++;
1125  } while ( --i > 0 );
1126  *t++ = C->numrhs;
1127  }
1128  if ( t >= AT.WorkTop ) {
1129  MLOCK(ErrorMessageLock);
1130  MesWork();
1131  MUNLOCK(ErrorMessageLock);
1132  return(-1);
1133  }
1134  AT.WorkPointer = t;
1135 /*
1136  #[ Case 1: no funnies or all funnies must be empty. We just cycle through.
1137 */
1138  if ( argcount == tcount ) {
1139  if ( funnycount > 0 ) { /* Test all funnies first */
1140  p = pattern + FUNHEAD;
1141  t = fun + FUNHEAD;
1142  while ( p < pstop ) {
1143  if ( *p != -ARGWILD ) { p++; continue; }
1144  AN.argaddress = t;
1145  if ( CheckWild(BHEAD p[1],ARGTOARG,0,t) ) goto nomatch;
1146  AddWild(BHEAD p[1],ARGTOARG,0);
1147  p += 2;
1148  }
1149  oldwilval = 1;
1150  }
1151  for ( k = 0; k <= type; k++ ) {
1152  if ( k == 0 ) {
1153  a = AT.pWorkSpace+oww; t = fun + FUNHEAD;
1154  while ( t < tstop ) { *a++ = t; NEXTARG(t); }
1155  }
1156  else {
1157  a = AT.pWorkSpace+oww+tcount; t = fun + FUNHEAD;
1158  while ( t < tstop ) { *--a = t; NEXTARG(t); }
1159  }
1160  for ( i = 0; i < tcount; i++ ) { /* The various cycles */
1161  p = pattern + FUNHEAD;
1162  wc = 0;
1163  for ( j = 0; j < tcount; j++ ) { /* The arguments */
1164  while ( *p == -ARGWILD ) p += 2;
1165  t = AT.pWorkSpace[oww+((i+j)%tcount)];
1166  if ( ( wcc = MatchArgument(BHEAD t,p) ) == 0 ) break;
1167  if ( wcc > 1 ) wc = 1;
1168  NEXTARG(p);
1169  }
1170  if ( j >= tcount ) { /* Match! */
1171 
1172  /* Continue with other functions. Make sure of the funnies */
1173 
1174  AN.RepFunList[AN.RepFunNum++] = offset;
1175  AN.RepFunList[AN.RepFunNum++] = 0;
1176 
1177  if ( funnycount > 0 ) {
1178  p = pattern + FUNHEAD;
1179  t = fun + FUNHEAD;
1180  while ( p < pstop ) {
1181  if ( *p != -ARGWILD ) { p++; continue; }
1182  AN.argaddress = t;
1183  AddWild(BHEAD p[1],ARGTOARG,0);
1184  p += 2;
1185  }
1186  }
1187  newpat = pattern + pattern[1];
1188  if ( newpat >= AN.patstop ) {
1189  if ( AN.UseFindOnly == 0 ) {
1190  if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
1191  AT.WorkPointer = oldworkpointer;
1192  AT.pWorkPointer = oww;
1193  AN.UsedOtherFind = 1;
1194  return(1);
1195  }
1196  j = 0;
1197  }
1198  else {
1199  AT.WorkPointer = oldworkpointer;
1200  AT.pWorkPointer = oww;
1201  return(1);
1202  }
1203  }
1204  else j = ScanFunctions(BHEAD newpat,inter,par);
1205  if ( j ) {
1206  AT.WorkPointer = oldworkpointer;
1207  AT.pWorkPointer = oww;
1208  return(j); /* Full match. Return our success */
1209  }
1210  AN.RepFunNum -= 2;
1211  }
1212 
1213  /* No (deeper) match. -> reset wildcards and continue */
1214 
1215  if ( wc && nwstore > 0 ) {
1216  j = nwstore;
1217  m = AN.WildValue;
1218  t = thewildcards + ntwa; r = AT.WildMask;
1219  if ( j > 0 ) {
1220  do {
1221  *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
1222  } while ( --j > 0 );
1223  }
1224  C->numrhs = *t++;
1225  C->Pointer = C->Buffer + oldcpointer;
1226  }
1227  }
1228  }
1229  goto NoSuccess;
1230  }
1231 /*
1232  #] Case 1:
1233  #[ Case 2: One -ARGWILD. Fix its length.
1234 */
1235  if ( funnycount == 1 ) {
1236  funnycount = tcount - argcount; /* Number or arguments to be eaten */
1237  for ( k = 0; k <= type; k++ ) {
1238  if ( k == 0 ) {
1239  a = AT.pWorkSpace+oww; t = fun + FUNHEAD;
1240  while ( t < tstop ) { *a++ = t; NEXTARG(t); }
1241  }
1242  else {
1243  a = AT.pWorkSpace+oww+tcount; t = fun + FUNHEAD;
1244  while ( t < tstop ) { *--a = t; NEXTARG(t); }
1245  }
1246  for ( i = 0; i < tcount; i++ ) { /* The various cycles */
1247  p = pattern + FUNHEAD;
1248  a = AT.pWorkSpace+oww;
1249  wc = 0;
1250  for ( j = 0; j < tcount; j++, a++ ) { /* The arguments */
1251  t = *a;
1252  if ( *p == -ARGWILD ) {
1253  wc = 1;
1254  AN.argaddress = (WORD *)a;
1255  if ( CheckWild(BHEAD p[1],ARLTOARL,funnycount,(WORD *)a) ) break;
1256  AddWild(BHEAD p[1],ARLTOARL,funnycount);
1257  j += funnycount-1; a += funnycount-1;
1258  }
1259  else if ( MatchArgument(BHEAD t,p) == 0 ) break;
1260  NEXTARG(p);
1261  }
1262  if ( j >= tcount ) { /* Match! */
1263 
1264  /* Continue with other functions. Make sure of the funnies */
1265 
1266  AN.RepFunList[AN.RepFunNum++] = offset;
1267  AN.RepFunList[AN.RepFunNum++] = 0;
1268  newpat = pattern + pattern[1];
1269  if ( newpat >= AN.patstop ) {
1270  if ( AN.UseFindOnly == 0 ) {
1271  if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
1272  AT.WorkPointer = oldworkpointer;
1273  AT.pWorkPointer = oww;
1274  AN.UsedOtherFind = 1;
1275  return(1);
1276  }
1277  j = 0;
1278  }
1279  else {
1280  AT.WorkPointer = oldworkpointer;
1281  AT.pWorkPointer = oww;
1282  return(1);
1283  }
1284  }
1285  else j = ScanFunctions(BHEAD newpat,inter,par);
1286  if ( j ) {
1287  AT.WorkPointer = oldworkpointer;
1288  AT.pWorkPointer = oww;
1289  return(j); /* Full match. Return our success */
1290  }
1291  AN.RepFunNum -= 2;
1292  }
1293 
1294  /* No (deeper) match. -> reset wildcards and continue */
1295 
1296  if ( wc ) {
1297  j = nwstore;
1298  m = AN.WildValue;
1299  t = thewildcards + ntwa; r = AT.WildMask;
1300  if ( j > 0 ) {
1301  do {
1302  *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
1303  } while ( --j > 0 );
1304  }
1305  C->numrhs = *t++;
1306  C->Pointer = C->Buffer + oldcpointer;
1307  }
1308  a = AT.pWorkSpace+oww;
1309  t = *a;
1310  for ( j = 1; j < tcount; j++ ) { *a = a[1]; a++; }
1311  *a = t;
1312  }
1313  }
1314  goto NoSuccess;
1315  }
1316 /*
1317  #] Case 2:
1318  #[ Case 3: More than one -ARGWILD. Complicated.
1319 */
1320 
1321  sumeat = tcount - argcount; /* Total number to be eaten by Funnies */
1322 /*
1323  In the first funnycount elements of 'thewildcards' we arrange
1324  for the summing over the various possibilities.
1325  The renumbering table is in thewildcards[2*funnycount]
1326  The multiplicity table is in thewildcards[funnycount]
1327  The number of arguments for each is in thewildcards[]
1328 */
1329  p = pattern+FUNHEAD;
1330  for ( i = funnycount; i < ntwa; i++ ) thewildcards[i] = -1;
1331  multiplicity = thewildcards + funnycount;
1332  renum = multiplicity + funnycount;
1333  j = 0;
1334  while ( p < pstop ) {
1335  if ( *p != -ARGWILD ) { p++; continue; }
1336  p++;
1337  if ( renum[*p] < 0 ) {
1338  renum[*p] = j;
1339  multiplicity[j] = 1;
1340  j++;
1341  }
1342  else multiplicity[renum[*p]]++;
1343  p++;
1344  }
1345 /*
1346  Strategy: First 'declared' has a tendency to be smaller
1347 */
1348  for ( i = 1; i < AN.NumTotWildArgs; i++ ) {
1349  if ( renum[i] < 0 ) continue;
1350  for ( j = i+1; j <= AN.NumTotWildArgs; j++ ) {
1351  if ( renum[j] < 0 ) continue;
1352  if ( renum[i] < renum[j] ) continue;
1353  k = multiplicity[renum[i]];
1354  multiplicity[renum[i]] = multiplicity[renum[j]];
1355  multiplicity[renum[j]] = k;
1356  k = renum[i]; renum[i] = renum[j]; renum[j] = k;
1357  }
1358  }
1359  for ( i = 0; i < funnycount; i++ ) thewildcards[i] = 0;
1360  iraise = funnycount-1;
1361  for ( ;; ) {
1362  for ( i = 0, j = sumeat; i < iraise; i++ )
1363  j -= thewildcards[i]*multiplicity[i];
1364  if ( j < 0 || j % multiplicity[iraise] != 0 ) {
1365  if ( j > 0 ) {
1366  thewildcards[iraise-1]++;
1367  continue;
1368  }
1369  itop = iraise-1;
1370  while ( itop > 0 && j < 0 ) {
1371  j += thewildcards[itop]*multiplicity[itop];
1372  thewildcards[itop] = 0;
1373  itop--;
1374  }
1375  if ( itop <= 0 && j <= 0 ) break;
1376  thewildcards[itop]++;
1377  continue;
1378  }
1379  thewildcards[iraise] = j / multiplicity[iraise];
1380 
1381  for ( k = 0; k <= type; k++ ) {
1382  if ( k == 0 ) {
1383  a = AT.pWorkSpace+oww; t = fun + FUNHEAD;
1384  while ( t < tstop ) { *a++ = t; NEXTARG(t); }
1385  }
1386  else {
1387  a = AT.pWorkSpace+oww+tcount; t = fun + FUNHEAD;
1388  while ( t < tstop ) { *--a = t; NEXTARG(t); }
1389  }
1390  for ( i = 0; i < tcount; i++ ) { /* The various cycles */
1391  p = pattern + FUNHEAD;
1392  a = AT.pWorkSpace+oww;
1393  wc = 0;
1394  for ( j = 0; j < tcount; j++, a++ ) { /* The arguments */
1395  t = *a;
1396  if ( *p == -ARGWILD ) {
1397  wc = thewildcards[renum[p[1]]];
1398  AN.argaddress = (WORD *)a;
1399  if ( CheckWild(BHEAD p[1],ARLTOARL,wc,(WORD *)a) ) break;
1400  AddWild(BHEAD p[1],ARLTOARL,wc);
1401  j += wc-1; a += wc-1; wc = 1;
1402  }
1403  else if ( MatchArgument(BHEAD t,p) == 0 ) break;
1404  NEXTARG(p);
1405  }
1406  if ( j >= tcount ) { /* Match! */
1407 
1408  /* Continue with other functions. Make sure of the funnies */
1409 
1410  AN.RepFunList[AN.RepFunNum++] = offset;
1411  AN.RepFunList[AN.RepFunNum++] = 0;
1412  newpat = pattern + pattern[1];
1413  if ( newpat >= AN.patstop ) {
1414  if ( AN.UseFindOnly == 0 ) {
1415  if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
1416  AT.WorkPointer = oldworkpointer;
1417  AT.pWorkPointer = oww;
1418  AN.UsedOtherFind = 1;
1419  return(1);
1420  }
1421  j = 0;
1422  }
1423  else {
1424  AT.WorkPointer = oldworkpointer;
1425  AT.pWorkPointer = oww;
1426  return(1);
1427  }
1428  }
1429  else j = ScanFunctions(BHEAD newpat,inter,par);
1430  if ( j ) {
1431  AT.WorkPointer = oldworkpointer;
1432  AT.pWorkPointer = oww;
1433  return(j); /* Full match. Return our success */
1434  }
1435  AN.RepFunNum -= 2;
1436  }
1437 
1438  /* No (deeper) match. -> reset wildcards and continue */
1439 
1440  if ( wc ) {
1441  j = nwstore;
1442  m = AN.WildValue;
1443  t = thewildcards + ntwa; r = AT.WildMask;
1444  if ( j > 0 ) {
1445  do {
1446  *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
1447  } while ( --j > 0 );
1448  }
1449  C->numrhs = *t++;
1450  C->Pointer = C->Buffer + oldcpointer;
1451  }
1452  a = AT.pWorkSpace+oww;
1453  t = *a;
1454  for ( j = 1; j < tcount; j++ ) { *a = a[1]; a++; }
1455  *a = t;
1456  }
1457  }
1458  (thewildcards[iraise-1])++;
1459  }
1460 /*
1461  #] Case 3:
1462 */
1463 NoSuccess:
1464  if ( oldwilval > 0 ) {
1465 nomatch:;
1466  j = nwstore;
1467  m = AN.WildValue;
1468  t = lowlevel; r = AT.WildMask;
1469  if ( j > 0 ) {
1470  do {
1471  *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
1472  } while ( --j > 0 );
1473  }
1474  C->numrhs = *t++;
1475  C->Pointer = C->Buffer + oldcpointer;
1476  }
1477  AT.WorkPointer = oldworkpointer;
1478  AT.pWorkPointer = oww;
1479  return(0);
1480 }
1481 
1482 /*
1483  #] FunMatchCy :
1484  #[ FunMatchSy :
1485 
1486  Matching of (anti)symmetric functions.
1487  Like MatchE, but now for general functions.
1488 */
1489 
1490 int FunMatchSy(PHEAD WORD *pattern, WORD *fun, WORD *inter, WORD par)
1491 {
1492  GETBIDENTITY
1493  WORD *t, *tstop, *p, *pstop, *m, *r, *oldworkpointer = AT.WorkPointer;
1494  WORD **a, *thewildcards, oldwilval = 0;
1495  WORD newvalue, *lowlevel = 0, num, assig;
1496  WORD *cycles;
1497  LONG oww = AT.pWorkPointer, lhpars, lhfunnies;
1498  int argcount = 0, funnycount = 0, tcount = 0, signs = 0, signfun = 0, signo;
1499  int type = 0, pnum, i, j, k, nwstore, iraise, cou2;
1500  CBUF *C = cbuf+AT.ebufnum;
1501  int ntwa = 3*AN.NumTotWildArgs+1;
1502  LONG oldcpointer = C->Pointer - C->Buffer;
1503  WORD offset = fun-AN.terstart, *newpat;
1504 
1505  if ( (functions[fun[0]-FUNCTION].symmetric & ~REVERSEORDER) == RCYCLESYMMETRIC ) type = 1;
1506  pnum = pattern[0];
1507  nwstore = (AN.WildValue[-SUBEXPSIZE+1]-SUBEXPSIZE)/4;
1508  if ( pnum > FUNCTION + WILDOFFSET ) {
1509  pnum -= WILDOFFSET;
1510  if ( CheckWild(BHEAD pnum,FUNTOFUN,fun[0],&newvalue) ) return(0);
1511  oldwilval = 1;
1512  t = lowlevel = oldworkpointer;
1513  m = AN.WildValue;
1514  i = nwstore;
1515  r = AT.WildMask;
1516  if ( i > 0 ) {
1517  do {
1518  *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *r++;
1519  } while ( --i > 0 );
1520  }
1521  *t++ = C->numrhs;
1522  if ( t >= AT.WorkTop ) {
1523  MLOCK(ErrorMessageLock);
1524  MesWork();
1525  MUNLOCK(ErrorMessageLock);
1526  return(-1);
1527  }
1528  AT.WorkPointer = t;
1529  AddWild(BHEAD pnum,FUNTOFUN,newvalue);
1530  }
1531  if ( (functions[pnum-FUNCTION].symmetric & ~REVERSEORDER) == RCYCLESYMMETRIC ) type = 1;
1532 
1533  /* Try for a straight match. After all, both have been normalized */
1534 
1535  if ( fun[1] == pattern[1] ) {
1536  i = fun[1]-FUNHEAD; p = pattern+FUNHEAD; t = fun + FUNHEAD;
1537  while ( --i >= 0 ) { if ( *p++ != *t++ ) break; }
1538  if ( i < 0 ) goto quicky;
1539  }
1540 
1541  /* First we have to make an inventory. Are there -ARGWILD pointers? */
1542 
1543  p = pattern + FUNHEAD;
1544  pstop = pattern + pattern[1];
1545  while ( p < pstop ) {
1546  if ( *p == -ARGWILD ) { p += 2; funnycount++; }
1547  else { NEXTARG(p); argcount++; }
1548  }
1549  t = fun + FUNHEAD;
1550  tstop = fun + fun[1];
1551  while ( t < tstop ) { NEXTARG(t); tcount++; }
1552 
1553  if ( argcount > tcount ) return(0);
1554  if ( argcount < tcount && funnycount == 0 ) return(0);
1555  if ( argcount == 0 && tcount == 0 && funnycount == 0 ) {
1556 quicky:
1557  if ( AN.SignCheck && signs != AN.ExpectedSign ) goto NoSuccess;
1558  AN.RepFunList[AN.RepFunNum++] = offset;
1559  AN.RepFunList[AN.RepFunNum++] = signs;
1560  newpat = pattern + pattern[1];
1561  if ( newpat >= AN.patstop ) {
1562  if ( AN.UseFindOnly == 0 ) {
1563  if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
1564  AT.WorkPointer = oldworkpointer;
1565  AN.UsedOtherFind = 1;
1566  return(1);
1567  }
1568  j = 0;
1569  }
1570  else {
1571  AT.WorkPointer = oldworkpointer;
1572  return(1);
1573  }
1574  }
1575  else j = ScanFunctions(BHEAD newpat,inter,par);
1576  if ( j ) {
1577  AT.WorkPointer = oldworkpointer;
1578  return(j);
1579  }
1580  goto NoSuccess;
1581  }
1582 
1583  /* Store the wildcard assignments */
1584 
1585  WantAddPointers(tcount+argcount+funnycount);
1586  AT.pWorkPointer += tcount+argcount+funnycount;
1587  thewildcards = t = AT.WorkPointer;
1588  t += ntwa;
1589  if ( oldwilval ) lowlevel = oldworkpointer;
1590  else lowlevel = t;
1591  m = AN.WildValue;
1592  i = nwstore; assig = 0;
1593  if ( i > 0 ) {
1594  r = AT.WildMask;
1595  do {
1596  assig += *r;
1597  *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *m++; *t++ = *r++;
1598  } while ( --i > 0 );
1599  *t++ = C->numrhs;
1600  }
1601  if ( t >= AT.WorkTop ) {
1602  MLOCK(ErrorMessageLock);
1603  MesWork();
1604  MUNLOCK(ErrorMessageLock);
1605  return(-1);
1606  }
1607  AT.WorkPointer = t;
1608 
1609  /* Store pointers to the arguments */
1610 
1611  t = fun + FUNHEAD; a = AT.pWorkSpace+oww;
1612  while ( t < tstop ) { *a++ = t; NEXTARG(t) }
1613  lhpars = a-AT.pWorkSpace;
1614  t = pattern + FUNHEAD;
1615  while ( t < pstop ) {
1616  if ( *t != -ARGWILD ) *a++ = t;
1617  NEXTARG(t)
1618  }
1619  lhfunnies = a-AT.pWorkSpace;
1620  t = pattern + FUNHEAD; cou2 = 0;
1621  while ( t < pstop ) {
1622  cou2++;
1623  if ( *t == -ARGWILD ) {
1624  *a++ = t;
1625 /*
1626  signfun: last ?a: tcount-argcount: number of arguments in ?a (assume one ?a)
1627  argcount+funnycount-cou2: arguments after ?a.
1628  Together tells whether moving ?a to end of list is even or odd
1629 */
1630  signfun = ((argcount+funnycount-cou2)*(tcount-argcount)) & 1;
1631  }
1632  NEXTARG(t)
1633  }
1634  signs += signfun;
1635  if ( funnycount > 0 ) {
1636  if ( ( (functions[fun[0]-FUNCTION].symmetric & ~REVERSEORDER) == SYMMETRIC )
1637  || ( (functions[fun[0]-FUNCTION].symmetric & ~REVERSEORDER) == ANTISYMMETRIC )
1638  || ( (functions[pnum-FUNCTION].symmetric & ~REVERSEORDER) == SYMMETRIC )
1639  || ( (functions[pnum-FUNCTION].symmetric & ~REVERSEORDER) == ANTISYMMETRIC ) ) {
1640  AT.WorkPointer = oldworkpointer;
1641  AT.pWorkPointer = oww;
1642  MLOCK(ErrorMessageLock);
1643  MesPrint("Sorry: no argument field wildcards yet in (anti)symmetric functions");
1644  MUNLOCK(ErrorMessageLock);
1645  Terminate(-1);
1646  }
1647  }
1648 /*
1649  Sort the regular arguments by
1650  1: no wildcards, fast.
1651  2: wildcards that have been assigned.
1652  3: general arguments.
1653  4: wildcards without an assignment.
1654 */
1655  iraise = argcount;
1656  for ( i = 0; i < iraise; i++ ) {
1657  t = AT.pWorkSpace[i+lhpars];
1658  if ( *t > 0 ) { /* Category 3: general argument */
1659  continue;
1660  }
1661  else if ( *t <= -FUNCTION ) {
1662  if ( *t > -FUNCTION - WILDOFFSET ) goto cat1;
1663  type = FUNTOFUN; num = -*t - WILDOFFSET;
1664  }
1665  else if ( *t == -SYMBOL ) {
1666  if ( t[1] < 2*MAXPOWER ) goto cat1;
1667  type = SYMTOSYM; num = t[1] - 2*MAXPOWER;
1668  }
1669  else if ( *t == -INDEX ) {
1670  if ( t[1] < AM.OffsetIndex + WILDOFFSET ) goto cat1;
1671  type = INDTOIND; num = t[1] - WILDOFFSET;
1672  }
1673  else if ( *t == -VECTOR || *t == -MINVECTOR ) {
1674  if ( t[1] < AM.OffsetVector + WILDOFFSET ) goto cat1;
1675  type = VECTOVEC; num = t[1] - WILDOFFSET;
1676  }
1677  else goto cat1; /* Things like -SNUMBER etc. */
1678 /*
1679  Now we have a wildcard and have to see whether it was assigned
1680 */
1681  m = AN.WildValue;
1682  j = nwstore;
1683  r = AT.WildMask;
1684  while ( --j >= 0 ) {
1685  if ( m[2] == num && *r ) {
1686  if ( type == *m ) break;
1687  if ( type == SYMTOSYM ) {
1688  if ( *m == SYMTONUM || *m == SYMTOSUB ) break;
1689  }
1690  else if ( type == INDTOIND ) {
1691  if ( *m == INDTOSUB ) break;
1692  }
1693  else if ( type == VECTOVEC ) {
1694  if ( *m == VECTOMIN || *m == VECTOSUB ) break;
1695  }
1696  }
1697  m += 4; r++;
1698  }
1699  if ( j < 0 ) { /* Category 4: Wildcard that was not assigned */
1700  a = AT.pWorkSpace+lhpars;
1701  iraise--;
1702  if ( iraise != i ) signs++;
1703  m = a[iraise];
1704  a[iraise] = a[i];
1705  a[i] = m; i--;
1706  }
1707  else { /* Category 2: Wildcard that was assigned */
1708  for ( j = 0; j < tcount; j++ ) {
1709  if ( MatchArgument(BHEAD AT.pWorkSpace[oww+j],t) ) {
1710  k = nwstore;
1711  r = AT.WildMask;
1712  num = 0;
1713  while ( --k >= 0 ) num += *r++;
1714  if ( num == assig ) { /* no wildcards were changed */
1715  goto oneless;
1716  }
1717  break;
1718  }
1719  }
1720  if ( j >= tcount ) goto NoSuccess;
1721  j = nwstore;
1722  m = AN.WildValue;
1723  t = thewildcards + ntwa; r = AT.WildMask;
1724  if ( j > 0 ) {
1725  do { /* undo assignment */
1726  *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
1727  } while ( --j > 0 );
1728  }
1729  C->numrhs = *t++;
1730  }
1731  continue;
1732 cat1:
1733  for ( j = 0; j < tcount; j++ ) {
1734  m = AT.pWorkSpace[j+oww];
1735  if ( *t != *m ) continue;
1736  if ( *t < 0 ) {
1737  if ( *t <= -FUNCTION ) break;
1738  if ( t[1] == m[1] ) break;
1739  }
1740  else {
1741  k = *t; r = t;
1742  while ( --k >= 0 && *m++ == *r++ ) {}
1743  if ( k < 0 ) break;
1744  }
1745  }
1746  if ( j >= tcount ) goto NoSuccess; /* Even the fixed ones don't match */
1747 oneless:
1748  signs += j - i;
1749 /*
1750  The next statements replace the one that is commented out
1751 */
1752  tcount--;
1753  while ( j < tcount ) {
1754  AT.pWorkSpace[oww+j] = AT.pWorkSpace[oww+j+1]; j++;
1755  }
1756 /*
1757  AT.pWorkSpace[oww+j] = AT.pWorkSpace[oww+(--tcount)];
1758 */
1759  argcount--; j = i;
1760  while ( j < argcount ) {
1761  AT.pWorkSpace[lhpars+j] = AT.pWorkSpace[lhpars+j+1]; j++;
1762  }
1763  iraise--; i--;
1764  }
1765 /*
1766  Now we see whether there are any ARGWILD objects that have been
1767  assigned already. In that case the work simplifies considerably.
1768  Currently (12-nov-2001) only in (R)CYCLIC functions; hence we do not
1769  test the sign!
1770 */
1771  for ( i = 0; i < funnycount; i++ ) {
1772  k = AT.pWorkSpace[lhfunnies+i][1];
1773  m = AN.WildValue;
1774  j = nwstore;
1775  r = AT.WildMask;
1776  while ( --j >= 0 ) {
1777  if ( *m == ARGTOARG && m[2] == k ) break;
1778  m += 4; r++;
1779  }
1780  if ( *r == 0 ) continue; /* not assigned yet */
1781  m = cbuf[AT.ebufnum].rhs[m[3]];
1782  if ( *m > 0 ) { /* Tensor arguments */
1783  j = *m;
1784  if ( j > tcount - argcount ) goto NoSuccess;
1785  while ( --j >= 0 ) {
1786  m++;
1787  if ( *m < 0 ) type = -VECTOR;
1788  else if ( *m < AM.OffsetIndex ) type = -SNUMBER;
1789  else type = -INDEX;
1790  a = AT.pWorkSpace+oww;
1791  for ( k = 0; k < tcount; k++ ) {
1792  if ( a[k][0] != type || a[k][1] != *m ) continue;
1793  a[k] = a[--tcount];
1794  goto nextjarg;
1795  }
1796  goto NoSuccess;
1797 nextjarg:;
1798  }
1799  }
1800  else {
1801  m++;
1802  while ( *m ) {
1803  for ( k = 0; k < tcount; k++ ) {
1804  t = AT.pWorkSpace[oww+k];
1805  if ( *t != *m ) continue;
1806  r = m;
1807  if ( *r < 0 ) {
1808  if ( *r < -FUNCTION ) goto nextargw;
1809  else if ( r[1] == t[1] ) goto nextargw;
1810  }
1811  else {
1812  j = *r;
1813  while ( --j >= 0 && *r++ == *t++ ) {}
1814  if ( j < 0 ) goto nextargw;
1815  }
1816  }
1817  goto NoSuccess;
1818 nextargw:;
1819  AT.pWorkSpace[oww+k] = AT.pWorkSpace[oww+(--tcount)];
1820  NEXTARG(m)
1821  }
1822  }
1823  AT.pWorkSpace[lhfunnies+i] = AT.pWorkSpace[lhfunnies+(--funnycount)];
1824  }
1825  if ( tcount == 0 ) {
1826  if ( argcount > 0 ) goto NoSuccess;
1827  for ( i = 0; i < funnycount; i++ ) {
1828  AddWild(BHEAD AT.pWorkSpace[lhfunnies+i][1],ARGTOARG,0);
1829  }
1830  goto quicky;
1831  }
1832 /*
1833  We have now in lhpars first iraise elements with a dubious nature.
1834  Then argcount-iraise wildcards that have not been assigned.
1835  In lhfunnies we have funnycount ARGTOARG objects. ( (R)CyCLIC only )
1836 
1837  First work our way through the 'dubious' objects
1838  We check whether assig changes.
1839 */
1840  for ( i = 0; i < iraise; i++ ) {
1841  for ( j = 0; j < tcount; j++ ) {
1842  if ( MatchArgument(BHEAD AT.pWorkSpace[oww+j],AT.pWorkSpace[lhpars+i]) ) {
1843  k = nwstore;
1844  r = AT.WildMask;
1845  num = 0;
1846  while ( --k >= 0 ) num += *r++;
1847  if ( num == assig ) { /* no wildcards were changed */
1848  signs += j-i;
1849  AT.pWorkSpace[oww+j] = AT.pWorkSpace[oww+(--tcount)];
1850  if ( tcount > j ) signs += tcount-j-1;
1851  argcount--;
1852  a = AT.pWorkSpace + lhpars;
1853  for ( j = i; j < argcount; j++ ) a[j] = a[j+1];
1854  iraise--;
1855  goto nextiraise;
1856  }
1857  else { /* We cannot use this yet */
1858  j = nwstore;
1859  m = AN.WildValue;
1860  t = thewildcards + ntwa; r = AT.WildMask;
1861  if ( j > 0 ) {
1862  do { /* undo assignment */
1863  *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
1864  } while ( --j > 0 );
1865  }
1866  C->numrhs = *t++;
1867  C->Pointer = C->Buffer + oldcpointer;
1868  goto nextiraise;
1869  }
1870  }
1871  }
1872  goto NoSuccess;
1873 nextiraise:;
1874  }
1875 /*
1876  Now all leftover patterns have unassigned wildcards in them.
1877  From now on we are in potential factorial territory.
1878 
1879  Strategy:
1880  1: cycle through the regular objects.
1881  2: save wildcard settings
1882  3: divide the ARGWILDs
1883  4: make permutations of leftover arguments
1884  5: try them all
1885 */
1886  cycles = AT.WorkPointer;
1887  for ( i = 0; i < tcount; i++ ) cycles[i] = tcount-i;
1888  AT.WorkPointer += tcount;
1889  signo = 0;
1890 /*MesPrint("<1> signs = %d",signs);*/
1891  for (;;) {
1892  WORD oRepFunNum = AN.RepFunNum;
1893  for ( j = 0; j < argcount; j++ ) {
1894  if ( MatchArgument(BHEAD AT.pWorkSpace[oww+j],AT.pWorkSpace[lhpars+j]) == 0 ) {
1895  break;
1896  }
1897  }
1898  if ( j >= argcount ) {
1899 /*
1900  Thus far we have a match. Now the funnies
1901 */
1902  if ( funnycount ) {
1903  AT.WorkPointer = oldworkpointer;
1904  AT.pWorkPointer = oww;
1905  MLOCK(ErrorMessageLock);
1906  MesPrint("Sorry: no argument field wildcards yet in (anti)symmetric functions");
1907  MUNLOCK(ErrorMessageLock);
1908 /*
1909  Bugfix 31-oct-2001, reported by Kasper Peeters
1910  We returned here with value -1 but that is not caught.
1911  Extra note (12-nov-2001): the sign becomes a bit problematic
1912  if we have funnies. No more than one allowed in antisymmetric
1913  functions, or we have serious problems.
1914 */
1915  Terminate(-1);
1916  }
1917 
1918  AN.RepFunList[AN.RepFunNum++] = offset;
1919  if ( ( (functions[fun[0]-FUNCTION].symmetric & ~REVERSEORDER) == ANTISYMMETRIC )
1920  || ( (functions[pnum-FUNCTION].symmetric & ~REVERSEORDER) == ANTISYMMETRIC ) ) {
1921  AN.RepFunList[AN.RepFunNum++] = ( signs + signo ) & 1;
1922  }
1923  else {
1924  AN.RepFunList[AN.RepFunNum++] = 0;
1925  }
1926  newpat = pattern + pattern[1];
1927  if ( newpat >= AN.patstop ) {
1928  WORD countsgn, sgn = 0;
1929  for ( countsgn = oRepFunNum+1; countsgn < AN.RepFunNum; countsgn += 2 ) {
1930  if ( AN.RepFunList[countsgn] ) sgn ^= 1;
1931  }
1932  if ( AN.SignCheck == 0 || sgn == AN.ExpectedSign ) {
1933  AT.WorkPointer = oldworkpointer;
1934  AT.pWorkPointer = oww;
1935  return(1);
1936  }
1937  if ( AN.UseFindOnly == 0 ) {
1938  if ( FindOnce(BHEAD AN.findTerm,AN.findPattern) ) {
1939  AT.WorkPointer = oldworkpointer;
1940  AT.pWorkPointer = oww;
1941  AN.UsedOtherFind = 1;
1942  return(1);
1943  }
1944  }
1945  j = 0;
1946  }
1947  else j = ScanFunctions(BHEAD newpat,inter,par);
1948  if ( j ) {
1949  WORD countsgn, sgn = 0;
1950  for ( countsgn = oRepFunNum+1; countsgn < AN.RepFunNum; countsgn += 2 ) {
1951  if ( AN.RepFunList[countsgn] ) sgn ^= 1;
1952  }
1953  if ( AN.SignCheck == 0 || sgn == AN.ExpectedSign ) {
1954  AT.WorkPointer = oldworkpointer;
1955  AT.pWorkPointer = oww;
1956  return(j);
1957  }
1958  }
1959  AN.RepFunNum = oRepFunNum;
1960  i = argcount - 1;
1961  }
1962  else i = j;
1963  j = nwstore;
1964  m = AN.WildValue;
1965  t = thewildcards + ntwa; r = AT.WildMask;
1966  if ( j > 0 ) {
1967  do {
1968  *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
1969  } while ( --j > 0 );
1970  }
1971  C->numrhs = *t++;
1972  C->Pointer = C->Buffer + oldcpointer;
1973 /*
1974  On to the next cycle
1975 */
1976  a = AT.pWorkSpace + oww;
1977  for ( j = i+1, t = a[i]; j < tcount; j++ ) a[j-1] = a[j];
1978  a[tcount-1] = t; cycles[i]--;
1979  signo += tcount - i - 1;
1980  while ( cycles[i] <= 0 ) {
1981  cycles[i] = tcount - i;
1982  i--;
1983  if ( i < 0 ) goto NoSuccess;
1984 /*
1985  MLOCK(ErrorMessageLock);
1986  MesPrint("Cycle i = %d",i);
1987  MUNLOCK(ErrorMessageLock);
1988 */
1989  for ( j = i+1, t = a[i]; j < tcount; j++ ) a[j-1] = a[j];
1990  a[tcount-1] = t; cycles[i]--;
1991  signo += tcount - i - 1;
1992  }
1993  }
1994 NoSuccess:
1995  if ( oldwilval > 0 ) {
1996  j = nwstore;
1997  m = AN.WildValue;
1998  t = lowlevel; r = AT.WildMask;
1999  if ( j > 0 ) {
2000  do {
2001  *m++ = *t++; *m++ = *t++; *m++ = *t++; *m++ = *t++; *r++ = *t++;
2002  } while ( --j > 0 );
2003  }
2004  C->numrhs = *t++;
2005  C->Pointer = C->Buffer + oldcpointer;
2006  }
2007  AT.WorkPointer = oldworkpointer;
2008  AT.pWorkPointer = oww;
2009  return(0);
2010 }
2011 
2012 /*
2013  #] FunMatchSy :
2014  #[ MatchArgument :
2015 */
2016 
2017 int MatchArgument(PHEAD WORD *arg, WORD *pat)
2018 {
2019  GETBIDENTITY
2020  WORD *m = pat, *t = arg, i, j, newvalue;
2021  WORD *argmstop = pat, *argtstop = arg;
2022  WORD *cto, *cfrom, *csav, ci;
2023  WORD oRepFunNum, *oRepFunList;
2024  WORD *oterstart,*oterstop,*opatstop;
2025  WORD wildargs, wildeat;
2026  WORD *mtrmstop, *ttrmstop, *msubstop, msizcoef;
2027  WORD *wildargtaken;
2028  int wc = 1;
2029 
2030  NEXTARG(argmstop);
2031  NEXTARG(argtstop);
2032 /*
2033  #[ Both fast :
2034 */
2035  if ( *m < 0 && *t < 0 ) {
2036  if ( *t <= -FUNCTION ) {
2037  if ( *t == *m ) {}
2038  else if ( *m <= -FUNCTION-WILDOFFSET
2039  && functions[-*t-FUNCTION].spec
2040  == functions[-*m-FUNCTION-WILDOFFSET].spec ) {
2041  i = -*m - WILDOFFSET; wc = 2;
2042  if ( CheckWild(BHEAD i,FUNTOFUN,-*t,&newvalue) ) {
2043  return(0);
2044  }
2045  AddWild(BHEAD i,FUNTOFUN,newvalue);
2046  }
2047  else if ( *m == -SYMBOL && m[1] >= 2*MAXPOWER ) {
2048  i = m[1] - 2*MAXPOWER;
2049  AN.argaddress = AT.FunArg;
2050  AT.FunArg[ARGHEAD+1] = -*t;
2051  if ( CheckWild(BHEAD i,SYMTOSUB,1,AN.argaddress) ) return(0);
2052  AddWild(BHEAD i,SYMTOSUB,0);
2053  }
2054  else return(0);
2055  }
2056  else if ( *t == *m ) {
2057  if ( t[1] == m[1] ) {}
2058  else if ( *t == -SYMBOL ) {
2059  j = SYMTOSYM;
2060 SymAll: if ( ( i = m[1] - 2*MAXPOWER ) < 0 ) return(0);
2061  wc = 2;
2062  if ( CheckWild(BHEAD i,j,t[1],&newvalue) ) return(0);
2063  AddWild(BHEAD i,j,newvalue);
2064  }
2065  else if ( *t == -INDEX ) {
2066 IndAll: i = m[1] - WILDOFFSET;
2067  if ( i < AM.OffsetIndex || i >= WILDOFFSET+AM.OffsetIndex )
2068  return(0);
2069  /* We kill the summed over indices here */
2070  wc = 2;
2071  if ( CheckWild(BHEAD i,INDTOIND,t[1],&newvalue) ) return(0);
2072  AddWild(BHEAD i,INDTOIND,newvalue);
2073  }
2074  else if ( *t == -VECTOR || *t == -MINVECTOR ) {
2075  i = m[1] - WILDOFFSET;
2076  if ( i < AM.OffsetVector ) return(0);
2077  wc = 2;
2078  if ( CheckWild(BHEAD i,VECTOVEC,t[1],&newvalue) ) return(0);
2079  AddWild(BHEAD i,VECTOVEC,newvalue);
2080  }
2081  else return(0);
2082  }
2083  else if ( *m == -INDEX && m[1] >= AM.OffsetIndex+WILDOFFSET
2084  && m[1] < AM.OffsetIndex+(WILDOFFSET<<1) ) {
2085  if ( *t == -VECTOR || *t == -SNUMBER ) goto IndAll;
2086  if ( *t == -MINVECTOR ) {
2087  i = m[1] - WILDOFFSET;
2088  AN.argaddress = AT.MinVecArg;
2089  AT.MinVecArg[ARGHEAD+3] = t[1];
2090  wc = 2;
2091  if ( CheckWild(BHEAD i,INDTOSUB,1,AN.argaddress) ) return(0);
2092  AddWild(BHEAD i,INDTOSUB,(WORD)0);
2093  }
2094  else return(0);
2095  }
2096  else if ( *m == -SYMBOL && m[1] >= 2*MAXPOWER && *t == -SNUMBER ) {
2097  j = SYMTONUM;
2098  goto SymAll;
2099  }
2100  else if ( *m == -VECTOR && *t == -MINVECTOR &&
2101  ( i = m[1] - WILDOFFSET ) >= AM.OffsetVector ) {
2102  AN.argaddress = AT.MinVecArg;
2103  AT.MinVecArg[ARGHEAD+3] = t[1];
2104  wc = 2;
2105  if ( CheckWild(BHEAD i,VECTOSUB,1,AN.argaddress) ) return(0);
2106  AddWild(BHEAD i,VECTOSUB,(WORD)0);
2107  }
2108  else return(0);
2109  }
2110 /*
2111  #] Both fast :
2112  #[ Fast arg :
2113 */
2114  else if ( *m > 0 && *t <= -FUNCTION ) {
2115  if ( ( m[ARGHEAD]+ARGHEAD == *m ) && m[*m-1] == 3
2116  && m[*m-2] == 1 && m[*m-3] == 1 && m[ARGHEAD+1] >= FUNCTION
2117  && m[ARGHEAD+2] == *m-ARGHEAD-4 ) { /* Check for f(?a) etc */
2118  WORD *mmmst, *mmm, mmmi;
2119  if ( m[ARGHEAD+1] >= FUNCTION+WILDOFFSET ) {
2120  mmmi = *m - WILDOFFSET;
2121  wc = 2;
2122  if ( CheckWild(BHEAD mmmi,FUNTOFUN,-*t,&newvalue) ) return(0);
2123  AddWild(BHEAD mmmi,FUNTOFUN,newvalue);
2124  }
2125  else if ( m[ARGHEAD+1] != -*t ) return(0);
2126 /*
2127  Only arguments allowed are ?a etc.
2128 */
2129  mmmst = m+*m-3;
2130  mmm = m + ARGHEAD + FUNHEAD + 1;
2131  while ( mmm < mmmst ) {
2132  if ( *mmm != -ARGWILD ) return(0);
2133  mmmi = 0;
2134  AN.argaddress = t; wc = 2;
2135  if ( CheckWild(BHEAD mmm[1],ARGTOARG,mmmi,t) ) return(0);
2136  AddWild(BHEAD mmm[1],ARGTOARG,mmmi);
2137  mmm += 2;
2138  }
2139  }
2140  else return(0);
2141  }
2142 /*
2143  #] Fast arg :
2144  #[ Fast pat :
2145 */
2146  else if ( *m < 0 && *t > 0 ) {
2147  if ( *m == -SYMBOL ) { /* SYMTOSUB */
2148  if ( m[1] < 2*MAXPOWER ) return(0);
2149  i = m[1] - 2*MAXPOWER;
2150  AN.argaddress = t; wc = 2;
2151  if ( CheckWild(BHEAD i,SYMTOSUB,1,AN.argaddress) ) return(0);
2152  AddWild(BHEAD i,SYMTOSUB,0);
2153  }
2154  else if ( *m == -VECTOR ) {
2155  if ( ( i = m[1] - WILDOFFSET ) < AM.OffsetVector ) return(0);
2156  AN.argaddress = t; wc = 2;
2157  if ( CheckWild(BHEAD i,VECTOSUB,1,t) ) return(0);
2158  AddWild(BHEAD i,VECTOSUB,(WORD)0);
2159  }
2160  else if ( *m == -INDEX ) {
2161  if ( ( i = m[1] - WILDOFFSET ) < AM.OffsetIndex ) return(0);
2162  if ( i >= AM.OffsetIndex + WILDOFFSET ) return(0);
2163  AN.argaddress = t; wc = 2;
2164  if ( CheckWild(BHEAD i,INDTOSUB,1,AN.argaddress) ) return(0);
2165  AddWild(BHEAD i,INDTOSUB,(WORD)0);
2166  }
2167  else return(0);
2168  }
2169 /*
2170  #] Fast pat :
2171  #[ Both general :
2172 */
2173  else if ( *m > 0 && *t > 0 ) {
2174  i = *m;
2175  do { if ( *m++ != *t++ ) break; } while ( --i > 0 );
2176  if ( i > 0 ) {
2177 /*
2178  Not an exact match here.
2179  We have to hope that the pattern contains a composite wildcard.
2180 */
2181  m = pat; t = arg;
2182  m += ARGHEAD; t += ARGHEAD; /* Point at (first?) term */
2183  mtrmstop = m + *m;
2184  ttrmstop = t + *t;
2185  if ( mtrmstop < argmstop ) return(0);/* More than one term */
2186  msizcoef = mtrmstop[-1];
2187  if ( msizcoef < 0 ) msizcoef = -msizcoef;
2188  msubstop = mtrmstop - msizcoef;
2189  m++;
2190  if ( m >= msubstop ) return(0); /* Only coefficient */
2191 /*
2192  Here we have a composite term. It can match provided it
2193  matches the entire argument. This argument must be a
2194  single term also and the coefficients should match
2195  (more or less).
2196  The matching takes:
2197  1: Match the functions etc. Nothing can be left.
2198  2: Match dotproducts and symbols. ONLY must match
2199  and nothing may be left.
2200  For safety it is best to take the term out and put it
2201  in workspace.
2202 */
2203  if ( argtstop > ttrmstop ) return(0);
2204  m--;
2205 
2206  oterstart = AN.terstart;
2207  oterstop = AN.terstop;
2208  opatstop = AN.patstop;
2209  oRepFunList = AN.RepFunList;
2210  oRepFunNum = AN.RepFunNum;
2211  AN.RepFunNum = 0;
2212  wildargtaken = AT.WorkPointer;
2213  AN.RepFunList = wildargtaken + AN.NumTotWildArgs;
2214  AT.WorkPointer = (WORD *)(((UBYTE *)(AN.RepFunList)) + AM.MaxTer/2);
2215  csav = cto = AT.WorkPointer;
2216  cfrom = t;
2217  ci = *t;
2218  while ( --ci >= 0 ) *cto++ = *cfrom++;
2219  AT.WorkPointer = cto;
2220  ci = msizcoef;
2221  cfrom = mtrmstop;
2222  while ( --ci >= 0 ) {
2223  if ( *--cfrom != *--cto ) {
2224  AT.WorkPointer = wildargtaken;
2225  AN.RepFunList = oRepFunList;
2226  AN.RepFunNum = oRepFunNum;
2227  AN.terstart = oterstart;
2228  AN.terstop = oterstop;
2229  AN.patstop = opatstop;
2230  return(0);
2231  }
2232  }
2233  *m -= msizcoef;
2234  wildargs = AN.WildArgs;
2235  wildeat = AN.WildEat;
2236  for ( i = 0; i < wildargs; i++ ) wildargtaken[i] = AT.WildArgTaken[i];
2237  AN.ForFindOnly = 0; AN.UseFindOnly = 1;
2238  AN.nogroundlevel++;
2239  if ( FindRest(BHEAD csav,m) && ( AN.UsedOtherFind || FindOnly(BHEAD csav,m) ) ) { }
2240  else {
2241  *m += msizcoef;
2242  AT.WorkPointer = wildargtaken;
2243  AN.RepFunList = oRepFunList;
2244  AN.RepFunNum = oRepFunNum;
2245  AN.terstart = oterstart;
2246  AN.terstop = oterstop;
2247  AN.patstop = opatstop;
2248  AN.WildArgs = wildargs;
2249  AN.WildEat = wildeat;
2250  AN.nogroundlevel--;
2251  for ( i = 0; i < wildargs; i++ ) AT.WildArgTaken[i] = wildargtaken[i];
2252  return(0);
2253  }
2254  AN.nogroundlevel--;
2255  AN.WildArgs = wildargs;
2256  AN.WildEat = wildeat;
2257  for ( i = 0; i < wildargs; i++ ) AT.WildArgTaken[i] = wildargtaken[i];
2258  Substitute(BHEAD csav,m,1);
2259  cto = csav;
2260  cfrom = cto + *cto - msizcoef;
2261  cto++;
2262  *m += msizcoef;
2263  AT.WorkPointer = wildargtaken;
2264  AN.RepFunList = oRepFunList;
2265  AN.RepFunNum = oRepFunNum;
2266  AN.terstart = oterstart;
2267  AN.terstop = oterstop;
2268  AN.patstop = opatstop;
2269  if ( *cto != SUBEXPRESSION ) return(0);
2270  cto += cto[1];
2271  if ( cto < cfrom ) return(0);
2272  }
2273  }
2274 /*
2275  #] Both general :
2276 */
2277  else return(0);
2278 /*
2279  And now the success: (wc = 2 means that there was a wildcard involved)
2280 */
2281  return(wc);
2282 }
2283 
2284 /*
2285  #] MatchArgument :
2286 */
#define PHEAD
Definition: ftypes.h:56
Definition: structs.h:908
WORD * Pointer
Definition: structs.h:911
WORD * Buffer
Definition: structs.h:909