Sindbad~EG File Manager

/* M. Beeson, for Otter-lambda */
/* Extracted from unify2.c,  6.3.04 */
/* 6.30.04  modified get_constant_aux to not return an is_number term. 
7.1.04   when getConstant calls getConstants, the last parameter should be 'flag' 
7.1.04   if(flag.. should be if(flag > 0.. at line 196 
12.4.05  added depth parameter to getConstants and wrote constant_term. 
12.5.05 modified constant_term 
3.20.06 made include filenames lowercase 
*/

#include <assert.h>
#include <ctype.h>  // isdigit 
#include "header.h"
#include "unify.h"    /* BIND and DEREFERENCE */
#include "bterms.h"
#include "bsym.h"
#include "beta.h"
#include "unify2.h"
#include "proto.h"   // occur_check
#include "fsubsto.h"
#include "getconstant.h"  
//#define DIAGNOSTICS

static int is_number(struct term *t);
static struct term_ptr *getConstants(struct term *t, int flag, int depth);
/*_______________________________________________________________________________*/
static int NatNum(int parent, int argNumber, int s)
/* s is the sym_num of some constant, occurring as the argNumber'th argument
of a term with sym_num parent.  Check the types list, if it is non-NULL, and
return 1 if this constant has type NatNum,  0 if not.  If the types list is NULL,
check if the name of this constant begins with n,m,k,i, or j,  and return 1
if it does, and 0 if it doesn't.
*/
{  /* for now the types list isn't implemented, so we only do the second thing. */
   char *p = sn_to_str(s);
   if(!p)
      assert(0);
   return strchr("nmkijNMKIJ",p[0]) ? 1 : 0;
}
/*_______________________________________________________________________________*/
static struct term *getConstant_aux(int parent, int argNumber, struct term * t, int intflag)
/* return a constant term contained in t.  If intflag is 1,
it must be an integer term; if it's 2, it must be a blocking-functor term; 
if it's zero, any constant will do. If no such constant exists in t, return NULL. 
Parent is the sym_num of the parent of t, which is needed to consult the types
list.  t occurs in the parent term as the argNumber'th arg.
*/
{
  struct rel *r;
  struct term *ans;
  int k;
  if(t->type == NAME && intflag != 2 && !is_number(t))
     { if(intflag==1)
          return NatNum(parent, argNumber, t->sym_num) ? t : NULL;
       else
          return t;
     }
  if(blocking_functor(t->sym_num))
     return intflag == 2 ? t : NULL;
  for(r=t->farg, k = 0;r;r=r->narg, ++k)
     { ans = getConstant_aux(t->sym_num,k,r->argval,intflag);
       if(ans)
          return ans;
     }
  return NULL;
}
/*_______________________________________________________________________________*/
 struct term *getConstant(struct term * t)
/* return a constant (or constant term) contained in t.  If INDUCTION_FLAG is set,
an integer constant is returned if there is one; otherwise (i.e. 
if INDUCTION_FLAG is not set, or there is no integer constant), any constant will do.
If no such constant exists in t, return a blocking-functor Skolem term if there is one.
Otherwise, return NULL.
*/

