Sindbad~EG File Manager

Current Path : /usr/home/beeson/Otter-Lambda/yyy/userfunc/
Upload File :
Current File : /usr/home/beeson/Otter-Lambda/yyy/userfunc/userfunc.c

/* Mathpert's user-defined function facility */

/*
M. Beeson
2.4.92 original date
1.24.98 modified
5.25.99 changed 1068 to 1067
11.2.99 corrected atomsub
1.9.00  corrected replace_definition.
6.24.04 modified enter_definition and replace_definition to reject recursive definitions
       and correctly reset the old definition (in replace_definition) in case of an
       attempted recursive definition.
          Added return value 6 to enter_definition and replace_definition
8.26.04 Added 'inuse' field to funcdefn, and added function definition_in_use.
9.2.04  added one more arg to enter_definition and replace_definition,
        to eliminate dependence on mstring.
        Changed MAXDEFNSTRING to 80.
        Modified funcdefn structure to allocate an array for the defnstring field
        instead of using calloc.
        Modified enter_definition to accept a new definition identical to an existing one.
9.5.04  removed a superfluous include.
10.25.05 added LVARGPTR in several places
1.21.06  corrected remove_definition, which was freeing space (userfunctions[i].defnstring)
         that has not been dynamically allocated
2.19.06  made funcdefn 'struct functiondefinition' where formerly it was an unnamed struct.
*/

/* Function definitions are handled separately from 'definitions'
as used in solving equations or integration by substitution.
One reason is that function definitions are shared by all Mathpert
documents (in the Windows version of Mathpert).  The data about
function definitions is local to this file; all communication about
user-defined functions is handled through the public functions
defined in this file and prototyped in userfunc.h; these are
the functions exported by userfunc.dll.  */

/* In the Windows version of Mathpert, function definitions will be
stored on the local heap of funcdefn.dll, and will be accessible to
all Mathpert documents.   They will live and die only by means of
enter_definition and remove_definition; they will last from one
problem to another, unless explicitly removed.
*/

#include <assert.h>
#include <string.h>
#include <stdlib.h>
#define USERFUNC_DLL
#include "export.h"
#include "terms.h"
#include "userfunc.h"
#include "english.h"
#include "dispfunc.h"  /* atom_string */
#define MAXDEFNSTRING 80
#define MAXNAME 16

static double values[4] = { E_DECIMAL, PI_DECIMAL, 1.0, 0.0};
static void make_defnstring(term lhs, term rhs, char *printname, char *rhs_name, char *ans);
static int wf(unsigned short f, int index, term x, term rhs);
/*__________________________________________________________________*/

typedef struct functiondefinition
  { term lhs;
    term rhs;
    char name[MAXNAME];   /* string to use in printing this function;
                     NULL means it's a one-character function,
                     just use the functor.  */
    char defnstring[MAXDEFNSTRING];  /* menu string to show the defn of the function */
    unsigned short dependencies;
    int wellfounded;
    int inuse;    /* number of documents that contain this function */
  } funcdefn;


static funcdefn userfunctions[MAXUSERFUNCTIONS];

/* At most MAXUSERFUNCTIONS different functions can
be in use at the same time.  16 is used because there
can't be more than 16 items on a menu and the
operations for applying defined functions are on a menu.
   If MAXUSERFUNCTIONS becomes more than 16 then the
dependencies field needs to be changed from short to long.
   The dependencies array is intended to tell in bit j of dependencies[i]
whether the function i depends on function j.  Thus an explicit definition
will have dependencies[i] = 0, and a simple recursive one will have
dependencies[i] = 1 << i.
*/

static unsigned nextfunction;
/* The definitions in use will be the userfunctions[0] up to
   userfunctions[nextfunction-1]  */

/*________________________________________________________________*/
static term local_make_term( unsigned short f, unsigned short n)
/*   Static copy of function defined in speed.c */
/*   See speed.c for documentation              */

