Sindbad~EG File Manager
/* M. Beeson; code to add variables to varlist, for Mathpert and Gentzen */
/*
12.2.93 extracted from earlier code
3.18.99 modified
1.9.00 added PSEUDOATOM to set_valuepointers
3.2.00 added bindvar and unbindvar
7.22.00 modified initialize_parameter to use GreekString
7.28.00 deleted declaration of now-unused 'buffer' in initialize_parameter
5.29.01 removed a superfluous line in make_atom_from_string
9.6.04 changed ltoa to sprintf in gensym
9.9.04 changed make_atom_from_string to use eulere and pi.
changed string_to_atom to handle "infty".
6.24.05 modified vaux for binders EVAL and LAM, EXISTS, FORALL
7.21.05 modified getnewvar to return ILLEGAL when vaux fails
10.25.05 added LVARGPTR in several places
*/
/* var.dll works like this: it maintains internal static variables
varlist, varinfo, parameters, defns,
maxvariables, maxparameters, maxdefns,
nvariables, nparameters, nextdefn, eigenvariable, currentline.
These are also the names of fields in the DocVarData, which is
a part of the DocData of each document. When we switch TO a
document, init_varDLL is called and initializes the DLL's variables
from the DocVarData. Now the arrays point to the same data. The
integers nvariables (etc) in the DocVarData are never accessed in
Mathpert except by init_varDLL and exit_varDLL. The rest of the code
uses, for example, get_nvariables() to access nvariables.
*/
#include <string.h> /* memcpy */
#include <stdio.h> /* sprintf */
#include <assert.h>
#define VAR_DLL
#include "export.h"
#include "terms.h"
#include "speed.h"
#include "defns.h"
#include "vaux.h"
#include "constant.h" /* externs for eulere, pi, complexi */
#include "dcomplex.h"
#include "deval.h"
#include "ceval.h"
#include "dispfunc.h" /* newatom, GreekString, atom_string */
static vardata *varDLL;
/* will always point to the current document's vardata */
/* Set by init_varDLL. */
static char *compute_subscripted_varname(term expr);
static double local_drandom(void);
/*__________________________________________________________*/
MEXPORT_VAR int vaux(term t)
/* continue adding new variables to varlist, which has dimension
maxvariables; add all variables in t.
if it isn't big enough, make more space. Indeed it must leave
one UNUSED space, so that info about bound variables can be
added BEFORE vaux is called.
*/
/* doesn't count PI, e, i, LEFT, RIGHT, or INFINITY */
/* Always leaves at least two unused spaces for enhance_problem to use */
/* accepts 'i' only as the index variable of a sum */
/* sets varinfo.scope to BOUND correctly */
/* sets varinfo.type to whatever the TYPE macro returns on the
variable at its first new occurrence in t. Variables created
by getnewintvar for instance have this set to INTEGER.
*/
/* sets varinfo.linenumber to varDLL->currentline */
/* for bound variables, sets varinfo[j].locus to an ILLEGAL term;
this gets set and reset as we traverse the term, but should be ILLEGAL
while we are not traversing */
/* Returns zero for success. Nonzero returns as follows:
65: complexi used as variable of integration with complex numbers on
66: index variable of sum can't occur outside the sum
67: index variable of product can't occur outside the product
68: variable of definite integration can't occur outside the integral
69: limit variable can't occur outside the limit
15: MathXpert can't handle any more variables!
*/
{ int i,err;
unsigned a = FUNCTOR(t);
term v;
term *varlist = varDLL->varlist;
varinf *varinfo = varDLL->varinfo;
if(ISATOM(t))
{ /* determine if t is already in varlist */
if(a==PI_ATOM || (a== 'i' && TYPE(t) != INTEGER) || a == 'e' ||
a == INFINITY || a==LEFT || a==RIGHT ||
a == TRUEFUNCTOR || a == FALSEFUNCTOR
)
return 0; /* don't count these */
/* But do count i if it has type integer; normally
it should then be bound, and already counted by
virtue of the code below, but when the Graph button
is pushed in sigma notation, if the variable of
summation is 'i', then we get a free 'i' here.
*/
for(i=0;i<varDLL->nvariables;i++)
{ if(FUNCTOR(varlist[i]) == a)
break; /* already there */
}
if(i==varDLL->nvariables) /* wasn't already there, must add it */
{ if(varDLL->nvariables >= varDLL->maxvariables-1)
{ /* No use allocating more space, because the dependencies are stored in
a 32-bit word (and maxvariables is 32), so even if we allocate more,
the dependency management will be broken. */
return 15;
}
/* Now go ahead and add t to the varlist */
varlist[varDLL->nvariables] = t;
LVARGPTR(varlist[varDLL->nvariables]) = (void *) &varinfo[varDLL->nvariables].realpart;
++varDLL->nvariables;
/* Now add info to varinfo[nvariables-1] */
if(varinfo[varDLL->nvariables-1].scope != BOUND
&& varinfo[varDLL->nvariables-1].scope != HALFBOUND
) /* it's already been set for bound variables,
don't change it. Bound variables are caught
BELOW here in the code, and the scope set,
but then they get sent through again to
get added to varlist */
varinfo[varDLL->nvariables-1].scope = UNIVERSAL;
/* universal, type unspecified */
/* if it should be EXISTENTIAL, it will be changed later */
varinfo[varDLL->nvariables-1].linenumber = varDLL->currentline + 1;
varinfo[varDLL->nvariables-1].type = TYPE(varlist[varDLL->nvariables-1]);
varinfo[varDLL->nvariables-1].realpart = local_drandom();
/* the value of the variable under deval() is set
randomly. Ssolve uses numerical evaluation to
try to refute equations even if they have parameters. */
if(SUBSCRIPT(a))
{ char *printname = compute_subscripted_varname(t);
assert(strlen(printname) <= 4);
strcpy(varinfo[varDLL->nvariables-1].name, printname);
}
}
return 0;
}
if(OBJECT(t))
return 0;
/* so now it's a compound term */
/* catch bound variables and label them in varinfo */
if(a==SUM || a== PRODUCT || (a==INTEGRAL && ARITY(t)==4) || a==LIMIT|| a == EVAL ||
a == LAM || a == EXISTS || a == FORALL
)
{ if(a==LIMIT)
{ v = ARG(0,ARG(0,t));
SETORDERED(v); /* see order.c, search for "limit" */
}
else if( a == LAM || a == EXISTS || a == FORALL)
v = ARG(0,t);
else
v = ARG(1,t);
for(i=0;i<varDLL->nvariables;i++)
{ if(ISATOM(v) && FUNCTOR(varlist[i]) == FUNCTOR(v))
{ if(varinfo[i].scope != BOUND)
/* variable occurs both free and bound */
{ switch(a)
{ case SUM: return 66;
case PRODUCT: return 67;
case INTEGRAL: return 68;
case LIMIT: return 69;
}
}
else
break;
}
}
if(i == varDLL->nvariables)
{ /* So now v is a variable not encountered yet: add it */
varinfo[varDLL->nvariables].scope = BOUND;
SETFUNCTOR(varinfo[varDLL->nvariables].locus,ILLEGAL,0);
ZEROINFO(varinfo[varDLL->nvariables].locus);
varinfo[varDLL->nvariables].linenumber = varDLL->currentline + 1;
if(FUNCTOR(v) == 'i')
/* then the code above won't get it */
{ if(a == SUM || a == PRODUCT)
{ SETFUNCTOR(varlist[varDLL->nvariables],'i',0);
ZEROINFO(varlist[varDLL->nvariables]);
SETTYPE(varlist[varDLL->nvariables], INTEGER);
varinfo[varDLL->nvariables].type = INTEGER;
LVARGPTR(varlist[varDLL->nvariables]) = (void *) &varinfo[varDLL->nvariables].realpart;
++varDLL->nvariables;
}
else
return 65; /* i can't be used as a variable of integration
when complex numbers are on */
}
else
{ err = vaux(v);
if(err)
return err;
}
}
if(a==LIMIT)
{ err = vaux(ARG(1,ARG(0,t)));
if(err)
return err;
err = vaux(ARG(1,t));
if(err)
return err;
if (ARITY(t)==3)
{ err = vaux(ARG(2,t));
if(err)
return err;
}
return 0;
}
else
{ for(i=0;i<ARITY(t);++i)
{ if((a == SUM || a == PRODUCT || a == INTEGRAL || a == EVAL) && i==1)
continue; /* already did ARG(1,t) */
else if((a == LAM || a == EXISTS || a == FORALL) && i==0)
continue;
err = vaux(ARG(i,t));
if(err)
return err;
}
}
return 0;
}
else if((FUNCTOR(t)==INTEGRAL && ARITY(t)==2) /* indefinite integral */
|| (FUNCTOR(t) == DIFF ) /* derivative */
)
{ for(i=0;i<varDLL->nvariables;i++)
{ if(ISATOM(ARG(1,t)) && FUNCTOR(varlist[i])==FUNCTOR(ARG(1,t)))
{ varinfo[i].scope = HALFBOUND;
break;
}
}
if (i==varDLL->nvariables) /* variable is not already in varlist */
{ varinfo[varDLL->nvariables].scope = HALFBOUND;
vaux(ARG(1,t)); /* the variable of integration */
err = vaux(ARG(0,t));
if(err)
return err;
if(ARITY(t)==3) /* higher derivative */
err = vaux(ARG(2,t));
if(err)
return err;
return 0;
}
}
else
varinfo[varDLL->nvariables].scope = UNIVERSAL;
/* So it won't accidentally be BOUND or HALF-BOUND in
the calls below; we can't assume that the unused parts
of varinfo contain zero. They do if it's a fresh document,
but not if reset_document has been called (when the Next
or Previous buttons are used).
*/
for(i=0;i<ARITY(t);i++)
{ err = vaux(ARG(i,t));
if(err)
return err;
}
return 0;
}
/*_____________________________________________________*/
#define IA 16807
#define IMAX 2147483647L
#define IQ 127773L
#define IR 2836
static double local_drandom(void)
/* return a random number between 0 and 1 */
/* Adapted from Numerical Recipes p. 279, 2nd edition */
{ long k;
static double idum = 17; /* can be any seed but CANNOT BE ZERO */
k = (long) idum/IQ;
idum = IA *(idum-k*IQ)-IR*k;
if(idum < 0)
idum += IMAX;
return (1.0/IMAX) * idum;
}
/*_______________________________________________________________________*/
MEXPORT_VAR term getnewvar(term t,char *data)
/* get a new variable which does not occur in t, preferring
to use the letters in data. For example getnewvar(t,"ijk")
will return 'i' if t doesn't contain i, but will return k if t contains
i and j. If t contains all the letters in data, it will use the first
letter as a root for gensym. Enter the new variable in varlist and
varinfo just as if it had been entered with the problem, EXCEPT that
its scope is made the same as that of varlist[eigenvariable].
The string 'data' may also be exactly "theta" or "epsilon". In
the former case the choice of variables will be from theta, phi, t, alpha,beta.
In the latter it will be epsilon or a subscripted epsilon.
WARNING: operators should not call this function unless they are
going to succeed and return an answer containing the new variable, to
avoid getting random new variables created that aren't used.
The new variable must also not duplicate one already in varlist.
When there's no more space for subscripted variables, it will
return an ILLEGAL term. */
{ int i,j;
double z;
term ans;
char buf[5];
char str[2];
int n = strlen(data);
int err;
term *varlist = varDLL->varlist;
varinf *varinfo = varDLL->varinfo;
if(n == 7 && !strcmp(data,"epsilon"))
{ if(!contains(t,EPSILON))
{ SETFUNCTOR(ans,EPSILON,0);
SETTYPE(ans,R);
}
else
{ ans = gensym(EPSILON);
SETTYPE(ans,R);
}
}
else
{ if (n==5 && !strcmp(data,"theta"))
{ buf[0] = THETA;
buf[1] = PHI;
buf[2] = 't';
buf[3] = ALPHA;
buf[4] = BETA;
buf[5] = 0;
n = 5;
data = buf;
}
for(i=0;i < n; i++)
{ if( !contains(t,data[i]) )
{ for(j=0;j<varDLL->nvariables;j++)
{ /* check if this letter is already in use */
if(data[i]==FUNCTOR(varlist[j]))
break;
}
if(j<varDLL->nvariables) /* it's already been used */
continue; /* so go on to the next letter in data */
/* if we get here, data[i] is ok--use it */
str[0] = data[i];
str[1] = '\0';
ans = make_atom_from_string(str);
break;
}
}
if(i==n)
{ ans = gensym(data[0]);
if(FUNCTOR(ans) == ILLEGAL)
return ans;
}
}
err = vaux(ans); /* put it in varlist and varinfo */
if(err)
{ // too many variables, probably
SETFUNCTOR(ans, ILLEGAL,0);
return ans;
}
varinfo[varDLL->nvariables-1].scope = varinfo[varDLL->eigenvariable].scope;
/* Now set the value of this variable randomly; this is used in
check_numerically in ssolve.c when checking solutions of equations
that involve parameters. The parameters are thus given random
values which will, with high probability, enable rejection of
truly spurious solutions without rejecting genuine solutions. */
z = local_drandom();
ans.args = (void *) &varinfo[varDLL->nvariables-1].realpart;
SETVALUE(ans,z);
return ans;
}
/*_______________________________________________________________________*/
MEXPORT_VAR term index_variable(term x)
/* get a new index variable which does not occur in x */
/* Like getnewintvar, but sets the scope to BOUND, not EXISTENTIAL */
{ term ans = getnewvar(x,"kjmnpqsJMNPQ");
if(FUNCTOR(ans)==ILLEGAL)
return ans;
varDLL->varinfo[varDLL->nvariables-1].type = INTEGER;
/* that's enough so 'immediate' can deduce the type; but
the assumption that it's an integer won't show on this basis */
varDLL->varinfo[varDLL->nvariables-1].scope = BOUND;
SETTYPE(ans,INTEGER);
SETTYPE(varDLL->varlist[varDLL->nvariables-1],INTEGER);
SETVALUE(ans, 0.0);
return ans;
}
/*_________________________________________________________________*/
static term getnewintvar_aux(term x, char *s,int scope)
/* call getnewvar and make it an int, choosing a name preferably from
among characters of s that don't occur in x. Set the 'scope' field in
varinfo to scope, which will be BOUND or EXISTENTIAL. */
{ term ans = getnewvar(x,s);
term *varlist;
varinf *varinfo;
if(FUNCTOR(ans)==ILLEGAL)
return ans;
varlist = varDLL->varlist;
varinfo = varDLL->varinfo;
varinfo[varDLL->nvariables-1].type = INTEGER;
/* that's enough so 'immediate' can deduce the type; but
the assumption that it's an integer won't show on this basis */
varinfo[varDLL->nvariables-1].scope = scope;
SETVALUE(ans, 0.0);
SETEXISTENTIALVAR(ans); /* mark a certain bit in the info field */
SETEXISTENTIALVAR(varlist[varDLL->nvariables-1]);
/* you must mark the copy in the varlist too */
SETTYPE(ans,INTEGER); /* getnewvar gets it right only on a few default values,
but once you've used them up, getnewvar sets the
type to R. */
SETTYPE(varlist[varDLL->nvariables-1],INTEGER);
return ans;
}
/*________________________________________________________________*/
MEXPORT_VAR term getnewintvar(term x, char *s)
/* call getnewvar and make it an int, choosing a name preferably from
among characters of s that don't occur in x. Set the 'scope' field in
varinfo to EXISTENTIAL. */
{ return getnewintvar_aux(x,s,EXISTENTIAL);
}
/*________________________________________________________________*/
MEXPORT_VAR term getnewboundintvar(term x, char *s)
/* call getnewvar and make it an int, choosing a name preferably from
among characters of s that don't occur in x. Set the 'scope' field in
varinfo to EXISTENTIAL. */
{ return getnewintvar_aux(x,s,BOUND);
}
/*_______________________________________________________________________*/
static int cofi_index;
MEXPORT_VAR void set_cofi_index(int n)
/* set the index for the next constant of integration */
{ cofi_index = n;
}
/*_______________________________________________________________________*/
MEXPORT_VAR int get_cofi_index(void)
/* access the value of cofi_index */
{ return cofi_index;
}
/*______________________________________________________________________*/
MEXPORT_VAR int contains_free(term t, unsigned short f)
/* return 1 if t contains f free, 0 if not. If it contains
t both free and bound, 1 is returned, although such terms are
not supposed to arise in Mathpert. */
{ unsigned short n,i,g;
int j = -1;
if(OBJECT(t))
return 0;
if(ISATOM(t))
return f == FUNCTOR(t) ? 1 : 0;
n = ARITY(t);
g = FUNCTOR(t);
if(g == INTEGRAL && n == 4)
j = 1;
if(g == SUM || g == PRODUCT || g == EVAL || g == BIGOH)
j = 1;
if(g == LAM || g == FORALL || g == EXISTS)
j = 0;
if(g == LIMIT)
{ if(f == FUNCTOR(ARG(0,ARG(0,t))))
return 0;
if(contains_free(ARG(1,ARG(0,t)),f))
return 1;
j = 0;
}
else
{ if(FUNCTOR(ARG(j,t)) == f)
return 0;
}
for(i=0;i<n;i++)
{ if(i==j)
continue;
if(contains_free(ARG(i,t),f))
return 1;
}
return 0;
}
/*_______________________________________________________________________*/
/* Constants of integration are created by the following function. */
MEXPORT_VAR term constant_of_integration(term s,term x)
/* Usually x is the variable of integration, s is the integrand.
But x can also be a term like and(x,y) or and(x,and(y,z))
listing several variables, if more than one integral has been
done at the same line. The constant of integration to be
returned should depend on variables in s which are not in x.
Constants of integration are not atoms. They are
terms with functor CONSTANTOFINTEGRATION. They will be
printed as c_k or as c_k(a,b..) where a,b... are the
variables on which they depend. The 0-th argument is the
subscript that will be printed.
*/
{ term ans;
int i,k;
unsigned short f;
term *varlist = varDLL->varlist;
unsigned short count = 0;
/* On how many variables will this constant depend? */
for(i=0;i<varDLL->nvariables;i++)
{ f = FUNCTOR(varlist[i]);
if(!contains(x,f) && (contains_free(s,f) || depends(s,varlist[i])) &&
(!depends(x,varlist[i]) || isparameter(varlist[i])>= 0 ) &&
!depends(varlist[i],x)
)
++count;
}
ans = make_term(CONSTANTOFINTEGRATION,(unsigned short)(count+1));
ARGREP(ans,0,make_int(cofi_index));
++cofi_index; /* ready for next time */
k=1;
for(i=0;i<varDLL->nvariables;i++)
{ f = FUNCTOR(varlist[i]);
if(!contains(x,f) && (contains_free(s,f) || depends(s,varlist[i])) &&
(!depends(x,varlist[i]) || isparameter(varlist[i])>=0) &&
!depends(varlist[i],x)
)
{ ARGREP(ans,k,varlist[i]);
++k;
}
}
return ans;
}
/*__________________________________________________________*/
MEXPORT_VAR void initialize_parameter(int i, int linenumber)
/* initialize varlist[i] as a parameter, putting
linenumber into the .linenumber field of the
parameter data structure for the new parameter. */
{ int j;
parameter *parameters = varDLL->parameters;
term *varlist = varDLL->varlist;
char *pname;
/* first check if this variable has already been made a parameter */
for(j=0;j<varDLL->nparameters;j++)
{ if(parameters[j].functor == FUNCTOR(varlist[i]))
return; /* it's already there */
}
if(PREDEFINED_ATOM(FUNCTOR(varlist[i])))
pname = GreekString(varlist[i]);
else
pname = atom_string(varlist[i]);
/* pointer to a static string or an entry in the symbols array */
if (varDLL->nparameters >= varDLL->maxparameters)
#ifndef _Windows
{ return; /* just don't do it; this should rarely happen;
in fact I'm not certain it can happen at all. */
}
#else
{ varDLL->maxparameters += 2;
GlobalReAllocPtr(varDLL->parameters, varDLL->maxparameters*sizeof(parameter),GHND);
}
#endif
parameters[varDLL->nparameters].name = pname;
if(pname[0] == 'b')
parameters[varDLL->nparameters].increment = 0.1;
else
parameters[varDLL->nparameters].increment = 1.0; /* default value of increment */
parameters[varDLL->nparameters].addr = &varDLL->varinfo[i].realpart;
parameters[varDLL->nparameters].index = i;
parameters[varDLL->nparameters].functor = FUNCTOR(varlist[i]);
parameters[varDLL->nparameters].linenumber = linenumber;
*(parameters[varDLL->nparameters].addr) = 1.0; /* default value of parameter */
++varDLL->nparameters;
}
/*_________________________________________________________*/
MEXPORT_VAR void push_parameters(void)
/* push the current values of ALL parameters
onto their respective history lists, provided the
current values are different from what is already at
the head of the list */
{ unsigned i;
unsigned n = varDLL->nparameters;
parameter *parameters = varDLL->parameters;
dlist *marker;
for(i=0;i<n;i++) /* first check if there are new values to push */
{ if(parameters[i].history == NULL ||
*parameters[i].addr != parameters[i].history->data
)
break;
}
if(i==n)
/* nothing to do */
return;
for(i=0;i<n;i++)
{ marker = parameters[i].history;
parameters[i].history = (dlist *) mallocate(sizeof(dlist));
if(parameters[i].history == NULL)
nospace();
parameters[i].history->next = marker;
parameters[i].history->data = * parameters[i].addr;
}
}
/*_________________________________________________________*/
MEXPORT_VAR void clear_parameter_history(void)
/* free the linked lists parameter[i].history */
{ unsigned i;
unsigned n = varDLL->nparameters;
parameter *parameters = varDLL->parameters;
dlist *marker, *prev;
for(i=0;i<n;i++)
{ marker = parameters[i].history;
while(marker)
{ prev = marker;
marker = marker->next;
free2(prev);
}
parameters[i].history = NULL;
}
}
/*_________________________________________________________*/
MEXPORT_VAR int get_index(term t)
/* t must be an atom already in varlist. Return the index i such
that t is varlist[i]. */
{ int i;
int n = varDLL->nvariables;
term *varlist = varDLL->varlist;
assert(ISATOM(t));
for(i=0;i<n;i++)
{ if(FUNCTOR(t) == FUNCTOR(varlist[i]))
return i;
}
assert(0);
return 0;
}
/*__________________________________________________________*/
MEXPORT_VAR int get_eigenindex(void)
{ return varDLL->eigenvariable;
}
/*__________________________________________________________*/
MEXPORT_VAR term get_eigenvariable(void)
{ return varDLL->varlist[varDLL->eigenvariable];
}
/*__________________________________________________________*/
MEXPORT_VAR int get_currentline(void)
{ return varDLL->currentline;
}
/*__________________________________________________________*/
MEXPORT_VAR void set_currentline(int n)
{ varDLL->currentline = n;
}
/*__________________________________________________________*/
MEXPORT_VAR void increment_currentline(void)
{ ++varDLL->currentline;
}
/*__________________________________________________________*/
MEXPORT_VAR void decrement_currentline(void)
{ --varDLL->currentline;
}
/*__________________________________________________________*/
MEXPORT_VAR int get_nvariables(void)
{ return varDLL->nvariables;
}
/*__________________________________________________________*/
MEXPORT_VAR void set_nvariables(int n)
/* used to eliminate recently-defined variables */
{ if (n > varDLL->nvariables)
assert(0);
assert(n >= 0);
if(varDLL->nvariables == n)
return; /* A breakpoint on the next line will catch genuine changes.*/
varDLL->nvariables = n;
}
/*__________________________________________________________*/
MEXPORT_VAR int get_nparameters(void)
{ return varDLL->nparameters;
}
/*__________________________________________________________*/
MEXPORT_VAR void set_nparameters(int n)
{ varDLL->nparameters = n;
}
/*__________________________________________________________*/
MEXPORT_VAR void decrement_nparameters(void)
/* used by undo() to undo 'Regard variable as constant' */
{ assert(varDLL->nparameters > 0);
--varDLL->nparameters;
}
/*__________________________________________________________*/
MEXPORT_VAR void set_eigenvariable(int i)
{ if(varDLL->nvariables == 0)
{ assert(i==0);
varDLL->eigenvariable = 0;
return;
}
if(i >= varDLL->nvariables)
assert(0);
varDLL->eigenvariable = i;
}
/*__________________________________________________________*/
MEXPORT_VAR void init_varDLL(vardata *pData)
/* Called whenever we switch documents; it's passed a pointer
to the new document's DocVarData. Must initialize var.dll to work with
the new document. */
{ varDLL = pData;
}
/*___________________________________________________________*/
MEXPORT_VAR void swapvars(int i, int j)
/* swap varlist[i] and varlist[j] and
also swap varinfo[i] and varinfo[j].
If one of these variables occurs in the parameters array, fix that
entry up also. */
{ varinf saveit;
term temp;
int k;
parameter *parameters = varDLL->parameters;
term *varlist = varDLL->varlist;
varinf *varinfo = varDLL->varinfo;
temp = varlist[i];
saveit = varinfo[i];
varlist[i] = varlist[j];
varinfo[i] = varinfo[j];
varlist[j] = temp;
varinfo[j] = saveit;
LVARGPTR(varlist[i]) = (void *) &varinfo[i].realpart;
LVARGPTR(varlist[j]) = (void *) &varinfo[j].realpart;
/* Now work on the parameters array */
for(k=0;k<varDLL->nparameters;k++)
{ if(parameters[k].index == i)
{ parameters[k].addr = &varinfo[j].realpart;
parameters[k].index =j;
}
else if(parameters[k].index == j)
{ parameters[k].index = i;
parameters[k].addr = &varinfo[i].realpart;
}
}
return;
}
/*_________________________________________________________*/
MEXPORT_VAR term * get_varlist(void)
{ return varDLL->varlist;
}
/*_________________________________________________________*/
MEXPORT_VAR varinf * get_varinfo(void)
{ return varDLL->varinfo;
}
/*_____________________________________________________________*/
MEXPORT_VAR term getvar(term t, char *data)
/* like getnewvar, this gets a variable not contained in t,
chosen if possible from the letters in string data; but getnewvar
always gets a NEW variable, while getvar doesn't care if the
variable is already in use. */
{ int i,j;
term ans;
double z;
char str[2];
int n = strlen(data);
term *varlist = varDLL->varlist;
varinf *varinfo = varDLL->varinfo;
for(i=0;i < n; i++)
{ if( !contains(t,data[i]) )
{ for(j=0;j<varDLL->nvariables;j++)
{ /* check if this letter is already in use */
if(data[i]==FUNCTOR(varlist[j]))
break;
}
if(j<varDLL->nvariables) /* it's already in use */
return varlist[j]; /* done */
/* if we get here, data[i] is ok--use it */
str[0] = data[i];
str[1] = '\0';
ans = make_atom_from_string(str);
break;
}
}
if(i==n)
ans = gensym(data[0]);
vaux(ans); /* put it in varlist and varinfo */
varinfo[varDLL->nvariables-1].scope = varinfo[varDLL->eigenvariable].scope;
/* Now set the value of this variable randomly */
z = local_drandom();
ans.args = (void *) &varinfo[varDLL->nvariables-1].realpart;
SETVALUE(ans,z);
return ans;
}
/*______________________________________________________________________*/
MEXPORT_VAR int let_permanent(term l, term r)
{ defn *defns = varDLL->defns;
int err = let(l,r);
if(err)
return 1;
defns[varDLL->nextdefn-1].permanent = 1; /* don't unwind at the end */
varDLL->eigenvariable = defns[varDLL->nextdefn-1].oldeigen; /* don't change eigenvariable */
return 0;
}
/*______________________________________________________________________*/
MEXPORT_VAR int reverse_let(term l, term r)
/* used for substitutions l = r where l is an old variable and
r contains a new variable. All the new variables have already
been added to varlist.
*/
{ defn *defns = varDLL->defns;
int err = let(l,r);
if(err)
return 1;
defns[varDLL->nextdefn-1].reverse = 1;
return 0;
}
/*______________________________________________________________________*/
MEXPORT_VAR int let(term l, term r)
/* enter the defn 'l=r' (in which l is being defined as r) */
/* does not cause any visible display */
/* currentline is recorded for use by undo */
/* In case of simultaneous definitions, *l and r will be AND terms of the
same arity, e.g. (x,y) = (r cos �, r sin �). None of the variables on
the left side is allowed to occur in any of the right sides */
/* The new variable(s) must be entered in varlist, and its (their) dependencies
on other variables properly recorded. That a variable is dependent on
some other variables is recorded in a certain bit of its .info field by
the macro SET_DEPENDENT; that bit is read by DEPENDENT. If it IS dependent,
which variables varlist[i] depends on are recorded in varinfo[i].dp; the
k-th bit of this 21-bit field tells whether varlist[i] depends on varlist[k].
*/
/* Return 0 for success, 1 for failure (too many variables or out of space) */
/* This function must also cause multcompare to place the (each) newly-defined
variable in the same position in multiplicative order as the
variable in the right side of its definition (the first variable if there
is more than one), so that after a change of variable we don't see a
lot of order-changing. This is accomplished by setting varinfo[i].multorder
to 1; multcompare examines that field. */
/* The lifetime of the terms l and r placed in the defns array will be
determined by the calling program. No 'permanent' copies are made.
Mathpert should call 'permcopy' before passing the args to let, so that
the lifetime will be that of the document. */
/* Since there can be at most 32 variables, there can be at most 32 definitions.
So there's no use in reallocing when we're out of space. We just fail. */
{ int err, eigen;
unsigned i,n;
/* First make sure we have enough space to enter the new definition */
if(varDLL->nextdefn == varDLL->maxdefns)
return 1; /* failure, no more space for definitions. See above. */
/* Now enter the definition */
if(varDLL->defns == NULL)
{ nospace();
return 1;
}
UNPROTECT(r); /* r is local, but this is what will be entered in defns[nextdefn] */
/* if it's protected now, it still should be simplified after
unwind_definitions */
varDLL->defns[varDLL->nextdefn].left = l;
varDLL->defns[varDLL->nextdefn].right = r;
varDLL->defns[varDLL->nextdefn].line = varDLL->currentline + 1;
varDLL->defns[varDLL->nextdefn].visible = 1; /* by default */
varDLL->defns[varDLL->nextdefn].reverse = 0; /* by default */
varDLL->defns[varDLL->nextdefn].permanent = 0; /* by default */
++varDLL->nextdefn;
/* Now put the variables in varlist and enter their dependencies */
if(FUNCTOR(l) == AND)
{ n = ARITY(l);
assert(n == ARITY(r) && FUNCTOR(r)==AND);
eigen = varDLL->eigenvariable;
for(i=0;i<n;i++)
{ err = let_aux(ARG(i,l),ARG(i,r),1);
if(err)
return 1;
}
/* on multiple definitions, let_aux screws up the .oldeigen
field, since it sets the eigenvariable on the first call to
let_aux and then on the second call sets the old eigenvariable
to the new one. Fix this here: */
varDLL->defns[varDLL->nextdefn-1].oldeigen = eigen;
return 0;
}
else
return let_aux(l,r,1);
}
/*____________________________________________*/
MEXPORT_VAR int let_aux(term l, term r, int flag)
/* l should be an atom; add it to varlist, making more space if
necessary; also set l to depend on all atoms in r. If flag is
nonzero, set the 'multorder' field of varinfo when entering l in
varlist, so multiplicative order will treat it like the first
variable in r, and also change the eigenvariable to l, but don't
change the eigenvariable if flag is zero. Also if flag is
nonzero, assume the new variable l has been added by let,
so defns[varDLL->nextdefn-1] is the definition of l, and we
need to adjust dependency information there. However, let_aux
also is called by grbutton when the Graph button is pressed, to
add a new variable for the y-axis, in which case there is no
definition to modify.
Return 0 for success, 1 if the number of variables exceeds
MAXDEPENDS; in this case the new variable is entered in varlist
but the definition is not entered.
Change 'eigenvariable' if varlist[eigenvariable] is being
substituted for. */
{ int i,j,natoms;
unsigned f;
int nonconstantflag = 0;
unsigned long dependsinfo = 0;
term *atomlist;
term *varlist = varDLL->varlist;
varinf *varinfo = varDLL->varinfo;
int whichvar;
assert(ISATOM(l));
vaux(l); /* add l to varlist, making space if necessary; see getprob.c */
if(varDLL->nvariables > MAXDEPENDS)
return 1; /* too many definitions */
if(seminumerical(r))
{ varDLL->defns[varDLL->nextdefn-1].oldeigen = varDLL->eigenvariable;
deval(r,&varinfo[varDLL->nvariables-1].realpart);
varinfo[varDLL->nvariables-1].imagpart = 0;
return 0;
}
if(complexnumerical(r))
{ dcomplex z;
ceval(r, &z);
varinfo[varDLL->nvariables-1].realpart = z.r;
varinfo[varDLL->nvariables-1].imagpart = z.i;
}
natoms = atomsin(r,&atomlist);
whichvar = varDLL->nvariables - 1;
/* usually l = varlist[varDLL->nvariables-1]. But if l was already in varlist,
then this isn't the case. The next few lines will adjust
whichvar so that in EVERY case we have l = varlist[whichvar] */
for(i=0;i<varDLL->nvariables;i++)
{ if(ISATOM(l) && FUNCTOR(l) == FUNCTOR(varlist[i]))
{ whichvar = i;
break;
}
}
if(flag)
varinfo[whichvar].multorder = 1;
if(varDLL->nvariables == 1)
{ /* there were no variables originally, now varlist contains
only l, the variable being defined */
varinfo[varDLL->nvariables-1].dp = 0L;
free2(atomlist);
return 0;
}
for(i=0;i<natoms;i++)
{ /* record that l depends on atomlist[i] */
for(j=0;j<varDLL->nvariables-1;j++)
{ if(FUNCTOR(atomlist[i]) == FUNCTOR(varlist[j]))
break;
}
f = FUNCTOR(atomlist[i]);
if (j>=varDLL->nvariables)
assert(f == 'e' || f == 'i' || f == PI_ATOM);
else
/* l depends on varlist[j]; set bit j of dependsinfo */
{ dependsinfo |= (1L << j);
nonconstantflag = 1;
}
}
if(nonconstantflag)
{ SETDEPENDENT(varlist[whichvar]);
if(flag)
SETDEPENDENT(varDLL->defns[varDLL->nextdefn-1].left);
/* set the 'depends' bit in the definition itself, so
that if a later operator (such as trysubstitution)
fishes it out of there it will have this bit
correctly set. */
}
/* set bit in .info field that says it depends on SOMETHING */
varinfo[whichvar].dp = dependsinfo;
if(flag && contains(r,FUNCTOR(varlist[varDLL->eigenvariable])))
{ /* then l is the new eigenvariable */
varDLL->defns[varDLL->nextdefn-1].oldeigen = varDLL->eigenvariable;
varDLL->eigenvariable = whichvar;
}
else if(flag) /* the variable is introduced by let, but the right side
doesn't contain the eigenvariable */
varDLL->defns[varDLL->nextdefn-1].oldeigen = varDLL->eigenvariable;
free2(atomlist); /* allocated by atomsin */
return 0;
}
/*_______________________________________________________________*/
MEXPORT_VAR int get_nextdefn(void)
/* return the number of definitions currently stored */
{ return varDLL->nextdefn;
}
/*_______________________________________________________________*/
MEXPORT_VAR void set_nextdefn(int n)
/* used to delete assumptions made since a previous time */
/* return the number of definitions currently stored */
{ assert(n <= varDLL->nextdefn);
varDLL->nextdefn = n;
}
/*________________________________________________________________*/
MEXPORT_VAR defn get_defn(int i)
/* return the i-th definition */
{ assert(i < varDLL->nextdefn);
return varDLL->defns[i];
}
/*______________________________________________________*/
MEXPORT_VAR parameter * get_parameters(void)
{ return varDLL->parameters;
}
/*______________________________________________________________________*/
MEXPORT_VAR int undo_letdefns(void)
/* return 1 if any definition is undone, zero if not */
/* Also removes any variables introduced at currentline by the theorem prover */
{ int i,saveit;
defn *defns = varDLL->defns;
varinf *varinfo = varDLL->varinfo;
if(varDLL->nextdefn==0)
{ /* be careful that we don't try to access varinfo[-1] in case
the problem had no variables. */
while(varDLL->nvariables > 0 &&
varinfo[varDLL->nvariables-1].linenumber==varDLL->currentline
)
{ --varDLL->nvariables;
}
return 0;
}
saveit = varDLL->nextdefn;
i = varDLL->nextdefn-1;
while(i>=0 && defns[i].line == varDLL->currentline)
{ /* destroy_term(defns[i].right); no longer necessary as these
are kept in 'permanent' memory */
varDLL->eigenvariable = defns[i].oldeigen;
--varDLL->nextdefn;
--i;
}
while(varDLL->nvariables > 0 &&
varinfo[varDLL->nvariables-1].linenumber==varDLL->currentline
)
--varDLL->nvariables;
return (varDLL->nextdefn == saveit ? 0 : 1);
}
/*____________________________________________________________*/
MEXPORT_VAR defn * get_defns(void)
/* defns.c needs access */
{ return varDLL->defns;
}
/*_____________________________________________________________________*/
MEXPORT_VAR term gensym(char root)
/* produce a new atom with a print name of the form c1, c2, ...c45... */
/* passing 0 or 1 for the root resets the counter to 0 or 1 and returns an ILLEGAL term. */
{ char s[32];
static int gensym_counter;
if(root == 0 || root == 1)
{ term dummy;
SETFUNCTOR(dummy, ILLEGAL,0); /* avoid warning message */
gensym_counter = root;
return dummy; /* return value is irrelevant */
}
sprintf(s+1,"%d",gensym_counter++);
s[0] = root;
/* Now s contains the desired string */
return make_atom_from_string(s);
}
/*______________________________________________________________________*/
/* make_atom_from_string is the way in which atoms are originally to be
created, even if the string has length 1.
*/
MEXPORT_VAR term make_atom_from_string( char *a)
/* If you change this, change make_atom_from_string2 in parser.c too.
Use predefined atoms for pi, eulere; that way their value pointers
will point to the correct decimal value.
However, "i" is not returned as complexi.
*/
{ unsigned short atom;
term ans;
atom = string_to_atom(a);
if(atom == PI_ATOM)
return pi;
if(atom == 'e')
return eulere;
SETFUNCTOR(ans,atom,0);
ZEROINFO(ans); /* make sure the .info field is zero */
/* Now set the type of the variable */
if(atom == 'i')
SETCOMPLEX(ans);
else if( *a == 'n' || *a == 'm' || *a == 'k' || *a == 'j')
SETTYPE(ans,INTEGER);
else
SETTYPE(ans,R);
return ans;
}
/* _________________________________________________________________*/
MEXPORT_VAR unsigned short string_to_atom(char *x)
/* If you change this, change the static copy in parser.c too */
{ if(x[1] == '\0') /* a one-symbol atom */
/* We do not recognize extended character codes for Greek letters.
The name of the Greek letter must be typed out.
*/
return x[0];
switch( x[0])
{ case 'a':
if( !strcmp(x,"alpha"))
return ALPHA;
break;
case 'b':
if( !strcmp(x,"beta"))
return BETA;
break;
case 'd':
if( !strcmp(x,"delta"))
return DELTA;
break;
case 'e':
if( !strcmp(x,"epsilon"))
return EPSILON;
break;
case 'f':
if( !strcmp(x,"false"))
return FALSEFUNCTOR;
break;
case 'g':
if( !strcmp(x,"gamma"))
return LITTLEGAMMA;
break;
case 'i':
if( !strcmp(x,"infinity"))
return INFINITY;
if( !strcmp(x, "infty"))
return INFINITY;
break;
case 'l':
if( !strcmp(x,"lambda"))
return LAMBDA;
break;
case 'm':
if( !strcmp(x,"mu"))
return MU;
break;
case 'p':
if( !strcmp(x,"phi"))
return PHI;
if( !strcmp(x,"pi"))
return PI_ATOM;
break;
case 's':
if( !strcmp(x,"sigma"))
return SIGMA;
break;
case 't':
if( !strcmp(x,"theta"))
return THETA;
if( !strcmp(x,"true"))
return TRUEFUNCTOR;
break;
case 'z':
if( !strcmp(x,"zeta"))
return RIEMANNZETA;
break;
}
return newatom(x);
}
/*__________________________________________________________*/
static void vvaux(term t, term **atomlist, int *nvars, int *maxvars)
/* continue adding new atoms to atomlist, which has dimension
*maxvars; *nvars is the dimension so far used.
If it isn't big enough, make more space using reallocate;
this static function is called only from this file, where
space is allocated using callocate. This function DOES
add PI, EULERE, and INFINITY, but not LEFT and RIGHT.
*/
{ int i;
unsigned a = FUNCTOR(t);
if(ISATOM(t))
{ if(FUNCTOR(t)==LEFT || FUNCTOR(t)==RIGHT)
return; /* ignore LEFT and RIGHT */
/* determine if t is already in atomlist */
for(i=0;i < *nvars;i++)
{ if(FUNCTOR((*atomlist)[i]) == a)
break; /* already there */
}
if(i== *nvars) /* wasn't already there, must add it */
{ if( *nvars < *maxvars -2) /* go ahead and add it */
{ (*atomlist)[*nvars] = t;
++ *nvars;
}
else /* get more space and then add it */
{ *maxvars += 10;
*atomlist = (term *) reallocate(*atomlist, *maxvars * sizeof(term));
(*atomlist)[*nvars] = t;
++ *nvars;
}
}
return;
}
if(OBJECT(t))
return ;
/* so now it's a compound term */
for(i=0;i<ARITY(t);i++)
{ vvaux(ARG(i,t),atomlist,nvars,maxvars);
}
}
/*__________________________________________________________*/
MEXPORT_VAR int isparameter(term x)
/* If x is a parameter, return its index in the parameters array;
if not, return -1 */
{ int i;
parameter *parameters = varDLL->parameters;
if(!ISATOM(x))
return -1;
for(i=0;i<varDLL->nparameters;i++)
{ if(FUNCTOR(x)==parameters[i].functor)
return i;
}
return -1;
}
/*____________________________________________________________*/
MEXPORT_VAR int is_letdefined(term u, term *ans)
/* return 1 if u is let-defined, putting its definition in *ans;
or return 0 if u is not let-defined. It presumes u is an atom. */
{ int i;
defn *defns = varDLL->defns;
if(!ISATOM(u))
return 0;
for(i=0;i<varDLL->nextdefn;i++)
{ if(FUNCTOR(defns[i].left) == FUNCTOR(u))
{ *ans = defns[i].right;
return 1;
}
}
return 0;
}
/*_____________________________________________________________*/
MEXPORT_VAR void undo_parameters(int currentline)
/* remove all parameters introduced at linenumbers >= currentline */
/* assumes that the parameters have all been created by initialize_parameter,
so they are in chronological order in the parameters array. */
{ int i;
parameter *parameters = varDLL->parameters;
for(i=0;i<varDLL->nparameters;i++)
{ if(parameters[i].linenumber >= currentline)
break;
}
varDLL->nparameters = i;
}
/*____________________________________________________________*/
static char *compute_subscripted_varname(term expr)
/* compute the print string for a subscripted variable.
Return a string in space created by callocate */
{ char buffer[32];
char *printstring;
char *q;
term temp = expr;
int subscript;
unsigned short f = FUNCTOR(expr);
SETFUNCTOR(temp,VARNAME(f),0);
q = atom_string(temp);
strcpy(buffer,q);
subscript = SUBSCRIPT(f)-1;
sprintf(buffer + strlen(buffer),"%d", subscript);
/* Now the right string is in buffer */
printstring = callocate(strlen(buffer)+1,sizeof(char));
strcpy(printstring,buffer);
return printstring;
}
/*_____________________________________________________________*/
static unsigned long lowbits(unsigned long x, int i)
/* return a long with bits 0, ..., i-1 the same as x and
higher bits zero. */
{ unsigned long mask = (unsigned long) -1; /* all bits 1 */
int nbits = 8 * sizeof(unsigned long);
mask = (mask >> (nbits-i)); /* shift nbits-1 zeroes in from the left */
return x & mask;
}
/*_____________________________________________________________*/
static unsigned long highbits(unsigned long x, int i)
/* return a long with bits i+1,... the same as x
and bits 0,...,i set to zero
*/
{ unsigned long mask = (unsigned long) -1; /* all bits 1*/
mask = mask << (i+1); /* shift in i+1 zero bits from the right */
return x & mask;
}
/*_____________________________________________________________*/
MEXPORT_VAR int deletevar(term x)
/* remove atom x from varlist, moving all subsequent
variables down one and resetting nvariables. Adjust
dependency information of any variables that depend on
the moved variables. Return 1 if the variable is
found and deleted, 0 if it is not in varlist or if x
is not an atom.
*/
{ int i,j;
term *varlist = varDLL->varlist;
unsigned long r;
int nvariables = varDLL->nvariables;
varinf *varinfo = varDLL->varinfo;
if(!ISATOM(x))
return 0;
for(i=0; i< nvariables; i++)
{ if(FUNCTOR(x) == FUNCTOR(varlist[i]))
break;
}
if(i == nvariables)
return 0; /* variable not found */
/* Check whether any variable depends on this variable */
for(j=0;j<nvariables;j++)
{ r = (1L << i);
if(varinfo[j].dp & r)
return 1; /* refuse to delete */
}
/* OK, now move subsequent ones down */
for(j=i+1; j<nvariables; j++)
{ varlist[j-1] = varlist[j];
varinfo[j-1] = varinfo[j];
}
--varDLL->nvariables;
--nvariables;
for(j=0;j<nvariables;j++)
{ /* adjust dependency information */
r = varinfo[j].dp;
if(r >> i)
{ /* varlist[j] depended on the i-th or later variable */
varinfo[j].dp = lowbits(r,i) | (highbits(r,i) >> 1);
}
}
return 0;
}
/*_______________________________________________________*/
MEXPORT_VAR term firstdepends(term x)
/* x must be a variable. Return the first variable that x
depends on, other than x itself; if x depends on no other
variable then return x.
*/
{ int i,j;
term *varlist = varDLL->varlist;
unsigned long d;
int nvariables = varDLL->nvariables;
varinf *varinfo = varDLL->varinfo;
for(i=0;i<nvariables;i++)
{ if(FUNCTOR(varlist[i]) == FUNCTOR(x))
break;
}
assert(i<nvariables); /* you must find x in the varlist */
if(varinfo[i].dp == 0)
return x;
for( j=0,d = varinfo[i].dp; d && ((!(d&1)) || j==i) ; ++j )
d = d >> 1;
if(d==0)
return x;
return varlist[j];
}
/*______________________________________________________________________*/
MEXPORT_VAR unsigned short bound_in(term x, term t)
/* if variable x occurs bound in t, return the binding functor.
If not, return 0. */
{ unsigned short f,n,ans;
int i;
if(ATOMIC(t))
return 0;
f = FUNCTOR(t);
n = ARITY(t);
if(f == LIMIT && equals(x,ARG(0,ARG(0,t))))
return LIMIT;
if((f == LAM || f == FORALL || f == EXISTS || f == BIGOH) && equals(x,ARG(0,t)))
return f;
if((f == SUM || f == PRODUCT || f == DIFF || f == INTEGRAL) && equals(x,ARG(1,t)))
return f;
for(i=0;i<n;i++)
{ ans = bound_in(x,ARG(i,t));
if(ans)
return ans;
}
return 0;
}
/*_________________________________________________________________*/
MEXPORT_VAR void set_valuepointers(term *t)
/* set the .args field of each atom in *t correctly, using the
corresponding entry in varlist
*/
{ int i;
unsigned short f,n;
int nvariables = get_nvariables();
term *varlist = get_varlist();
if(ISATOM(*t))
{ f = FUNCTOR(*t);
for(i=0;i<nvariables;i++)
{ if(f == FUNCTOR(varlist[i]))
{ t->args = varlist[i].args;
SETTYPE(*t,TYPE(varlist[i]));
/* in Mathpert, these should be the same anyway; in
Weierstrass, varlist[i] may have had its type set
by the parser when it parsed e.g. x:N, and later
occurrences of 'x' don't have their types set until
this function is called. */
return;
}
}
switch(f)
{ case PI_ATOM: t->args = pi.args;
return;
case 'e' : t->args = eulere.args;
return;
case 'i' : t->args = complexi.args;
return;
case RIGHT:
case LEFT: /* direction indicators for one-sided limits are
not put into varlist, so they have no value pointers. */
case BOUNDED_OSCILLATIONS:
case UNBOUNDED_OSCILLATIONS:
case UNDEFINED: /* no value pointer for undefined */
case INFINITY: return; /* no value pointer for infinity */
case ILLEGAL: return; /* abstract on a LINEARSYSTEM term gets here */
case TRUEFUNCTOR: return;
case FALSEFUNCTOR: return;
case VAR: return;
case PSEUDOATOM: return;
default : assert(0);
/* you should have found the atom in varlist */
}
}
if(OBJECT(*t))
return;
n = ARITY(*t);
for(i=0;i<n;i++)
{ set_valuepointers(ARGPTR(*t) +i);
}
}
/*_______________________________________________________________*/
MEXPORT_VAR void set_dependency_info(term u, term t)
/* u must be a variable. Set the dependency info in
varinfo to show u depending on all variables in t.
t must contain at least one variable.
*/
{ term *varlist = get_varlist();
int nvariables = get_nvariables();
varinf *varinfo = get_varinfo();
int i,j;
unsigned long dpinfo = 0L;
for(i=0;i<nvariables;i++)
{ if(equals(u,varlist[i]))
break;
}
if(i==nvariables)
assert(0);
/* Now set bits in dpinfo corresponding to the atoms in t */
for(j=0;j<nvariables;j++)
{ if(j==i)
continue;
if(contains(t,FUNCTOR(varlist[j])))
dpinfo |= (1<<j);
}
varinfo[i].dp = dpinfo;
}
/*_______________________________________________________________________________*/
MEXPORT_VAR void bindvar(term x)
/* set the variable x's scope in varinfo to BOUND */
{ term *varlist;
int nvariables,i;
varinf *varinfo;
if(!ATOMIC(x))
return;
varlist = get_varlist();
nvariables = get_nvariables();
varinfo = get_varinfo();
for(i=0;i<nvariables;i++)
{ if(FUNCTOR(varlist[i]) == FUNCTOR(x))
{ varinfo[i].scope = BOUND;
return;
}
}
}
/*_______________________________________________________________________________*/
MEXPORT_VAR void unbindvar(term x)
/* set the variable x's scope in varinfo to UNBOUND */
{ term *varlist;
int nvariables,i;
varinf *varinfo;
if(!ATOMIC(x))
return;
varlist = get_varlist();
nvariables = get_nvariables();
varinfo = get_varinfo();
for(i=0;i<nvariables;i++)
{ if(FUNCTOR(varlist[i]) == FUNCTOR(x))
{ varinfo[i].scope = UNIVERSAL;
return;
}
}
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists