Sindbad~EG File Manager

/* M. Beeson, for Mathpert.
Original date 7.3.96
Last modified 1.29.98
3.10.99 modified located_subterm.
5.6.13 include lsubterm.h
*/

#include <string.h>
#include <assert.h>
#include <stddef.h>

#include "terms.h"
#include "display.h"
#include "display1.h"
#include "bigrect.h"
#include "lterm.h"
#include "lsubterm.h"

static int located_subterm_aux(term arg, lterm t,
                               unsigned short *legal, int nlegal,
                               unsigned short *required, int nrequired,
                               ltermlist **ans, int flag
                              );
/*__________________________________________________________*/
int equaltrace(term arg, lterm t)
/* return 0 if arg = abstract(t), but without using
memory to create abstract(t).  Return 1 if arg is
different than t.
*/
{ unsigned short n;
  int i,err;
  if(ISATOM(t) && !ISATOM(arg))
     return 1;
  if(ISATOM(arg) && !ISATOM(t))
     return 1;
  if(OBJECT(arg) && !OBJECT(t))
     return 1;
  if(OBJECT(t) && !OBJECT(arg))
     return 1;
  if(ISATOM(t))  /* and necessarily ISATOM(arg) */
     { if(FUNCTOR(t) == FUNCTOR(arg))
          return 0;
       return 1;
     }
  if(OBJECT(t))  /* and necessarily OBJECT(arg) */
     { if(TYPE(t) != TYPE(arg))
           return 1;
       /* the argptr of a located object points to the display string
          and then the data. */
       switch(TYPE(t))
          { case INTEGER:
               if(*((int*)(ARGPTR(t)+1)) == INTDATA(arg))
                  return 0;
               return 1;
            case DOUBLE:
               if(*((double*)(ARGPTR(t)+1)) == DOUBLEDATA(arg))
                  return 0;
               return 1;
            case BIGNUM:
               { bignum p,q;
                 p = *((bignum *)(ARGPTR(t)+1));
                 q = BIGNUMDATA(arg);
                 if(compare(p,q)==0)
                    return 0;
                 return 1;
               }
          }
     }
  /* Now neither arg nor t is not atomic */
  if(FUNCTOR(t) != FUNCTOR(arg) && !(FUNCTOR(t) == FRACT && FUNCTOR(arg) == '/'))
     return 1;
  if(ARITY(t) != ARITY(arg))
     return 1;
  n = ARITY(arg);
  for(i=0;i<n;i++)
     { err = equaltrace(ARG(i,arg),LARG(i,t));
       if(err)
          return 1;
     }
  return 0;
}

/*__________________________________________________________*/
int located_subterm(term arg, lterm t,
                           unsigned short *legal, int nlegal,
                           unsigned short *required, int nrequired,
                           ltermlist **ans
                          )
/* Find arg as a subterm of the located term t, and
return in *ans the corresponding list of located terms,
with their 'path' fields set to show the path from t to
the subterm. If nlegal is positive, then legal is an
array of functors of dimension nlegal, and if nrequired is
positive, then required is an array of functors of dimension
nrequired.
  Look only for subterms in t whose path from t contains only
functors in 'legal', and contains at least one of the functors
in 'required', if nrequired > 0.  Functors NUMERATOR
and DENOM are used in place of '/' when we only want subterms
of the numerator or denom.
  The answer is a list rather than a single term because
of examples like this:   a+c is a subterm of a+b+c,
and we return the list whose members are the located terms a,c
as located subterms of a+b+c.
Return 0 for success.  If arg does not occur
as a subterm of t, return 1; in that case *ans is
garbage.
*/

{ int err,i;
  for(i=0;i<3;i++)
     { err = located_subterm_aux(arg,t,legal,nlegal,required,nrequired,ans, i);
       if(!err)
          return 0;
     }
  return 1;
}
/*_____________________________________________________________________*/
static int located_subterm_aux(term arg, lterm t,
                               unsigned short *legal, int nlegal,
                               unsigned short *required, int nrequired,
                               ltermlist **ans, int flag
                              )