{  term ans;
   SETFUNCTOR(ans,f,n);
   ZEROINFO(ans);  /* set all info fields to zero */
   if(n==0)
      return ans;  /* don't allocate space for any args */
   ans.args = (void *) callocate(n, sizeof(term));
   if(ans.args == NULL)
      { SETFUNCTOR(ans,ILLEGAL,0);
        nospace();
        return ans;
      }
   SETARGS(ans);
   SETTYPE(ans,NOTYPE);
   return ans;
}

/*________________________________________________________________*/

static char *localstrdup(char *x)
/* return a copy of x on the C-managed heap */
/* If you want to substitute some other memory area
for function definitions, change this function */
{  // return strdup(x);  returns a <BAD_PTR> on 9.2.04
   char *ans = (char *) calloc(1,strlen(x)+1);
   strcpy(ans,x);
   return ans;
}
/*________________________________________________________________*/
static void localfree(void *x)

{ free(x);
}
/*________________________________________________________________*/
static term localcopy(term t)
/* return a copy of t with args on the C-managed heap.
We use the C-managed heap now where formerly we used the
Windows local heap, to make this module of Mathpert entirely
independent of Windows.  If you want to substitute some
other memory area for function definitions in a later port,
just change this and localstrdup and localdestroy.

   Also the numbers pointed to by the argptr of an object
are copied, including bignum digits.
*/

{ unsigned n,i;
  term ans;
  if(ISATOM(t))
     { /* atoms here do not necessarily have valid 'value pointers';
          for variables that doesn't matter, because when the definition
          is applied they will be substituted for.  But for constants
          it does matter. */
       switch(FUNCTOR(t))
          {  case 'e':
                LVARGPTR(t) = (void *) &values[0];
                break;
             case 'i':
                LVARGPTR(t) = (void *) &values[2];
                break;
             case PI_ATOM:
                LVARGPTR(t)= (void *) &values[1];
                break;
           }
       return t;
     }
  if(OBJECT(t))
     { ans = t;
       switch(TYPE(t))
          { case INTEGER:
               n = sizeof(long);
               break;
            case DOUBLE:
               n = sizeof(double);
               break;
            case BIGNUM:
               n = sizeof(bignum);
               break;
            default:
               assert(0);
          }
       LVARGPTR(ans) = (void *) calloc(n,sizeof(char));
       memcpy(ARGPTR(ans), ARGPTR(t), n);
       if(TYPE(t)==BIGNUM)
          { bignum source, dest;
            source = BIGNUMDATA(t);
            dest = BIGNUMDATA(ans);
            dest.val = (digit *) calloc(source.ln, sizeof(digit));
            memcpy(dest.val, source.val,source.ln * sizeof(digit));
          }
       return ans;
     }
  /* Now t is a compound term */
  n = ARITY(t);
  ans = t;
  LVARGPTR(ans) = (void *) calloc(n, sizeof(term));
  for(i=0;i<n;i++)
      ARGREP(ans,i,localcopy(ARG(i,t)));
  return ans;
}

static void localdestroy(term t)
/* recursively free all the args of term t assuming all those
args live on the local heap.  Also free object data
and bignum digits. */

{ unsigned i,n;
  if(ISATOM(t))
     return;
  if(OBJECT(t))
     { if(TYPE(t)==BIGNUM)
          free(BIGNUMDATA(t).val);
       free(ARGPTR(t));
       return;
     }
  n = ARITY(t);
  for(i=0;i<n;i++)
     localdestroy(ARG(i,t));
  free(ARGPTR(t));
}

/*_________________________________________________________________*/
MEXPORT_USERFUNC int nuserfunctions(void)
/* calling program can inquire how many functions are defined */
  { return nextfunction;
  }
