Sindbad~EG File Manager

/* M. Beeson, for MathXpert
Evaluate a (user-defined) function numerically
Original date 1.19.99
Last modified 2.21.99
*/

#include <assert.h>
#include <string.h>
#include <math.h>
#include <stdlib.h>   /* calloc */
#define ALGEBRA_DLL
#include "globals.h"
#include "userfunc.h"
#include "deval.h"
#include "errbuf.h"
#include "mpmem.h"
#include "feval.h"
/*_________________________________________________________________*/

MEXPORT_ALGEBRA int evalfunction(term t, term arg, term *next, char *reason)
/* Evaluate a numerical value of a user-defined function. */
{ unsigned short f = FUNCTOR(t);
  unsigned short n = ARITY(t);
  unsigned short j;
  unsigned short dependencies;
  aflag savearithflag,flag;
  term temp,temp2,x;
  int k;
  term *answers;
  term lhs,rhs;
  void  *savenode;
  if(!DEFINED_FUNCTION(f))
     return 1;
  if(!seminumerical(t))
     return 1;
  if(contains(t,INFINITY))
     return 1;
  k = is_defined(f);
  if(k < 0)
     return 1;
  get_definition(k,&lhs,&rhs);
  if(ARITY(lhs) != n)
     return 1;
  savearithflag = flag = get_arithflag();
  flag.fract = flag.intexp = flag.negexp = flag.ratexp = flag.roots = 1;
  flag.gcd = flag.abs = flag.factorial = flag.functions = flag.sums = 1;
  flag.complex = flag.comdenom = flag.complexpowers = 1;
  dependencies = get_dependencies(k);
  if(!dependencies)
     {  /* this is an explicit definition */
       temp = rhs;
       for(j=0;j<n;j++)
          { subst(ARG(j,t),ARG(j,lhs),temp,&temp2);
            if(j > 0)
               destroy_term(temp);
            temp = temp2;
          }
       return arith(temp,next,flag);
     }
  if(ARITY(lhs) == 1 &&
     dependencies == (1 << k) &&
     (TYPE(ARG(0,lhs)) == INTEGER || TYPE(ARG(0,lhs)) == NATNUM) &&
     well_founded(k)
    )
     { /* This is a simple recursion that will terminate */
       set_arithflag(flag);
       polyval(ARG(0,t),&x);
       if(!INTEGERP(x))
          { errbuf(0, english(2346)); /* Function argument must be an integer */
            return 1;
          }
       if(!ISINTEGER(x) || INTDATA(x) + 1 >= 0x8000)
			 { errbuf(0, english(2347));  /* Function argument too large. */
				return 1;
			 }
		 savenode = heapmax();
		 answers = (term *) calloc((int)(INTDATA(x)+1),sizeof(term));
       if(!answers)
          { errbuf(0,english(2347));
            return 1;
          }
       temp = feval(t,f,k,lhs,rhs,answers);
       if(FUNCTOR(temp) == ILLEGAL)
          { reset_heap(savenode);
            return 1;
          }
       save_and_reset(temp,savenode,next);
       free(answers);
       set_nanswers(0);   /* tell feval the answers are no good */
       set_arithflag(savearithflag);
       strcpy(reason,english(2348)); /* compute function value */
       HIGHLIGHT(*next);
       return 0;
     }
  return 1;  /* FINISH THIS: handle more complicated recursions and
                functions of more variables, such as Ackermann's function */
}