{ struct term *trythis = NULL;
  int i,flag;
  struct term_ptr *left=NULL, *right=NULL,*p, *q;
  if(t->type == NAME)
    return t;  // ideally this should only be done if t has the same type as
               // the desired ground type of Ap.
  
  if(! strcmp(sn_to_str(t->sym_num),"="))
     { /* Now t is an equation, so we prefer a constant that appears on both sides */          
       if(Flags[INDUCTION_FLAG].val == 0)
         return getConstant_aux(0,0,t,0);
       for(flag = Flags[INDUCTION_FLAG].val; flag >= -1; flag--)
          { /* when INDUCTION_FLAG is set, first try for an integer constant, 
               then any constant (name), then a blocking functor term.  The 
               flag-controlled loop tries these three.  In each case take 
               the rightmost constant on the left that occurs on both sides,
               if there is one that occurs on both sides.
            */
            left = getConstants(ARG0(t),flag,1);
            right = getConstants(ARG1(t),flag,1);
            #ifdef DIAGNOSTICS      
                  fprintf(stdout,"in getConstant, left = ");  // DEBUG
                  for(p = left;p;p=p->next) print_term_nl(stdout,p->term);// DEBUG
                  fprintf(stdout,"right = ");// DEBUG
                  for(p = right;p;p=p->next) print_term_nl(stdout,p->term);// DEBUG
            #endif       
            for(p=left;p;p=p->next)
              { trythis = p->term;
                // is trythis in the list right?
                for(q = right;q;q=q->next)
                   { if(term_ident2(trythis,q->term,0))
                        goto out;
                   }
              }
            // No good constant on both sides.
            // free left and right
            for(i=0;i<2;i++)
              { p = i ? right : left;
                while (p) 
                  { q = p;
                    p = p->next;
                    free_term_ptr(q);
                  }
              } 
          }
       for(flag = Flags[INDUCTION_FLAG].val; flag >= -1; flag--)
          { /* sometimes we want a constant that only occurs on one side.
            */
            if(t->occ.lit->sign)
              { 
                  left = getConstants(ARG0(t),flag,0);
                  right = getConstants(ARG1(t),flag,0);
                  #ifdef DIAGNOSTICS      
                        fprintf(stdout,"in getConstant, left = ");  // DEBUG
                        for(p = left;p;p=p->next) print_term_nl(stdout,p->term);// DEBUG
                        fprintf(stdout,"right = ");// DEBUG
                        for(p = right;p;p=p->next) print_term_nl(stdout,p->term);// DEBUG
                  #endif       
                  if(left)
                     { trythis = left->term;
                     goto out;
                     }
                  if(right)
                     { trythis = right->term;
                     goto out;
                     }
                  // free left and right
                  for(i=0;i<2;i++)
                  { p = i ? right : left;
                     while (p) 
                        { q = p;
                        p = p->next;
                        free_term_ptr(q);
                        }
                  } 
              }
          }
        return NULL;  // failure, no good constant anywhere in sight.
     }
  // Now, t is not an equation, so it's not required to have the constant on both sides.
  // Plenty of inequalities are proved by induction using a variable on one side only.
  // Also inequations p!=q are proved that way, and unify can be called with '=' when 
  // we put in a negative form of the induction axioms as in file le2.in 
  trythis =  getConstant_aux(0,0,t,1);
  if(trythis)
     goto out;
  trythis = getConstant_aux(0,0,t,0);
  if(trythis)
     goto out;
  trythis = getConstant_aux(0,0,t,2);
  out:
  // free left and right
  for(i=0;i<2;i++)
    { p = i ? right : left;
      while (p) 
        { q = p;
          p = p->next;
          free_term_ptr(q);
        }
    }
  return trythis;
}

/*_______________________________________________________________________________*/
static int is_number(struct term *t)
// return 1 if t's name is a character string composed of digits only. 
// return 0 otherwise
{ char *p = sn_to_str(t->sym_num);
  for(; *p;p++)
    { if(!isdigit(*p))
         return 0;
    }
  return 1;
}
/*_______________________________________________________________________________*/
static int constant_term(struct term *t)  
/* return 1 if t is a constant term, including terms satisfying blocking_functor,
which may contain lambda-bound variables.
Return 0 otherwise. */
{ struct rel *r;
  if(t->type == VARIABLE)
     return 0;
  if(t->type == NAME)
     return 1;
  if(blocking_functor(t->sym_num))
       return 1;
  for(r=t->farg;r;r=r->narg)
     { if(! constant_term(r->argval))
          return 0;
     }
  return 1;
}
   

/*_______________________________________________________________________________*/
static struct term_ptr *getConstants(struct term *t, int flag, int depth)
/* If flag == 0, return a list of all constants (names) or constant terms in t, 
in order encountered from right to left, up to depth d. (Names have depth 0).
  But don't count "0", "1", etc. as names, and don't go into 
blocking-functor terms, i.e. skip constants occurring in blocking functor-terms.
But DO count Hilbert epsilon-symbol terms, i.e. with functor e.
   If flag == 1,  return a list of all constants (names) that satisfy Natnum in t,
in the order encountered from right to left, not counting "0", "1", etc., but skip
blocking-functor terms as before.
   If flag = -1,  include blocking-functor terms as well as names.
*/
{ struct rel *r;
  int argnum;
  struct sym_ent *se;
  struct term_ptr *p, *marker, *ans;
  if(t->type == VARIABLE)
     return NULL;
  if(t->type == NAME)
     { if(is_number(t))
          return NULL;
       p = get_term_ptr();
       p-> term = t;
       p->next = NULL;
       return p;
     }
  // now t->type == COMPLEX
  if(blocking_functor(t->sym_num))
     { if(flag == 0 && 
           (se = sym_tab_member("e",1)) != NULL && 
           (unsigned short) se->sym_num == t->sym_num
          )
          { p = get_term_ptr();
            p -> term = t;
            p -> next = NULL;
            return p;
          }
       if(flag != -1)
          return NULL;
       p = get_term_ptr();
       p -> term = t;
       p -> next = NULL;
       return p;
     }
  ans = NULL;
  for(r=t->farg,argnum=0;r; r=r->narg,++argnum)
     { if(flag > 0  && r->argval->type==NAME && !NatNum(t->sym_num,argnum,r->argval->sym_num))
           continue;
       p = getConstants(r->argval,flag,depth);
       if(p == NULL)
          continue;
       marker = p;
       while(marker->next)
          marker = marker->next;
       marker->next = ans;
       ans = p;
     }
  if(constant_term(t))
     { int w = weight(t,Weight_pick_given_index);
       if(w <= depth + 1 )
          { p = get_term_ptr();
            p -> term = t;
            p->next = ans;
            ans = p;
          }
     }
  return ans;
}