/*_________________________________________________________________*/
MEXPORT_USERFUNC int is_defined(unsigned f)
/* if f is defined in userfunctions[k], return k.   Else return -1  */
{ unsigned i;
  for(i=0;i<nextfunction;i++)
     { if(FUNCTOR(userfunctions[i].lhs) == f)
          return i;
     }
  return -1;
}
/*_________________________________________________________________*/
MEXPORT_USERFUNC int enter_definition(term lhs, term rhs, char *printname, char *rhs_name)
/* The input is the left and right sides of a definition entered by
the user, along with the print name of the function (e.g. "f")  and the
print name of the right-hand side (obtained from mstring before calling this function).
The definition is entered in the userfunctions array,
and nextfunction is incremented.  Return values are as follows:

   0 : success.
   1 : userfunctions is already full.
   2 : lhs does not have the form f(atomlist).
   3 : f is already defined (with a different definition than we're trying now)
       If the same definition is already there, 0 is returned, and no additional
       entry is made.
   4 : repeated variable among the arguments on the left, as in f(x,y,x)=...
   5 : recursive definition, the definition of f involves f.  Not allowed.
   6 : f occurs in the right-hand side of a previously defined function.  Not allowed.

It is assumed that rhs does not contain any of the variables in
the array dummyvars.
*/

{ unsigned n = ARITY(lhs);
  unsigned f = FUNCTOR(lhs);
  unsigned i,j;
  if(ATOMIC(lhs))
     return 2;
  if(nextfunction == MAXUSERFUNCTIONS)
     return 1;  /* no room for another definition */
  for(i=0;i<n;i++)
     { if(!ATOMIC(ARG(i,lhs)))
           return 2;
       for(j=0;j<i;j++)
          { if(FUNCTOR(ARG(j,lhs))==FUNCTOR(ARG(i,lhs)))
               return 4;  /* duplicate variable on left side */
          }
     }
  for(i=0;i<nextfunction;i++)
     { if(f == FUNCTOR(userfunctions[i].lhs))
          { /* Now check if the definition is the same */
            if(!equals(rhs, userfunctions[i].rhs))
                return 3;  /* f is already defined, with a different definition */
            return 0;  /* f is already defined, with the same definition */
          }
     }
  for(i=0;i<nextfunction;i++)
     { if(contains(userfunctions[i].rhs,f) && contains(rhs,FUNCTOR(userfunctions[i].lhs)))
          return 6;
     }
  userfunctions[nextfunction].lhs = localcopy(lhs);
  userfunctions[nextfunction].rhs = localcopy(rhs);
  if(printname == NULL)
     userfunctions[nextfunction].name[0] = 0;
  else
     strcpy(userfunctions[nextfunction].name,printname);

  /* Now add to the dependencies field if necessary */
  for(j=0;j<= nextfunction;j++)
     { if(contains(rhs,FUNCTOR(userfunctions[j].lhs)))
          userfunctions[i].dependencies |= ((1 << j) | userfunctions[j].dependencies);
     }
  if(userfunctions[nextfunction].dependencies & (1 << nextfunction))
     { userfunctions[nextfunction].name[0]= 0;
       localdestroy(userfunctions[nextfunction].lhs);
       localdestroy(userfunctions[nextfunction].rhs);
       localfree(userfunctions[nextfunction].defnstring);
       userfunctions[nextfunction].dependencies = 0;
       return 5;  /* recursive definitions not allowed */
     }

/* Originally there was provision for recursive functions, but wf calls
infer, which crashes if called when there is no document, and domain and
seminumerical crash on recursively defined function terms, so this feature,
which never did work,  was taken out 6.24.04.  Recursive definitions are,
however, needed for division of infinite series, but those are not entered
by the user, and are guaranteed to be total.
     &&
     ARITY(lhs) == 1
    )
     { int err = wf(FUNCTOR(lhs),nextfunction,ARG(0,lhs),rhs);
       userfunctions[nextfunction].wellfounded = err ? -1 : 1;
     }
*/
/* Now prepare the menus string */
  make_defnstring(lhs, rhs,printname, rhs_name,userfunctions[nextfunction].defnstring);
  userfunctions[nextfunction].inuse = 0;
  ++nextfunction;
  return 0;
}
/*_________________________________________________________________*/
#if 0
/* Dead code,  recursive function definitions by the user are not allowed */
static int wf(unsigned short f, int index, term x, term rhs)
/* rhs contains no other defined functions besides f.
Return 0 if the recursion f(x) = rhs defines
a total function because only values f(y) with y < x are used in
rhs.  Return 1 otherwise.  Index is the index of the definition
f(x) = rhs in the definitions array, and is used here to store
the answers so this function works instantly after the first call
for a given f.  The static array ans is filled so that ans[k] = 1
or -1 if the result of well_founded has already been computed to
be 0 or 1, respectively. ans[k] = 0 gives no information.
*/

