Sindbad~EG File Manager

/* M. Beeson, for Mathpert.
matchstring shortens the coding of some operations by making
terms that match given patterns, without using up memory if
the attempt fails.

3.8.92 file created
1.29.98 last modified
*/


#include <string.h>
#include <assert.h>
#include <math.h>   /* fabs */
#define POLYVAL_DLL
#include "globals.h"
#include "match.h"
#include "dispfunc.h"  /* functor_string */

static int matchstring_aux(term t, term x, term *a, int flag, int permutationflag, char *pattern, int *newflag, char **rest);
/*________________________________________________________________________*/
MEXPORT_POLYVAL int matchstring(term t, term x, char *pattern, term *a)
/* pattern lists functors or atoms or numbers to be matched.  Numbers
can be up to four. For example if pattern = "sqrt(+(x,a))" we will get
success (return 0)  if t has the form sqrt(x+A), and *a will be
instantiated to A.  This function accomplishes without allocating
memory what could be done with 'match' if we first created a term
involving 'var0' etc. from pattern and then called match. The
pattern must literally use 'x' and either 'a' or 'b' (but not both) . */
/* spaces not allowed in pattern */
/* arity of + or * must be 2 */

{ int err;
  char *rest;
  int flag;
  err = matchstring_aux(t,x,a,0,0,pattern,&flag,&rest);
  if(err || rest[0] != '\0')
     return 1;
  return 0;
}
/*____________________________________________________________________*/
static int matchstring_aux(term t, term x, term *a, int flag, int permutationflag, char *pattern, int *newflag, char **rest)
/*  Tell whether t matches an initial segment of pattern.
Flag tells whether *a  is free (flag == 0) or
already instantiated (flag ==1).  **rest is the unprocessed part of
pattern. Newflag tells whether *a got instantiated during the match.
Permutationflag is nonzero if this is not the first order of args tried;
so if it's nonzero we don't try again with permuted args.
  In patterns involving "arc" or "bin", it  will assume the a and b are not
variables but part of "arctan" etc. or "binomial".
*/

{ term u;
  char *next, *marker;
  char fstring[16];
  int err,k;
  unsigned char c = pattern[0];
  next = marker = pattern;  /* avoid error messages */
  if(c == '\0')
     return 1;
  if(c == 'x')
     { if(equals(t,x))
          { *rest = pattern + 1;
            *newflag = flag;
            return 0;
          }
       return 1;
     }
  if(
     (c == 'a' && !(pattern[1] == 'r' && pattern[2] == 'c'))
      ||
     (c == 'b' && !(pattern[1] == 'i' && pattern[2] == 'n'))
         /* don't match variables to "arccos" or "binomial"  */
    )
     { if(flag == 1)  /* a is already instantiated */
           { if(equals(t, *a))
                { *rest = pattern + 1;
                  *newflag = flag;
                  return 0;
                }
             else
                return 1;
           }
       else  /* a isn't instantiated yet */
           { *a = t;
             *rest = pattern +1;
             *newflag = 1;
             return 0;
           }
     }
  if(c == '1')
     { if(ISONE(t))  /* accepts doubles near 1.0 also */
           { *rest = pattern + 1;
             *newflag = flag;
             return 0;
           }
       return 1;
     }
  if ('2' <= c && c <= '9')
     { term u = c == '2' ? two :
                c == '3' ? three :
                c == '4' ? four :
                c == '5' ? five :
                c == '6' ? six :
                c == '7' ? seven :
                c == '8' ? eight :
                nine;
       if(equals(t,u))
           { *rest = pattern+1;
             *newflag = flag;
             return 0;
           }
       return 1;
     }
  if(c == 'e' && equals(t, eulere))
     { *rest = pattern+1;
       *newflag = flag;
       return 0;
     }
  if(c == 'p' && pattern[1] == 'i' && equals(t,pi))
     { *rest = pattern+2;
       *newflag = flag;
       return 0;
     }
  if(c == 227 && equals(t,pi))
     { *rest = pattern+1;
       *newflag = flag;
       return 0;
     }
  if(c == 'i' && equals(t,complexi))
     { *rest = pattern+1;
       *newflag = flag;
       return 0;
     }
  if(ATOMIC(t))
     return 1;
  /*  Now c must be a function symbol */
  if(FUNCTOR(t)==ABS)
      strcpy(fstring,"abs");
  else if (FUNCTOR(t) == SQRT)
      strcpy(fstring,"sqrt");
  else if (FUNCTOR(t) == ROOT)
      strcpy(fstring,"root");
  else
      functor_string(FUNCTOR(t),SCREEN,fstring);
  if(strstr(pattern,fstring)!= pattern)
      return 1; /* functors don't match */
  u = ARG(0,t);
  k = strlen(fstring);
  if(pattern[k] == 'h')
     return 1;   /* pattern can be "cosh" while functor is COS */
  assert(pattern[k] == '(');
  err = matchstring_aux(u,x,a,flag,permutationflag,pattern+k+1,&flag,&next);  /* skip '('  */
  if(err && FUNCTOR(t) != '+' && FUNCTOR(t) != '*')
      return 1;
  if(ARITY(t) == 1)
     { if(next[0] == ')')
           { *newflag = flag;
             *rest = next + 1;  /* pass the close paren */
             return 0;
           }
       else return 1;
     }
  if(ARITY(t) != 2)
      return 1;  /* function doesn't handle larger arities */
  if(!err)  /* first arg matched ok */
     {  if(*next != ',')
           return 1;
        marker = next+1;
        err = matchstring_aux(ARG(1,t),x,a,flag,permutationflag,marker,&flag,&next);
        if(err)
            return 1;
        if(*next != ')')
            return 1;  /* wrong arity */
        *newflag = flag;
        *rest = next + 1;  /* pass the close paren */
        return 0;
     }
  /* Now first arg didn't match */
  if( !permutationflag &&    /* see if we already tried the other order */
      (FUNCTOR(t) == '+' || FUNCTOR(t) == '*')
    )      /* then try the other order of args */
     {  u = make_term(FUNCTOR(t),2);
        ARGREP(u,0,ARG(1,t));
        ARGREP(u,1,ARG(0,t));
        err = matchstring_aux(u,x,a,flag,1,pattern,&flag,rest);
        RELEASE(u);
        return err;
     }
  return 1;  /* final failure */
}