/* first arguments are as for located_subterm (above).  
If flag is 0,  only look for arg on legal paths and only all in one piece,
i.e. don't look for *ans as a list of length more than 1.  
If flag is 1,  don't fail automatically on illegal paths, but still 
only accept *ans as a list of length 1.  
If flag is 2,  accept only legal paths but accept *ans as a list of 
any length.
Thus, if arg occurs e.g. on the right side of an equation in one piece
and on the left side as a list,  selected_subterm should find it on the 
right.  Example:   a c b = ab   where arg is ab.
*/
{ unsigned short n,m;
  unsigned short f,h,q=0;
  ltermlist *p,*next,*tail,*marker;
  int i,j,err,lastj;
  if(equaltrace(arg,t)==0)
     { if(nrequired > 0 && flag != 1)
          return 1;  /* fail due to not finding any required functor
                        on the path down to this term  */
       p = (ltermlist *)mallocate(sizeof(ltermlist));
       if(p == NULL)
          nospace();
       p->data = t;
       p->next = NULL;
       *ans = p;
       return 0;
     }
  if(ATOMIC(t))
     return 1;
  n = ARITY(t);
  m = ARITY(arg);
  h = FUNCTOR(t);
  f = FUNCTOR(arg);
  /* check for the case when arg is a subrange of t */
  if(f == h && (h == '*' || h == '+') && m < n)
     { for(j=0;j<n-m;j++)
          { /* try the subrange composed of the arguments j...j+m-1 of t */
            for(i=0;i<m;i++)
               { if(equaltrace(ARG(i,arg),LARG(j+i,t)))
                    break;
               }
            if(i==m)
               { /* success, it's a subrange */
                 p = (ltermlist *)mallocate(sizeof(ltermlist));
                 if(p == NULL)
                    nospace();
                 p->data = located_subrange(t,j,m);
                 p->next = NULL;
                 p->data.path = cons(j,h,cons(-(m+j),0,NULL));
                 /* a subrange is signalled by a negative arity and 0 functor;
                    the negative value is one more than the  index of the last
                    arg included in the subrange. */
                 *ans = p;
                 return 0;
               }
          }
     }
  if(nlegal > 0 && flag != 1)
     { /* fail if h isn't a member of legal */
       for(i=0;i<nlegal;i++)
          { if(h == legal[i])
               break;
            if(h == '/' && legal[i] == NUMERATOR)
               break;
            if(h == '/' && legal[i] == DENOM)
               break;
          }
       if(i==nlegal)
          return 1;
       q = legal[i];
     }
  /* is h a member of 'required'? */
  for(i=0;i<nrequired;i++)
     { if(required[i] == h)
          break;
     }
  if(i < nrequired)
     { /* h is a member of 'required' */
       nrequired = 0;  /* don't worry further about required */
     }
  if(FRACTION(t))
     { /* look in the denominator first, so we find the arguments to
          muleqn and mulineq correctly even if legal isn't set. */
       for(i=n-1;i>=0;i--)
          { if(q==DENOM && i==0)
               continue;  /* don't look in the numerator then */
            if(q==NUMERATOR && i==1)
               continue;  /* don't look in the denominator    */
            err = located_subterm_aux(arg,LARG(i,t),legal,nlegal,required,nrequired,ans,flag);
            if(!err)
               { /* adjust the paths of all the lterms in ans by consing 'i' */
                 for(marker = *ans;marker;marker=marker->next)
                    marker->data.path = cons(i,FUNCTOR(t),marker->data.path);
                 return 0;
               }
          }
     }
  else
     { for(i=0;i<n;i++)
          { err = located_subterm_aux(arg,LARG(i,t),legal,nlegal,required,nrequired,ans,flag);
            if(!err)
               { /* adjust the paths of all the lterms in ans by consing 'i' */
                 for(marker = *ans;marker;marker=marker->next)
                    marker->data.path = cons(i,FUNCTOR(t),marker->data.path);
                 return 0;
               }
          }
     }
  if(f != '+' && f != '*' && f != AND && f != OR)
     return 1;
  if(f != FUNCTOR(t))
     return 1;
  if(flag < 2)
     return 1;
  if(m >= n)
     return 1;
  /* We don't consider b+a to be a subterm of a+b, although we might consider
     adding that later.  For now we will only find arg as a subterm of t
     if the args of arg occur in the same order among the args of t; and
     we use 'lastj' to be sure we don't find them overlapping, e.g.
     (a+b)da x = c, where arg is (a+b)a, we want to get the SECOND a. */
  p = tail = NULL;
  lastj = 0;
  for(i=0;i<m;i++)
     { for(j=lastj;j<n;j++)
          { err = located_subterm_aux(ARG(i,arg),LARG(j,t),legal,nlegal,required,nrequired,&next,flag);
            if(!err && next->data.path == NULL)
               /* the part about next->data.path == NULL means that actually 
                  arg must be found at the top level--it must be LARG(j,t) itself,
                  not some subterm */
               { next->data.path = cons(j,f,next->data.path);
                 /* the path was relative to LARG(j,t); make it relative to t */
                 /* Now append next to p; tail points to the last node in p */
                 if(!tail)
                    p = tail = next;  /* the first node is created */
                 else
                    { tail->next = next;
                      while(tail -> next)
                         tail = tail->next;
                    }
                 lastj = j+1;
                 break;
               }
          }
      if(j==n)
         return 1;  /* did not find the ARG(i,arg) among the args of t */
    }
  *ans = p;
  return 0;  /* did successfully find all args of arg among the args of t */
}