Sindbad~EG File Manager
/* creators for different kinds of terms */
/* M. Beeson
Original date 2.6.92
last modified 1.30.99
10.25.05 added LVARGPTR at line 1093
8.19.07 made polygamma1 create an arity 2 term instead of arity 1.
8.24.07 corrected polygamma1
5.15.13 added bernoulli
5.21.13 added eulernumber
2.6.24 modified make_int, make_double, make_bignum so the data arg always points to
sizeof(term) space.
2.16.25 added includes needed to compile with Makefile
*/
#include <string.h>
#include "terms.h"
#include "speed.h"
#include "defns.h"
#include "vaux.h"
#include "constant.h" /* externs for eulere, pi_term, complexi */
#include "dcomplex.h"
#include "deval.h"
#include "ceval.h"
#include "maketerm.h"
#include "constant.h" // minusone, etc.
#include "heap.h" // callocate, etc.
/*_____________________________________________________________________*/
term make_fraction(term a,term b)
/* return a/b , not in new space*/
/* if b is 1, just return a */
{ term ans;
if(ONE(b))
return a;
ans = make_term('/',2);
ARGREP(ans,0,a);
ARGREP(ans,1,b);
return ans;
}
/*_____________________________________________________________________*/
term make_power(term base, term power)
/* does not balk at creating 0^0 */
{ term ans;
if(ONE(power))
return base;
if(ONE(base))
return one;
if(ZERO(base))
return zero;
ans = make_term('^',2);
ARGREP(ans,0,base);
ARGREP(ans,1,power);
return ans;
}
/*_______________________________________________________________________*/
term make_sqrt(term t)
{ term ans;
if(ONE(t))
return one;
ans = make_term(SQRT,1);
ARGREP(ans,0,t);
return ans;
}
/*_______________________________________________________________________*/
term make_root(term n,term t) /* root(n,t) */
{ term ans;
ans = make_term(ROOT,2);
ARGREP(ans,0,n);
ARGREP(ans,1,t);
return ans;
}
/*____________________________________________________________*/
/* make an atomic term from a bignum */
/* There is a static copy in parser.c; if you change this, change that too.*/
term make_bignum(bignum x)
{ term ans;
SETFUNCTOR(ans,0,1);
ans.info = 0;
SETTYPE(ans,BIGNUM);
SETAE(ans);
if ( (ans.args = (void *) mallocate(sizeof(term))) == NULL)
// sizeof(term), not sizeof(bignum)
{ SETFUNCTOR(ans,ILLEGAL,0);
nospace();
}
else
((bignum *)ans.args)[0] = x;
return ans;
}
/*_______________________________________________________________________*/
term bignum_term(bignum x)
/* use an INTEGER if the number will fit, otherwise use a bignum */
{ long d;
int err = bignum_long(x,&d);
if(err)
return make_bignum(x);
return make_int(d);
}
/*_______________________________________________________________________*/
term absolute(term t)
{ term ans;
ans = make_term(ABSFUNCTOR,1);
ARGREP(ans,0,t);
return ans;
}
/*_______________________________________________________________________*/
term odd(term t)
{ term ans;
ans = make_term(ODD1,1);
ARGREP(ans,0,t);
return ans;
}
/*_______________________________________________________________________*/
term even(term t)
{ term ans;
ans = make_term(EVEN1,1);
ARGREP(ans,0,t);
return ans;
}
/*_______________________________________________________________________*/
term nonzero(term t)
{ term ans;
ans = make_term(NE,2);
ARGREP(ans,0,t);
ARGREP(ans,1,zero);
return ans;
}
/*_______________________________________________________________________*/
term defined(term t)
{ term ans;
ans = make_term(DEFINED,1);
ARGREP(ans,0,t);
return ans;
}
/*_____________________________________________________________________*/
term type(term t, unsigned foo)
/* foo will be R, DCOMPLEX,INTEGER, or other values #-defined in terms.h */
{ term ans;
ans = make_term(':',2);
ARGREP(ans,0,t);
ARGREP(ans,1,make_int(foo));
return ans;
}
/*_______________________________________________________________________*/
term positive(term t)
{ term ans;
ans = make_term('<',2);
ARGREP(ans,1,t);
ARGREP(ans,0,zero);
return ans;
}
/*_______________________________________________________________________*/
term nonnegative(term t)
{ term ans;
ans = make_term(LE,2);
ARGREP(ans,1,t);
ARGREP(ans,0,zero);
return ans;
}
/*_______________________________________________________________________*/
term negative(term t)
{ term ans;
ans = make_term('<',2);
ARGREP(ans,0,t);
ARGREP(ans,1,zero);
return ans;
}
/*_______________________________________________________________________*/
term nonpositive(term t)
{ term ans;
ans = make_term(LE,2);
ARGREP(ans,0,t);
ARGREP(ans,1,zero);
return ans;
}
/*_______________________________________________________________________*/
term or(term a,term b)
{ term ans;
ans = make_term(OR,2);
ARGREP(ans,0,a);
ARGREP(ans,1,b);
return ans;
}
/*_______________________________________________________________________*/
term or3(term a,term b,term c)
{ term ans;
ans = make_term(OR,3);
ARGREP(ans,0,a);
ARGREP(ans,1,b);
ARGREP(ans,2,c);
return ans;
}
/*_______________________________________________________________________*/
term not(term a)
{ term ans;
ans= make_term(NOT,1);
ARGREP(ans,0,a);
return ans;
}
/*_______________________________________________________________________*/
term and(term a,term b)
{ term ans;
ans = make_term(AND,2);
ARGREP(ans,0,a);
ARGREP(ans,1,b);
return ans;
}
/*_______________________________________________________________________*/
term and3(term a,term b,term c)
{ term ans;
ans = make_term(AND,3);
ARGREP(ans,0,a);
ARGREP(ans,1,b);
ARGREP(ans,2,c);
return ans;
}
/*_______________________________________________________________________*/
term product(term a,term b)
/* even if multbyone is LEARNING, we don't get 1*a or a*1 */
/* return a^2 for the product a dot a */
{ term ans;
if(ONE(a))
return b;
if(ONE(b))
return a;
if(ATOMIC(a) && ATOMIC(b) && equals(a,b))
{ ans = make_power(a,two);
if(COLOR(a) || COLOR(b))
SETCOLOR(ans,YELLOW);
}
mt(a,b,&ans);
return ans;
}
/*_______________________________________________________________________*/
term signedproduct(term a, term b)
{ if(ONE(a))
return b;
if(ONE(b))
return a;
if(NEGATIVE(a) && COLOR(a))
SETCOLOR(ARG(0,a),COLOR(a));
if(NEGATIVE(b) && COLOR(b))
SETCOLOR(ARG(0,b),COLOR(b));
if(FUNCTOR(a) == '-')
{ if(ONE(ARG(0,a)))
return tnegate(b);
if(FUNCTOR(b) == '-')
{ if(ONE(ARG(0,b)))
return ARG(0,a);
return product(ARG(0,a),ARG(0,b));
}
else
return tnegate(product(ARG(0,a),b));
}
if(FUNCTOR(b) == '-')
{ if(ONE(ARG(0,b)))
return tnegate(a);
return tnegate(product(a,ARG(0,b)));
}
return product(a,b);
}
/*_______________________________________________________________________*/
term signedfraction(term a, term b)
{ if(FUNCTOR(a) == '-')
{ if(FUNCTOR(b) == '-')
return make_fraction(ARG(0,a),ARG(0,b));
else
return tnegate(make_fraction(ARG(0,a),b));
}
if(FUNCTOR(b) == '-')
return tnegate(make_fraction(a,ARG(0,b)));
return make_fraction(a,b);
}
/*_______________________________________________________________________*/
term product3(term a,term b, term c)
/* form the product of three terms */
{ term ans,temp;
if(ONE(a))
return product(b,c);
if(ONE(b))
return product(a,c);
if(ONE(c))
return product(a,b);
temp = product(a,b);
ans = product(temp,c);
return ans;
}
/*_______________________________________________________________________*/
term sum(term a,term b)
{ term ans;
if(ZERO(a))
return b;
if(ZERO(b))
return a;
at(a,b,&ans);
return ans;
}
/*_______________________________________________________________________*/
term limit(term a, term b)
{ term ans;
ans = make_term(LIMIT,2);
ARGREP(ans,0,a);
ARGREP(ans,1,b);
return ans;
}
/*_______________________________________________________________________*/
term arrow(term a, term b)
{ term ans;
ans = make_term(ARROW,2);
ARGREP(ans,0,a);
ARGREP(ans,1,b);
return ans;
}
/*_______________________________________________________________________*/
term limit3(term a, term b, term c)
/* b should be either 'left' or 'right' */
{ term ans;
ans = make_term(LIMIT,3);
ARGREP(ans,0,a);
ARGREP(ans,1,b);
ARGREP(ans,2,c);
return ans;
}
/*_______________________________________________________________________*/
term diff(term u, term x)
/* create diff(u,x) */
{ term ans;
ans = make_term(DIFF,2);
ARGREP(ans,0,u);
ARGREP(ans,1,x);
return ans;
}
/*_______________________________________________________________________*/
term integral(term u, term x)
/* create diff(u,x) */
{ term ans;
ans = make_term(INTEGRAL,2);
ARGREP(ans,0,u);
ARGREP(ans,1,x);
return ans;
}
/*_______________________________________________________________________*/
term diff3(term u,term x,term n)
/* create diff(u,x,n) */
{ term ans;
ans = make_term(DIFF,3);
ARGREP(ans,0,u);
ARGREP(ans,1,x);
ARGREP(ans,2,n);
return ans;
}
/*_______________________________________________________________________*/
term definite_integral(term u,term x,term lo,term hi)
/* create integral(u,x,lo,hi) */
{ term ans;
ans = make_term(INTEGRAL,4);
ARGREP(ans,0,u);
ARGREP(ans,1,x);
ARGREP(ans,2,lo);
ARGREP(ans,3,hi);
return ans;
}
/*_______________________________________________________________________*/
term make_binomial(term n,term index)
{ term ans;
ans = make_term(BINOMIAL,2);
ARGREP(ans,0,n);
ARGREP(ans,1,index);
return ans;
}
/*_______________________________________________________________________*/
term equation(term left, term right)
{ term ans;
ans = make_term('=',2);
ARGREP(ans,0,left);
ARGREP(ans,1,right);
return ans;
}
/*_______________________________________________________________________*/
term approxeq(term left, term right)
{ term ans;
ans = make_term(APPROXEQ,2);
ARGREP(ans,0,left);
ARGREP(ans,1,right);
return ans;
}
/*_______________________________________________________________________*/
term lessthan(term left, term right)
{ term ans;
ans = make_term('<',2);
ARGREP(ans,0,left);
ARGREP(ans,1,right);
return ans;
}
/*_______________________________________________________________________*/
term greaterthan(term left, term right)
{ term ans;
ans = make_term('>',2);
ARGREP(ans,0,left);
ARGREP(ans,1,right);
return ans;
}
/*_______________________________________________________________________*/
term le(term left, term right)
{ term ans;
ans = make_term(LE,2);
ARGREP(ans,0,left);
ARGREP(ans,1,right);
return ans;
}
/*_______________________________________________________________________*/
term ge(term left, term right)
{ term ans;
ans = make_term(GE,2);
ARGREP(ans,0,left);
ARGREP(ans,1,right);
return ans;
}
/*_______________________________________________________________________*/
term ne(term left, term right)
{ term ans;
ans = make_term(NE,2);
ARGREP(ans,0,left);
ARGREP(ans,1,right);
return ans;
}
/*_______________________________________________________________________*/
/* We follow the general convention that a term with a unary function 'foo'
is made by a function whose name is 'foo1', e.g. sin1, tan1, etc.
These functions do NOT incorporate ANY laws for the functors in question.
Here are a bunch of these: */
term acos1(term x)
{ term ans;
ans = make_term(ACOS,1);
ARGREP(ans,0,x);
return ans;
}
term acot1(term x)
{ term ans;
ans = make_term(ACOT,1);
ARGREP(ans,0,x);
return ans;
}
term acsc1(term x)
{ term ans;
ans = make_term(ACSC,1);
ARGREP(ans,0,x);
return ans;
}
term asec1(term x)
{ term ans;
ans = make_term(ASEC,1);
ARGREP(ans,0,x);
return ans;
}
term asin1(term x)
{ term ans;
ans = make_term(ASIN,1);
ARGREP(ans,0,x);
return ans;
}
term atan1(term x)
{ term ans;
ans = make_term(ATAN,1);
ARGREP(ans,0,x);
return ans;
}
term cos1(term x)
{ term ans;
ans = make_term(COS,1);
ARGREP(ans,0,x);
return ans;
}
term cot1(term x)
{ term ans;
ans = make_term(COT,1);
ARGREP(ans,0,x);
return ans;
}
term csc1(term x)
{ term ans;
ans = make_term(CSC,1);
ARGREP(ans,0,x);
return ans;
}
term ln1(term x)
{ term ans;
ans = make_term(LN,1);
ARGREP(ans,0,x);
return ans;
}
term log1(term x)
{ term ans;
ans = make_term(LOG,1);
ARGREP(ans,0,x);
return ans;
}
term logb1(term b, term x)
{ term ans = make_term(LOGB,2);
ARGREP(ans,0,b);
ARGREP(ans,1,x);
return ans;
}
term sg1(term x)
{ term ans;
ans = make_term(SG,1);
ARGREP(ans,0,x);
return ans;
}
term sec1(term x)
{ term ans;
ans = make_term(SEC,1);
ARGREP(ans,0,x);
return ans;
}
term sin1(term x)
{ term ans;
ans = make_term(SIN,1);
ARGREP(ans,0,x);
return ans;
}
term sqrt1(term x) /* make_sqrt knows that sqrt(1) = 1; sqrt1 does not */
{ term ans;
ans = make_term(SQRT,1);
ARGREP(ans,0,x);
return ans;
}
term tan1(term x)
{ term ans;
ans = make_term(TAN,1);
ARGREP(ans,0,x);
return ans;
}
term abs1(term x)
{ term ans;
ans = make_term(ABSFUNCTOR,1);
ARGREP(ans,0,x);
return ans;
}
term det1(term x)
{ term ans;
ans = make_term(DET,1);
ARGREP(ans,0,x);
return ans;
}
term besselj(term n, term x)
{ term ans;
ans = make_term(BESSELJ,2);
ARGREP(ans,0,n);
ARGREP(ans,1,x);
return ans;
}
term bessely(term n, term x)
{ term ans;
ans = make_term(BESSELY,2);
ARGREP(ans,0,n);
ARGREP(ans,1,x);
return ans;
}
term besselk(term n, term x)
{ term ans;
ans = make_term(BESSELK,2);
ARGREP(ans,0,n);
ARGREP(ans,1,x);
return ans;
}
term besseli(term n, term x)
{ term ans;
ans = make_term(BESSELI,2);
ARGREP(ans,0,n);
ARGREP(ans,1,x);
return ans;
}
term factorial1(term x)
{ term ans;
ans = make_term(FACTORIAL,1);
ARGREP(ans,0,x);
return ans;
}
term deg1(term x)
/* DEG is supposed to be applied only to numbers in
Mathpert. So -20 degrees should be -(deg(20)), not deg(-20).
It's convenient to handle this 'centrally' in this
term-making function, rather than remember it each time
we make a DEG term.
*/
{ term ans;
if(NEGATIVE(x))
return tnegate(deg1(ARG(0,x)));
ans = make_term(DEG,1);
ARGREP(ans,0,x);
return ans;
}
term erf1(term x)
{ term ans;
ans = make_term(ERF,1);
ARGREP(ans,0,x);
return ans;
}
term gamma1(term x)
{ term ans;
ans = make_term(GAMMA,1);
ARGREP(ans,0,x);
return ans;
}
term digamma1(term x)
{ term ans;
ans = make_term(DIGAMMA,1);
ARGREP(ans,0,x);
return ans;
}
term polygamma1(term n, term x)
{ term ans;
ans = make_term(POLYGAMMA,2);
ARGREP(ans,0,n);
ARGREP(ans,1,x);
return ans;
}
term indexedsum(term u,term i, term lower, term upper)
{ term ans;
ans = make_term(SUM,4);
ARGREP(ans,0,u);
ARGREP(ans,1,i);
ARGREP(ans,2,lower);
ARGREP(ans,3,upper);
return ans;
}
term series(term u,term i, term lower, term upper, term flag)
{ term ans;
ans = make_term(SUM,5);
ARGREP(ans,0,u);
ARGREP(ans,1,i);
ARGREP(ans,2,lower);
ARGREP(ans,3,upper);
ARGREP(ans,4,flag);
return ans;
}
term ldots(term u,term i, term lower, term upper,term aux)
{ term ans;
ans = make_term(SUM,5);
ARGREP(ans,0,u);
ARGREP(ans,1,i);
ARGREP(ans,2,lower);
ARGREP(ans,3,upper);
ARGREP(ans,4,aux);
return ans;
}
term indexedproduct(term u,term i, term lower, term upper)
{ term ans;
ans = make_term(PRODUCT,4);
ARGREP(ans,0,u);
ARGREP(ans,1,i);
ARGREP(ans,2,lower);
ARGREP(ans,3,upper);
return ans;
}
term evalat(term u, term x, term lower, term upper)
{ term ans;
ans = make_term(EVAL,4);
ARGREP(ans,0,u);
ARGREP(ans,1,x);
ARGREP(ans,2,lower);
ARGREP(ans,3,upper);
return ans;
}
term riemannzeta(term x)
{ term ans;
ans = make_term(RIEMANNZETA,1);
ARGREP(ans,0,x);
return ans;
}
term stroke(term u, term x, term a)
/* means lambda(x,u)(a); but note that lambda-abstraction and derivative
notation du/dx don't mix; so du/dx|x=a is needed */
{ term ans;
ans = make_term(STROKE,3);
ARGREP(ans,0,u);
ARGREP(ans,1,x);
ARGREP(ans,2,a);
return ans;
}
/*_______________________________________________________________________*/
term im(term x)
{ term ans;
ans = make_term(IMAGPART,1);
ARGREP(ans,0,x);
return ans;
}
/*_______________________________________________________________________*/
term re(term x)
{ term ans;
ans = make_term(REALPART,1);
ARGREP(ans,0,x);
return ans;
}
/*______________________________________________________________________*/
void mt(term a, term b, term *ans)
/* multiply a and b, flattening, and ignoring a or b if they are 1 */
/* if a or b is zero, return zero WITHOUT checking that the other is
defined; that's the caller's job, this has to be fast. */
/* if neither factor is one, then a new term is made, but its args are
filled with terms that already exist */
/* Does not use the distributive law or polymult, just handles minus
signs and associativity; does not collect powers or numbers. */
/* always allocates ans->args (unless ans is atomic) */
{ unsigned short n; /* arity of *ans */
int i;
unsigned f,g;
term u,v;
if (ONE(a))
{ copy(b,ans);
return;
}
if (ONE(b))
{ copy(a,ans);
return;
}
if (FUNCTOR(a)== '-' && FUNCTOR(b) == '-')
{ u = ARG(0,a);
SETCOLOR(u,COLOR(a));
v = ARG(0,b);
SETCOLOR(v,COLOR(b));
mt(u,v,ans);
return;
}
if (FUNCTOR(a)== '-')
{ term temp;
u = ARG(0,a);
SETCOLOR(u,COLOR(a));
mt(u,b,&temp);
tneg(temp,ans);
return;
}
if (FUNCTOR(b)== '-')
{ term temp;
v = ARG(0,b);
SETCOLOR(v,COLOR(b));
mt(a,v,&temp);
tneg(temp,ans);
return;
}
if (ZERO(a) || ZERO(b))
{ *ans = zero;
return;
}
f = FUNCTOR(a);
g = FUNCTOR(b);
if(f != '*' && g != '*')
{ *ans = make_term('*',2);
ARGREP(*ans,0,a);
ARGREP(*ans,1,b);
return;
}
if(f == '*' && g != '*')
{ n = ARITY(a) + 1;
*ans = make_term('*',n);
for(i=0;i<n-1;i++)
ARGREP(*ans,i,ARG(i,a));
if(COLOR(a))
{ for(i=0;i<n-1;i++)
SETCOLOR(ARG(i,*ans),COLOR(a));
}
ARGREP(*ans,n-1,b);
return;
}
if(f != '*' && g == '*')
{ n = ARITY(b) + 1;
*ans = make_term('*',n);
ARGREP(*ans,0,a);
for(i=1;i<n;i++)
ARGREP(*ans,i,ARG(i-1,b));
if(COLOR(b))
{ for(i=1;i<n;i++)
SETCOLOR(ARG(i,*ans),COLOR(b));
}
return;
}
if(f == '*' && g == '*')
{ int q = ARITY(a);
n = q + ARITY(b);
*ans = make_term('*',n);
for(i=0;i<q;i++)
ARGREP(*ans,i,ARG(i,a));
if(COLOR(a))
{ for(i=0;i<q;i++)
SETCOLOR(ARG(i,*ans),COLOR(a));
}
for(i=q;i<n;i++)
ARGREP(*ans,i,ARG(i-q,b));
if(COLOR(b))
{ for(i=q;i<n;i++)
SETCOLOR(ARG(i,*ans),COLOR(b));
}
return;
}
}
/*_____________________________________________________________________*/
void at(term a, term b, term *ans)
/* add a and b, flattening and ignoring a or b if they are 0 */
{ unsigned short n; /* arity of *ans */
int i;
int colora = COLOR(a);
int colorb = COLOR(b);
unsigned f,g;
if(ZERO(a))
{ *ans = b;
return;
}
if(ZERO(b))
{ *ans = a;
return;
}
f = FUNCTOR(a);
g = FUNCTOR(b);
if(f != '+' && g != '+')
{ *ans = make_term('+',2);
ARGREP(*ans,0,a);
ARGREP(*ans,1,b);
if(colora)
SETCOLOR(ARG(0,*ans),colora);
if(colorb)
SETCOLOR(ARG(1,*ans),colorb);
return;
}
if(f == '+' && g != '+')
{ n = ARITY(a) + 1;
*ans = make_term('+',n);
for(i=0;i<n-1;i++)
{ ARGREP(*ans,i,ARG(i,a));
if(colora)
SETCOLOR(ARG(i,*ans),colora);
}
ARGREP(*ans,n-1,b);
if(colorb)
SETCOLOR(ARG(n-1,*ans),colorb);
return;
}
if(f != '+' && g == '+')
{ n = ARITY(b) + 1;
*ans = make_term('+',n);
ARGREP(*ans,0,a);
if(colora)
SETCOLOR(ARG(0,*ans),colora);
for(i=1;i<n;i++)
{ ARGREP(*ans,i,ARG(i-1,b));
if(colorb)
SETCOLOR(ARG(i,*ans),colorb);
}
return;
}
if(f == '+' && g == '+')
{ int q = ARITY(a);
n = q + ARITY(b);
*ans = make_term('+',n);
for(i=0;i<q;i++)
{ ARGREP(*ans,i,ARG(i,a));
if(colora)
SETCOLOR(ARG(i,*ans),colora);
}
for(i=q;i<n;i++)
{ ARGREP(*ans,i,ARG(i-q,b));
if(colorb)
SETCOLOR(ARG(i,*ans),colorb);
}
return;
}
}
/*______________________________________________________________*/
term sigma(term u, term i, term lo, term hi)
{ term ans;
ans = make_term(SUM,4);
ARGREP(ans,0,u);
ARGREP(ans,1,i);
ARGREP(ans,2,lo);
ARGREP(ans,3,hi);
return ans;
}
/*_______________________________________________________________*/
term pr(term u, term n)
{ term ans;
ans = make_term(PR,2);
ARGREP(ans,0,u);
ARGREP(ans,1,n);
return ans;
}
/*_______________________________________________________________*/
term reciprocal(term u)
{ if(FUNCTOR(u) == '/')
return make_fraction(ARG(1,u),ARG(0,u));
if(FUNCTOR(u) == '-')
return tnegate(reciprocal(ARG(0,u)));
return make_fraction(one,u);
}
/*__________________________________________________________________*/
static void increment(term v, term *index)
/* if v is an integer, return the value of v+1 in index;
else return the term v+1 in index */
{ long k;
if(ISINTEGER(v))
{ k = INTDATA(v);
++k;
*index = make_int(k);
return;
}
*index = sum(v,one);
return;
}
/*__________________________________________________________________*/
term dif_aux(term u, term x)
/* x is an atom. Return diff(u,x) unless u is already a derivative
and then return a higher-derivative term, one higher derivative than u.
*/
{ term index,ans;
unsigned f = FUNCTOR(u);
if(f == PR && equals(x,get_eigenvariable()))
{ increment(ARG(1,u),&index);
ans = make_term(PR,2);
ARGREP(ans,0,ARG(0,u));
ARGREP(ans,1,index);
return ans;
}
if(!ATOMIC(u) && !PREDEFINED_FUNCTOR(f))
{ /* differentiate f(x) to f'(x) */
ans = make_term(PR,2);
ARGREP(ans,0,u);
ARGREP(ans,1,one);
return ans;
}
if(f != DIFF)
return diff(u,x);
if(!equals(x,ARITY(u)==2 ? ARG(1,u) : ARG(2,u)))
return diff(u,x);
if(ARITY(u) == 2)
return diff3(ARG(0,u),x,two);
increment(ARG(1,u),&index);
return diff3(ARG(0,u),x,index);
}
/*________________________________________________________________*/
term sinh1(term x)
{ term ans;
ans = make_term(SINH,1);
ARGREP(ans,0,x);
return ans;
}
term cosh1(term x)
{ term ans;
ans = make_term(COSH,1);
ARGREP(ans,0,x);
return ans;
}
term tanh1(term x)
{ term ans;
ans = make_term(TANH,1);
ARGREP(ans,0,x);
return ans;
}
term coth1(term x)
{ term ans;
ans = make_term(COTH,1);
ARGREP(ans,0,x);
return ans;
}
term sech1(term x)
{ term ans;
ans = make_term(SECH,1);
ARGREP(ans,0,x);
return ans;
}
term csch1(term x)
{ term ans;
ans = make_term(CSCH,1);
ARGREP(ans,0,x);
return ans;
}
term asinh1(term x)
{ term ans;
ans = make_term(ASINH,1);
ARGREP(ans,0,x);
return ans;
}
term acosh1(term x)
{ term ans;
ans = make_term(ACOSH,1);
ARGREP(ans,0,x);
return ans;
}
term atanh1(term x)
{ term ans;
ans = make_term(ATANH,1);
ARGREP(ans,0,x);
return ans;
}
term acoth1(term x)
{ term ans;
ans = make_term(ACOTH,1);
ARGREP(ans,0,x);
return ans;
}
term asech1(term x)
{ term ans;
ans = make_term(ASECH,1);
ARGREP(ans,0,x);
return ans;
}
term acsch1(term x)
{ term ans;
ans = make_term(ACSCH,1);
ARGREP(ans,0,x);
return ans;
}
term forall(term x, term t)
{ term ans;
ans = make_term(FORALL,2);
ARGREP(ans,0,x);
ARGREP(ans,1,t);
return ans;
}
term exists(term x, term t)
{ term ans;
ans = make_term(EXISTS,2);
ARGREP(ans,0,x);
ARGREP(ans,1,t);
return ans;
}
term implies(term x, term t)
{ term ans;
ans = make_term(IMPLIES,2);
ARGREP(ans,0,x);
ARGREP(ans,1,t);
return ans;
}
term if1(term a, term b)
{ term ans = make_term(IF,2);
ARGREP(ans,0,a);
ARGREP(ans,1,b);
return ans;
}
term cases2(term a, term b)
{ term ans = make_term(CASES,2);
ARGREP(ans,0,a);
ARGREP(ans,1,b);
return ans;
}
term bernoulli(term a)
{ term ans = make_term(BERNOULLI,1);
ARGREP(ans,0,a);
return ans;
}
term eulernumber(term a)
{ term ans = make_term(EULERNUMBER,1);
ARGREP(ans,0,a);
return ans;
}
term min1(term a, term b)
{ term ans = make_term(MINFUNCTOR,2);
ARGREP(ans,0,a);
ARGREP(ans,1,b);
return ans;
}
term max1(term a, term b)
{ term ans = make_term(MAXFUNCTOR,2);
ARGREP(ans,0,a);
ARGREP(ans,1,b);
return ans;
}
/*________________________________________________________________*/
/* Compound terms are created by the following function */
/* It should not be used to make 'objects' because for these,
the args field points to data which is of a different size than a term */
/* There are static copies of this in parser.c and funcdefn.c,
bblock2, bblock, and probably other places too.
If you change this change the copies too. */
term make_term( unsigned short f, unsigned short n)
/* makes a term ans such that ans.args points to the base of
an array of n terms. Also fills in the
functor field with f, and puts zero in the info field of ans. */
/* ILLEGAL is returned in the functor field of ans if space can't be found
for the arguments. (Action taken by nospace() may of course prevent
reaching the return statement if nospace aborts, for example.) */
{ 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;
}
/*______________________________________________________________________*/
term make_int(long n) /* make a term from a long int */
/* make an atomic term from a positive long and a term -(x) from a
negative long */
/* NULL is returned if space can't be found */
/* Use static constants for integers 0,1,...,10. */
/* There is a copy of this in parser.c, if you change this change the
copy too. */
{ term ans;
long *q;
SETFUNCTOR(ans,0,1); /* zero functor, arity 1*/
ZEROINFO(ans); /* set all info fields to zero */
SETTYPE(ans,INTEGER);
SETAE(ans);
if( n >= 0)
{ if(n <= MAXCONSTANTINT)
return constant_int((int ) n);
q = (long *) mallocate(sizeof(term)); // so we own enough space to copy a term from here
LVARGPTR(ans) = (void *) q;
if (ans.args == NULL)
nospace();
else
/* ((long *) ans.args)[0] = n; FAILS TO WORK IN CODEVIEW */
/* so does * ((long *) ans.args) = n; */
*q = n;
SETARGS(ans); /* so the space just allocated will be freed by destroy_term */
return ans;
}
/* now n < 0 */
{ long y= -n;
if(y == 1L)
return minusone;
ans = make_term('-',1);
ARGREP(ans,0,make_int(y));
SETTYPE(ans,INTEGER);
SETAE(ans);
return ans;
}
}
/*___________________________________________________________*/
term make_double(double x)
/* There is a copy of this in parser.c, if you change this change the
copy too. */
/* make a term from a double; atomic if the double is positive
and of the form -(x) if it's negative. */
{ term ans;
SETFUNCTOR(ans,0,1);
ZEROINFO(ans); /* set all info bits to zero */
SETTYPE(ans,DOUBLE);
SETAE(ans);
if(x >= 0.0)
{ if ( (ans.args = (void *) mallocate(sizeof(term))) == NULL)
// term, not double, so we own enough space to copy a term from here
nospace();
else
((double *) ans.args)[0] = x;
SETARGS(ans);
return ans;
}
else /* now x < 0 */
{ double y= -x;
ans = make_term('-',1);
ARGREP(ans,0,make_double(y));
SETAE(ans);
SETTYPE(ans,DOUBLE);
return ans;
}
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists