Sindbad~EG File Manager

/* Unification and matching code sufficient for MATHPERT */
/* See general remarks below */
/*
1.31.91 original date
1.29.98 last modified
*/
/*_________________________________________________________________*/
/* General remark:  rules whose left side is a sum, such as
sin^2 a + cos^2 a = 1, must work when the two terms are in any
order, when they are two summands of a sum with more than two
summands, and even when they are summands multiplied by the same
factor such as   3sin^2 a + 3cos^2 a, or both with minus signs as in
17 - sin^2 a - cos^2 a. */
/*__________________________________________________________________*/
#include <string.h>
#include <assert.h>
#include <string.h>   /* memset */
#include "globals.h"
#include "prover.h"
#include "match.h"
#include "cancel.h"
/*__________________________________________________________________*/
#define NVARS  16
static term metavariables[NVARS];

static void init_metavariables(void)
{ unsigned short i;
  for(i=0;i<NVARS;i++)
     { metavariables[i] = MAKE_ATOM(VAR);
       SET_METASUBSCRIPT(metavariables[i],i);
     }
}

/*__________________________________________________________________*/
int unify1(term p, term u, term *a, int *flag)
/* p may contain (meta) variables.  u does not.
   match the pattern p to term u, instantiating metavariables[i] to
   a[i];  space for a[NVARS] is presumed to already exist. Write the
   instantiated term to a[i] if flag[i] is 0.  (Similarly, flag[i]
   is presumed allocated already.)
   If flag[i] is 1, it means a[i] is already instantiated,
   so fail if metavariables[i] must be matched to a value different from the one
   a[i] already holds.  If metavariables[i] is instantiated at this step,
   flag[i] is changed to 1.
   Return 0 for success, 1 for failure.
   In case of failure, *a is not instantiated.
       Unlike in Robinson-style unification, we make 2A unify with 4x
   yielding A=2x.  This is needed to make double-angle formulae work right.
*/
{ int err;
  unsigned short i,n;
  term v, cancelled;
  if(METAVARIABLE(p))
      { i = (unsigned short) METASUBSCRIPT(p);  /* index of p in metavariables array */
        if(! flag[i])
           { a[i] = u;
             flag[i] = 1;
             return 0;
           }
        else
           return (equals(a[i],u) ? 0 : 1);
      }
  if(ATOMIC(p))
       return ( equals(p,u) ? 0 : 1 );
  if(FUNCTOR(p) != FUNCTOR(u))
     return 1;
  if(ARITY(p) != ARITY(u))
     return 1;
  n = ARITY(p);
  if(FUNCTOR(p) == '*' && ISINTEGER(ARG(0,p)) && ARITY(p)==2 && FUNCTOR(u) == '*')
     { /* example: p = 2A, u = 4x */
       if(ARITY(u) == 2 && equals(ARG(0,p),ARG(0,u)))
          return unify1(ARG(1,p),ARG(1,u),a,flag);
       err = cancel(u,ARG(0,p),&cancelled,&v);  /* v = 2x, cancelled = 2 */
       if(!err)
          return unify1(ARG(1,p),v,a,flag);
       return 1; /* cancel failed, no hope */
     }
  for(i=0;i<n;i++)
     { err = unify1(ARG(i,p),ARG(i,u),a,flag);
       if(err)
          return 1;
     }
  return 0;
}

/*__________________________________________________________________*/
int match(term t, term lhs, term rhs, term *a, term *ans)
/* lhs and rhs represent a rewrite rule containing metavariables in
the 'metavariables' array.
Term t should be a sum or product; lhs should also be
a sum or product (whichever t is).
the arity of lhs must be exactly 2, and rhs must NOT have the same
functor as t. (That is, you can't have rules that rewrite a sum as a sum
or a product as a product.)

The function tries to match lhs to the summands of t, instantiating
metavariables[i] to a[i].  If it succeeds, it makes a new sum *ans
with rhs at the location of the first term match to lhs.  The space
pointed to by a must be such that a[i] is valid space whenever
metavariables[i] is contained in lhs.

It returns 0 for success, 1 for failure.
*/

{ int i,j,k,sign1=1,sign2=1,newsign,err,l1,l2;
  int flag[NVARS];
  unsigned short n;
  unsigned short f = FUNCTOR(t);
  term p,q;   /* lhs = p+q */
  term u,temp,temp2;
  if(f != '+' && f != '*')
     return 1;
  if(FUNCTOR(lhs) != f)
     return 1;
  if(ARITY(lhs) != 2)
     return 1;
  memset(flag,0,NVARS *sizeof(int));
  if(!FUNCTOR(metavariables[0]))
     init_metavariables();
  p = ARG(0,lhs);
  q = ARG(1,lhs);
  if(NEGATIVE(p))
     { p = ARG(0,p);
       sign1 = -1;
     }
  if(NEGATIVE(q))
     { q = ARG(0,q);
       sign2 = -1;
     }
  /* locate the occurrence, if any, of a summand containing p */
  n = ARITY(t);
  for(i=0;i<n;i++)
    { if(NEGATIVE(ARG(i,t)))
         u = ARG(0,ARG(i,t));
      else
         u = ARG(i,t);
      err = unify1(p,u,a,flag);
      if(!err)
         { if(NEGATIVE(ARG(i,t)))
              sign1 *= -1;
           break;  /* got a match to p */
         }
    }
  if(i==n)
     return 1;  /* failure, no match to p */
  /* now look for a match to q */
  for(j=0;j<n;j++)
     { if(NEGATIVE(ARG(j,t)))
          { u = ARG(0,ARG(j,t));
            newsign = -sign2;
          }
       else
          { u = ARG(j,t);
            newsign = sign2;
          }
       if(i!=j && sign1 == newsign)
          { err = unify1(q,u,a,flag);
            if(!err)
               break;  /* got a match to q */
          }
     }
  if(j==n)
     return 1;  /* no match to q */
  /* Now we have matches to both p and q, with correct signs */
  /* so construct the answer */
  temp = rhs;
  for(k=0;k<NVARS;k++)
     { if(flag[k])   /*  a[k] was instantiated */
          { subst(a[k],metavariables[k],temp,&temp2);
            temp = temp2;
          }
     }
  if(n==2)
     { *ans = (sign1==1 ? temp : tnegate(temp));
       return 0;
     }
  *ans = make_term(f,(unsigned short)(n-1));
  /* Now copy the args of t except for the i-th and j-th */
  l1 = (i<j ? i : j);  /* the lesser of i and j */
  l2 = (i<j ? j : i);  /* the greater of the two */
  for(k = 0; k<n-1; k++)
     { if(k < l1)
          ARGREP(*ans,k,ARG(k,t));
       else if(k==l1)
          ARGREP(*ans,k,(sign1 == 1 ? temp  : tnegate(temp)));
       else if(k < l2)
          ARGREP(*ans,k,ARG(k,t));
       else
          ARGREP(*ans,k,ARG(k+1,t));
     }
  return 0;
}