{ unsigned short g,i,n,k;
  term t,savelocus;
  int err,nvars,saveeigen;
  static ans[MAXUSERFUNCTIONS];
  term *varlist;
  varinf *varinfo;
  int savej;
  if(ans[index])
     return ans[index] > 0 ? 0 : 1;
  if(ATOMIC(rhs))
     { ans[index] = 1;
       return 0;
     }
  n = ARITY(rhs);
  g = FUNCTOR(rhs);
  if(g== f)
     { if(n != 1)
          { ans[index] = -1;
            return 1;
          }
       t = ARG(0,rhs);
       err = infer(lessthan(t,x));
       if(err)
          { ans[index] = -1;
            return 1;
          }
       else
          { ans[index] = 1;
            return 0;
          }
     }
  if(g == SUM || g == PRODUCT)
     { varlist = get_varlist();
       nvars = get_nvariables();
       saveeigen = get_eigenindex();
       for(k=0;k<nvars;k++)
          { if(equals(varlist[k],x))
               { set_eigenvariable(k);
                 break;
               }
          }
       setlocus(ARG(1,rhs),&savelocus,&savej,rhs);
       fillbinders(rhs);
     }

  for(i=0;i<n;i++)
     { err = wf(f,index,x,ARG(i,rhs));
       if(err)
          goto out;
     }
  err = 0;
  out:
  if(g == SUM || g == PRODUCT)
     { varinfo = get_varinfo();
       varinfo[savej].locus = savelocus;
       releasebinders();
       set_eigenvariable(saveeigen);
     }
  ans[i] = err ? 1: -1;
  return err;
}
#endif

/*_________________________________________________________________*/
MEXPORT_USERFUNC int remove_definition(unsigned f)
/* Remove the definition of f.
   Return 0 for success, 1 if f isn't defined */
{ unsigned i;
  for(i=0;i<nextfunction;i++)
     { if(f == FUNCTOR(userfunctions[i].lhs))
           break;
     }
  if(i==nextfunction)
     return 1;
  localdestroy(userfunctions[i].lhs);
  localdestroy(userfunctions[i].rhs);
  userfunctions[i].defnstring[0] = 0;  /* this string is not dynamically allocated, so don't free it. */
  userfunctions[i].dependencies = 0;

  /* Now compact the array of definitions so it doesn't have a hole. */
  for(;i<nextfunction-1;i++)
     userfunctions[i] = userfunctions[i+1];
  --nextfunction;
  return 0;
}
/*_________________________________________________________________*/
MEXPORT_USERFUNC void remove_all_definitions(void)
/* Remove all user-defined functions. */
/* this is called to clean up during autotesting, but not in normal MathXpert use. */
{ unsigned i;
  for(i=0;i<nextfunction;i++)
     { localdestroy(userfunctions[i].lhs);
       localdestroy(userfunctions[i].rhs);
       userfunctions[i].dependencies = 0;
     }
  nextfunction = 0;
}
/*_________________________________________________________________*/
MEXPORT_USERFUNC int replace_definition(unsigned k, term lhs, term rhs, char *rhs_name)
/* Remove the definition userfunctions[k], and replace it
with a new definition OF THE SAME FUNCTION SYMBOL
given by lhs and rhs.  It is assumed that FUNCTOR(lhs) is the
same as the function defined in userfunctions[k].  */
/* Return values are the same as for enter_definition, except
that you can't fail because userfunctions is full. */

