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  modified
9.8.11  cast result of strlen to int  for 64-bit compilation without warnings
*/


#include <string.h>
#include <assert.h>
#include <math.h>   /* fabs */

#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);
/*________________________________________________________________________*/
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_term))
     { *rest = pattern+2;
       *newflag = flag;
       return 0;
     }
  if(c == 227 && equals(t,pi_term))
     { *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)==ABSFUNCTOR)
      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 = (int) 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 */
}