Sindbad~EG File Manager

// author:  Beeson
// purpose:  utility functions to construct and access parts of terms
// original date 8.3.02
// last modified 10.12.02
// 3.24.06 made make_term static 

#include <assert.h>
#include "header.h"
#include "bterms.h"
#include "bsym.h"
// #include "unify.h"

/*__________________________________________________________________________*/
 int arity(term t)
{ int ans = 0;
  struct rel *r;
  for(r = t->farg; r ; r = r->narg)
     ++ans;
  return ans;
}
/*__________________________________________________________________________*/
 static term make_term(int f, int n)
/* Make a term with space for n arguments, later to be inserted by argrep */
/* If n = 0,  it returns a name, not a variable */
 { struct term *t = get_term();
   struct rel *r;
   int k;
   if(n == 0)
      { t -> type = NAME;
        t -> sym_num = f;
        return t;
      }
   t->type = COMPLEX;
   t->sym_num =  f < MAX_BUILTINS ? f : str_to_sn(sn_to_str(f),1);
   r = get_rel();
   t->farg = r;
   for(k=1;k<n;k++)
       { r->narg = get_rel();
         r = r->narg;
       }
   r->narg = NULL;
   return t;
}
/*___________________________________________________________________________*/
term make_atom(char *name, struct literal *l)
/* return a new atom specified by its string name */
/* It must have a containing literal pointed to by l  */
{ struct term *ans = get_term();
  ans->type = NAME;
  ans->sym_num = str_to_sn(name,0);
  ans->occ.lit = l;
  ans->varnum = 0;
  ans->farg = NULL;
  return ans;
}
/*___________________________________________________________________________*/
term True(struct literal *l)
/* return the atom "true" */
{ return make_atom("$T",l);
}
/*___________________________________________________________________________*/
term False(struct literal *l)
/* return the atom "false" */
{ return make_atom("$F",l);
}
/*___________________________________________________________________________*/
int isTrue(term a)
/* return 1 if a is the atom "true" */
{ if(a->type != NAME)
     return 0;
  return a->sym_num == str_to_sn("$T",0);
}
/*___________________________________________________________________________*/
int isFalse(term a)
/* return 1 if a is the atom "false" */
{ if(a->type != NAME)
     return 0; 
  return a->sym_num == str_to_sn("$F",0);
}
/*______________________________________________________________________________*/
static void make_argof(struct term *a, struct term *t)
/* append t to  the superterm list of a */
/* increment the reference counts of both a and t */
{ struct rel *r = a->occ.rel;
  struct rel *m;
  if(!r)
     { a->occ.rel = get_rel();
       a->occ.rel->argof = t;
       t->fpa_id++;
       a->fpa_id++;
       return;
     }
  while(r)
     { m = r;
       r = r->nocc;
     }
  m->nocc = get_rel();
  m->nocc->argof = t;
  t->fpa_id++;
  a->fpa_id++;
}                
/*___________________________________________________________________________*/

void argrep(term t, int n, term newarg)
/* replace the n-th arg of term t with newarg if it has that many args */
{  int k;
   term old;
   struct rel *r = t->farg;
   for(k=0;k < n && r ; k++)
      { r = r->narg;
      }
   if(!r)
      { assert(0);  // erroneous call
        return;
      }
   old = r->argval;
   r->argval = newarg;
   make_argof(newarg,t);
   if(old != NULL)  // it could be NULL if t has just been made by make_term
      zap_term_special(old);    // now there's one less reference to it.
}
/*____________________________________________________________________________*/
term arg(int i, term t)
/* return the i'th argument of t */
{ int k;
  struct rel *r = t->farg;
  for(k=0; k<i && r ; k++)
    { r = r->narg;
    }
  if(!r)
     { assert(0);
       return NULL;   // erroneous call
     }
  return r->argval;
}

/*______________________________________________________________________________*/
term cases(term a, term b, term c, term d)
/* make a CASES term with the given arguments */  
{ term t = make_term(CASES,4);
  argrep(t,0,a);
  argrep(t,1,b);
  argrep(t,2,c);
  argrep(t,3,d);
  return t;
}
/*______________________________________________________________________________*/
term lambda(term a, term b)
/* make a LAMBDA term with the given arguments */  
{ term t = make_term(LAMBDA,2);
  if(a->type != VARIABLE)
     assert(0);
  argrep(t,0,a);
  argrep(t,1,b);
  return t;
}

/*______________________________________________________________________________*/
term ap(term a, term b)
/* make an AP term with the given arguments */  
{ term t = make_term(AP,2);
  argrep(t,0,a);
  argrep(t,1,b);
  return t;
}
/*______________________________________________________________________________*/
term otter_or(term a, term b)
/* make an OR term with the given arguments */  
{ term t = make_term(OR,2);
  argrep(t,0,a);
  argrep(t,1,b);
  return t;
}
/*______________________________________________________________________________*/
#if 0
term and(term a, term b)
/* make an AND term with the given arguments */  
{ term t = make_term(AND,2);
  argrep(t,0,a);
  argrep(t,1,b);
  return t;
}
#endif 
/*_______________________________________________________________________*/
int set_vars2(struct term *t, int *nextvar)
//  Beeson 10.6.02, enhancement of McCune's set_vars in io.c  
{ int i, rval;
  char *varnames[MAX_VARS];
  memset(varnames,0,MAX_VARS * sizeof(char *));  // Beeson 10.6.02, replacing a for-loop
  rval = set_vars_term(t, varnames);
  if(!rval)
     return 0;
  for(i=0;i<MAX_VARS;i++)
     { if(varnames[i] == NULL)
           break;
     }
  *nextvar = i;
  if(i == MAX_VARS)
      assert(0);
  return 0;
}  /* set_vars2 */