{ unsigned n = ARITY(lhs);
  unsigned i,j;
  unsigned short f = FUNCTOR(lhs);
  int olddependencies;
  term oldlhs, oldrhs;
  char *olddefn;
  olddependencies = userfunctions[k].dependencies;
  assert(!ATOMIC(lhs) && FUNCTOR(lhs) == FUNCTOR(userfunctions[k].lhs));
  for(i=0;i<n;i++)
     { if(!ATOMIC(ARG(i,lhs)))
           return 2;
       for(j=0;j<i;j++)
          { if(FUNCTOR(ARG(j,lhs))==FUNCTOR(ARG(i,lhs)))
               return 4;  /* duplicate variable on left side */
          }
     }
  for(i=0;i<nextfunction;i++)
     { if(i==k)
          continue;
       if(contains(userfunctions[i].rhs,f))
          return 6;
     }
  olddefn = localstrdup(userfunctions[k].defnstring); // may need it below     
  localfree(userfunctions[k].defnstring);  
   // if(!equals(lhs,userfunctions[k].lhs))
  oldlhs = userfunctions[k].lhs;
  oldrhs = userfunctions[k].rhs;
  userfunctions[k].lhs = localcopy(lhs);
  userfunctions[k].rhs = localcopy(rhs);
  /* userfunctions[k].name is unchanged */
  make_defnstring(lhs,rhs,userfunctions[k].name, rhs_name,userfunctions[k].defnstring);
  for(j=0;j<= nextfunction;j++)
     { if(contains(rhs,FUNCTOR(userfunctions[j].lhs)))
          userfunctions[i].dependencies |= ((1 << j) | userfunctions[j].dependencies);
     }
  if(userfunctions[k].dependencies & (1 << k))
     {
       localdestroy(userfunctions[k].lhs);
       localdestroy(userfunctions[k].rhs);
       userfunctions[k].lhs = oldlhs;
       userfunctions[k].rhs = oldrhs;
       strcpy(userfunctions[i].defnstring, olddefn);
       localfree(olddefn);
       userfunctions[k].dependencies = olddependencies;
       return 5;  /* recursive definitions not allowed */
     }
  localdestroy(oldlhs);
  localdestroy(oldrhs);
  localfree(olddefn);
  return 0;
}

/*_________________________________________________________________*/
MEXPORT_USERFUNC char *function_name(unsigned f)
/* return the print name of user-defined function f,
  or NULL if it is a one-character name or not a defined function */
{ int k;
  k = is_defined(f);
  if(k < 0)
     return NULL;
  return userfunctions[k].name;
}

/*_________________________________________________________________*/
MEXPORT_USERFUNC int get_definition(unsigned k, term *lhs, term *rhs)
/* If k < nextfunction, return 0, and write the definition
userfunctions[k] to lhs and rhs.  If k >= nextfunction, return 1.
The calling program will get access to the local heap of userfunc.dll
this way--it is its responsibility not to disturb that heap.  These
are supposed to be read-only terms.
*/

{ if(k >= nextfunction)
     return 1;
  *rhs = userfunctions[k].rhs;
  *lhs = userfunctions[k].lhs;
  return 0;
}

/*_________________________________________________________________*/
static term atomsub(unsigned n, term *oldvars, term *newvars, term t)
/* oldvars is an arrays of n atoms; newvars is an array of n terms.
Return the term obtained by substituting newvars[i] for oldvars[i]
simultaneously for i=0,...,n-1.  The terms newvars[i] are not copied,
but re-used.  Any new space created is made by local_make_term, so these
terms will live on the Mathpert heap, plus wherever the terms in
the newvars array live.
*/
/* The substitution is simultaneous to avoid capture of variables.
Example:  f(x,y) = x^2 + y^2.  What's f(x+y,x)?
It's (x+y)^2 + x^2.  If you don't do the substitution simultaneously
you may get (x+x)^2 + x^2.   */

{ unsigned i;
  unsigned short m;
  term ans;
  if(ISATOM(t))
     { for(i=0;i<n;i++)
          { if(FUNCTOR(t) == FUNCTOR(oldvars[i]))
               return newvars[i];
          }
       return t;
     }
  if(OBJECT(t))
     { if(TYPE(t) == DOUBLE || TYPE(t) == INTEGER)
          { copy(t,&ans);
            return ans;
          }
     }
  m = ARITY(t);
  ans = local_make_term(FUNCTOR(t),m);
  for(i=0;i<m;i++)
     ARGREP(ans,i,atomsub(n,oldvars,newvars,ARG(i,t)));
  return ans;
}

/*____________________________________________________________*/
MEXPORT_USERFUNC int apply_definition(term t, term *ans)
/* If t has the form f(x1,...xn) for a user-defined
function f,  use the definition of f to rewrite t,
and return the result in *ans.
   Return 0 for success, 1 for failure
*/

{ unsigned n,f,i;
  if(ATOMIC(t))
     return 1;
  f = FUNCTOR(t);
  n = ARITY(t);
  for(i=0;i<nextfunction;i++)
     { if(f == FUNCTOR(userfunctions[i].lhs) &&
          n == ARITY(userfunctions[i].lhs)
         )
          break;
     }
  if(i==nextfunction)
     return 1;
  *ans = atomsub(n,
                 ARGPTR(userfunctions[i].lhs),
                 ARGPTR(t),
                 userfunctions[i].rhs
                );
  return 0;
}
/*____________________________________________________________*/

static void make_defnstring(term lhs, term rhs, char *printname, char *rhs_name, char *ans)
/* make a menu string like "f(x)= 1/x".  If the definition
is too long, make it "Use the definition of f" instead.
Copy the result into ans.  It must of course not be longer than MAXDEFNSTRING,
which is presumed to be the capacity of ans.
*/

{ char buffer[128];
  char name[64];
  int i,k;
  unsigned short n;
  strcpy(name,printname);
  if(!ATOMIC(lhs))
     strcat(name,"(");
  k = strlen(name);
  n = ARITY(lhs);
  for(i=0;i<n;i++)
     { strcpy(name+k,atom_string(ARG(i,lhs)));
       if(i < n-1)
          strcat(name,",");
       k = strlen(name);
     }
  if(!ATOMIC(lhs))
     strcat(name,")");
  k = strlen(name);
  name[k] = 32;
  name[k+1] = '=';
  name[k+2] = 32;
  name[k+3] = 0;
  strcpy(buffer,name);
  if(strlen(rhs_name) + k+ 4 > MAXDEFNSTRING)
     goto toolong;
  strcpy(buffer+k+3,rhs_name);
  if(strlen(buffer) < MAXDEFNSTRING)
     { strcpy(ans,buffer);
       return;
     }
  toolong:
  strcpy(ans,english(1067));  /* use the definition of */
  strcat(ans,name);
}
/*____________________________________________________________*/
MEXPORT_USERFUNC char * get_defnstring(int k)
/* return the definition string for use in the menus for
applying the definition of the k-th user defined function
*/
{ return userfunctions[k].defnstring;
}
/*__________________________________________________________*/
MEXPORT_USERFUNC unsigned short get_dependencies(int k)
{ if(k < 0 || k >= MAXUSERFUNCTIONS)
     return 0;
  return userfunctions[k].dependencies;
}

/*__________________________________________________________*/
MEXPORT_USERFUNC int well_founded(int k)
/* return 1 if the k-th function definition is a well-founded
simple recursion. */

{ if(k < 0 || k >= MAXUSERFUNCTIONS)
     return 0;
  return userfunctions[k].wellfounded == 1 ? 1 : 0;
}
/*__________________________________________________________________*/
MEXPORT_USERFUNC int definition_in_use(char f[32])
/* return nonzero if user-defined function named f is in use
in some current document, 0 if not. */
{ unsigned i;
  char *marker = f;
  while(*marker == 32 && marker-f < 32)
     ++marker;
  if(marker == f + 32)
     assert(0);
  for(i=0;i<nextfunction;i++)
     { if(!strcmp(userfunctions[i].name,f))
          return userfunctions[i].inuse;
     }
  return 0;
}
/*_________________________________________________________________*/
MEXPORT_USERFUNC void increment_function_inuse(int j)
/* used from outside this DLL to increment the inuse field */
{ userfunctions[j].inuse++;
}

/*_________________________________________________________________*/
MEXPORT_USERFUNC void decrement_function_inuse(int j)
/* used from outside this DLL to increment the inuse field */
{ userfunctions[j].inuse--;
}

Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists