Sindbad~EG File Manager
/* Mathpert parser */
/* M. Beeson */
/*____________________________________________________________________*/
/* Parse an input string. Return (indirectly) a term as defined in terms.h.
Zero return value indicates no error */
/* If input does not parse, return an error number, and indirectly return
a pointer to the unparsed portion of the input string. This pointer
can be used to position the cursor, and the error number can be used
to get an error message. Neither of these things is handled in
this file. */
/*____________________________________________________________*/
/*
Original date 5.14.90
10.24.99 modified
2.4.00 modified funcname and function_term to ignore initial backslash
2.4.00 modified relop to accept TeX for LE, GE, NE.
2.4.00 modified term1 to accept TeX "\over"
2.4.00 modified greek to accept TeX "\beta", etc.
3.30.00 added code involving 'PROVISIONAL' to get parentheses retained
in (a+b) + (c+d)
3.31.00 added strip_provisional
3.26.01 modified strip_functor and string_functor and correct_arity to make
CONSTANTOFINTEGRATION parseable so it will cut-and-paste
8.3.02 corrected string_functor where "lam" should be "LAM"
6.23.04 added definefn and undefinefn; modified funcname to check for a defined function;
modified correct_arity, removing reliance on userfunc.dll.
Guarded all calls to isalpha to make sure it never gets a negative argument,
since that causes a crash.
6.29.04 corrected one of the 6.23 changes where in[i] should be in[1].
6.29.04 modified function_term, and added "LAMBDA" where "LAM" is so
that lambda(x,t) can be parsed as a function term as well as an identifier.
Added lambda_tail to parse lambda terms for Otter-lambda.
7.1.04 added *t = x at line 899 where /= is encountered.
9.2.04 added pmake_term to this file.
9.2.04 modified at comment "don't pass high ascii to isalnum", and at lines 1343, 2067,
1465, and 1467 similarly, so as not to pass high ascii to isdigit
9.4.04 replaced calls to MAKE_ATOM, and calls to make_term within definition
pmake_term, pmake_int, pmake_double, with pmake_term.
Replaced ltoa with sprintf.
9.5.04 modified string_to_atom to handle subscripted variables. Now newatom does not need
to be defined unless you want to handle multi-character identifiers like "mass".
Added get_decimalchar so pstring can be moved into parser.dll
9.6.04 modified line 1104, because isascii doesn't do what I thought. This is executed
only when unwritten_mult is zero, which never happens in MathXpert.
Changed definefns to take an unsigned short instead of an int in second argument.
Replaced strdup, which it turns out is not ANSI C, with calloc and strcpy.
9.9.04 added "infty" to string_to_atom
7.21.05 corrected at the dated lines.
7.23.05 extended at the dated line to parse and(p,q) where p,q are rexprs instead of just exprs.
10.25.05 added LVARGPTR at line 128
2.18.05 added CASES to string_functor.
added ifterm and casesterm.
removed code for IF from lterm1.
add call to casesterm to function_term.
These changes allow parsing
f(x) = cases(1-x^2 if x <= 0, 2x-1 if x>0)
f(x) = cases(if(x <= 0, 1-x^2), if(x>0, 2x-1))
f(x) = cases(1-x^2 if x <= 0, 2x-1 if x>0, 0) (using an implicit "otherwise")
f(x) = cases(if(x <= 0, 1-x^2), if(x>0, 2x-1),0)
2.26.07 modified 'number' to handle 1.e+012
8.19.07 added POLYGAMMA to correct_arity.
modified string_to_atom2 and make_atom_from_string2 and greek for eulergamma
7.31.10 modified line 420 where function_letters is null-terminated, to correct an out-of-bounds error found by VS2010.
4.18.13 added two casts (int) strlen(...
5.4.13 fixed some minor issues found by Xcode: removed stricmp
in processing Eulergamma; removed some unused variables; prototype
of ncomma needs return type; changed constant_int to constant_int2.
5.4.13 copied contents of const2.c into this file, making everything static, to avoid duplicate definitions.
5.15.13 added BERNOULLI to strip_functor and correct_arity.
5.17.13 moved if(err) return err above callocate in fix_bignums
5.21.13 removed OEM character for >= from relop
added EULERNUMBER to strip_function and correct_arity
6.1.13 added EULERNUMBER, EULERGAMMA, and BERNOULLI to string_functor.
6.5.13 added RIEMANNZETA to correct_arity.
6.21.13 changed 'pi' to 'parser_pi' to avoid a warning from Xcode
6.27.13 corrected set_parserflags to use 8 instead of NFUNCTIONLETTERS in strncpy
7.12.13 corrected string_functor, where "ABS" in quotes had been replaced by ABSFUNCTOR
9.25.14 added assert(err==0) at line 1413 and removed some code for the contrary case.
due to a global replace.
Initialized count=0 at the beginning of function_term.
Removed a bunch of unused static variables such as piover2.
11.24.23 modified relop for UTF-8 le, ge; and modified the code for DEG similarly
and modified ident so it won't reject those UTF-8 codes
6.17.24 added rho and psi to greek and string_to_atom
8.31.23 added PR to strip_functor
11.14.24 changed strip_functor to accept sgn as well as sg
12.6-7.24 altered primary and lexpr1 to permit parsing both |x| and A | B (as or(A,B))
1.13.25 removed two comment symbols in interval_term that prevented compilation. I don't know
how those mistaken comment symbols got in here.
1.13.25 added OR to strip_functor.
1.14.25 in primary_tail, replaced rexpr by lfactor to parse or(J(n,x), -10 < x < 10).
*/
#include <math.h>
#include <stdio.h>
#include <ctype.h>
#include <string.h>
#include <assert.h>
#include <stdlib.h>
#include "terms.h"
#include "parser.h"
#include "dispfunc.h" /* newatom, newfunctor */
static term make_atom_from_string2( char *a);
static int parser_initialized;
static void parser_copy(term t, term *ans); /* copy a term */
static char decimalchar = '.';
char get_decimalchar(void)
{ return decimalchar; // needed in pstring.c
}
static int ncommas(char *x);
static term constant_int2( int i);
static const term parser_pi, eulere, eulergamma,minusone;
#define MAXCONSTANTINT 10
/* the following two function pointers are set by setup_parser
to point to actions in the calling program which are taken
when a new functor or new atom is encountered. */
#define SUBSCRIPTABLE(x) ((x) == BESSELJ || (x)==BESSELY || (x)==BESSELI || (x) == BESSELK)
/*_____________________________________________________________________________*/
static term pmake_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.) */
/* This is a copy of make_term in var.c, used here to make the parser more
modular. For example, if you want to use the parser in another project and
use calloc instead of the MathXpert function callocate, change it in this
function (in one place only) and it's done. */
{ 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 term pmake_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_int2((int ) n);
q = (long *) mallocate(sizeof(term)); // so we can copy a term from her
LVARGPTR(ans) = (arg *) 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 = pmake_term('-',1);
ARGREP(ans,0,pmake_int(y));
SETTYPE(ans,INTEGER);
SETAE(ans);
return ans;
}
}
/*___________________________________________________________*/
static term pmake_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)
nospace();
else
((double *) ans.args)[0] = x;
SETARGS(ans);
return ans;
}
else /* now x < 0 */
{ double y= -x;
ans = pmake_term('-',1);
ARGREP(ans,0,pmake_double(y));
SETAE(ans);
SETTYPE(ans,DOUBLE);
return ans;
}
}
/*______________________________________________________________________________*/
static term make_fake_bignum(char *x);
/* Each nonterminal of the grammar corresponds to a function working as
above, except that negative return value only means failure to parse
this nonterminal (not an actual error). Positive value means actual
error causing termination of effort to parse. 0 means success. */
/* Space allocation considerations. Terms have a head and args. The
head of a term is all that is allocated by the declaration term t.
Nonterminal functions can create terms this way and pass them to other
nonterminals as input. Space for arguments is created by make_term,
which uses malloc. Effects of make_term are undone by RELEASE.
Thus t= pmake_term(f,arity) allocates space pointed to by t.args,
and RELEASE(t) frees it. A call to make_term followed later by
a call to RELEASE in the same function leaves space unchanged.
However, sometimes the RELEASE call has to come in another
function.
Specifically, when a term t is declared and passed into a function which
returns an error, then we should theoretically free all the args which
have (recursively) been allocated between the call and its return.
This job is done by destroy_term, which recursively frees all the
args of a term, but leaves the head of the term untouched.
Destroy_term should thus be called only in the body of the function
where its argument is declared.
ARGREP copies terms from local space into the
space created by make_term. Hence no errors arise from having
nonterminals use declarations term t; and then using t to make terms that
are passed out of the function where t is declared.
*/
/* Global variables controlling the parser: */
static char *pminus; /* used in parser.c to point to - in a+ (-b) if user enters it */
/* but is never used by Mathpert as of 5.4.94 */
static int bignumflag; /* set and examined by bparse() to see if real or
fake bignums should be made */
static char function_letters[8] = "fFgGhH";
/* so f(x+y) is a function term but c(x+y) is c*(x+y) */
/* Mathpert makes this "fg" when doing limits so h(x+y) is h*(x+y) */
/* Search for "ambiguity" below to read more about this. */
#define NFUNCTIONS 16 // max number of user-defined functions
static char *defined_functions[NFUNCTIONS];
static unsigned short defined_functors[NFUNCTIONS]; // functors to use for the defined functions
static unsigned short defined_arities[NFUNCTIONS];
/*__________________________________________________________________*/
void definefn(char *f,unsigned short arity)
{ int i;
for(i=0;i<NFUNCTIONS; i++)
{ if(defined_functions[i] && !strcmp(defined_functions[i],f))
return;
}
for(i=0;i<NFUNCTIONS;i++)
{ if(!defined_functions[i])
{ defined_functions[i] = calloc(strlen(f)+1,sizeof(char));
strcpy(defined_functions[i],f);
defined_functors[i] = newfunctor(f,arity);
defined_arities[i] = arity;
break;
}
}
}
/*__________________________________________________________________*/
void undefinefn(char *f)
{ int i;
for(i=0;i<NFUNCTIONS; i++)
{ if(!strcmp(defined_functions[i],f))
{ free(defined_functions[i]);
defined_functions[i] = NULL;
defined_functors[i] = 0;
defined_arities[i] = 0;
break;
}
}
}
/*__________________________________________________________________*/
/* The parser is a 'recursive descent' parser. The grammar is thus
without left-recursion. Here's the grammar:
lexpr --> lterm, lexpr1.
lexpr1 --> OR, lterm, lexpr1 | [].
lterm --> lfactor,lterm1.
lterm1 --> AND, lfactor,lterm1 | [].
lfactor --> NOT, blank_list, lfactor | rexpr.
rexpr --> expr, relop, expr | expr
relop --> GE, LE, < , > , ARROW, NE, SEQ
expr --> blank_list, term0, blank_list, expr1.
expr1 --> ( for example a + (-b) )
'+', blank_list, '(', blank_list, '-', blank_list, term, blank_list, ')',
blank_list, expr1.
expr1 --> '+', blank_list, term, expr1.
expr1 --> '->', blank_list, expr, expr1.
ineq --> expr, relop, expr.
expr1 --> '-', blank_list, term, expr1.
expr1 --> blank_list.
term0 --> '-', blank_list, pterm. ( term or minus a term )
term0 --> pterm.
pterm --> pfactor, term1.
term1 --> '*', blank_list, pfactor, term1.
term1 --> '/', blank_list, pfactor, term1.
term1 --> ':', blank_list, ptype.
term1 --> pfactor,term1. ( accepting unwritten '*' )
term1 --> blank_list.
pfactor --> primary, factor1.
ifterm -->'if', blank_list, ineq.
ifterm1--> ',', blank_list, ifterm1;
casesterm--> "cases",blank_list, '(',ifterm,blank_list,ifterm1,blank_list, ')'.
casesterm--> "cases",blank_list, '(',ifterm,blank_list,ifterm1,blank_list,term0 ')'.
(the last arg doesn't have to be an ifterm)
ptype --> atomic_type (that means 'R', 'C', 'Z', 'N').
later more complex type formation rules can be added.
aterm --> '*', blank_list,afactor, aterm.
aterm --> '/', blank_list,afactor,term1.
aterm --> afactor,aterm.
aterm --> blank_list.
afactor --> aprimary, factor1.
(like term1 but won't take a product including a function name)
Since primary and aprimary differ only in one line, they are
coded together and an extra (first) parameter is passed, 0 for
primary and 1 for aprimary.
factor1 --> '^', blank_list, primary, blank_list, factor1.
factor1 --> '^', blank_list, '-', primary, blank_list,factor1.
factor1 --> '!', blank_list. ( future postfix functions go here )
factor1 --> {'}*,blank_list. (as in u'')
factor1 --> blank_list.
primary --> number, blank_list.
primary --> '(', blank_list, lexpr, ')', blank_list.
primary --> '[', blank_list, lexpr, ']', blank_list.
primary --> '{', blank_list, lexpr, '}', blank_list.
( for vectors and matrices;
braces around one item are accepted as a grouping symbol)
primary --> '|', blank_list, expr, '|', blank_list. (for ABSFUNCTOR)
primary --> function_term.
primary --> ident.
function_term --> funcname, after_funcname.
function_term --> funcname, {'}*, primary_tail. [ f''(x,y) for example]
aprimary is like primary but without the 'funcname' rule.
after_funcname --> | ^, pfactor, primary_tail
| primary_tail
primary_tail(x) -->
in case unifunc(x) pfactor, aterm.
else
primary_tail(x) --> list of correct number of args separated by commas
and surrounded by matching parens or brackets (not braces)
And it only accepts an integer as the first arg of
ROOT or Bessel functions.
*/
/*_____________________________________________________________*/
static int lexpr(term *expr,char *in,char **out);
static void blank_list(char *in, char **out);
static int lexpr1(term x, term *expr,char *in,char **out);
static int lterm(term *t, char *in, char **out);
static int lterm1(term x, term *expr,char *in,char **out);
static int lfactor(term *f, char *in, char **out);
static int rexpr(term *t, char *in, char **out);
static int relop(unsigned short *functorp, char *in, char **out);
static int expr(term *e, char *in, char **out);
static int expr1(term x, term *e, char *in, char **out);
static int term0( term *ans, char *in, char **out); /* either a term or minus a term */
static int pterm(term *t, char *in, char **out); /* changed from 'term' because
the compiler won't allow a function and a type to have the same name */
static int term1(term x, term *t, char *in, char **out);
static int pfactor(term *f, char *in, char **out);
static int factor1(term x, term *ans, char *in, char **out);
static int primary(int flag, term *p, char *in, char **out);
static int function_term(term *p, char *in, char **out);
static int after_funcname(unsigned short x, unsigned short arity, term *p, char *in, char **out);
static int primary_tail(unsigned short x, unsigned short arity,term *ans, char *in, char **out);
static int limit_tail(term *ans, char *in, char ** out);
static int aterm(term x, term *t, char *in, char **out);
static int afactor(term *f, char *in, char **out);
static int ident(term *ans,char *in, char **out);
static int greek(term *ans, char *in, char **out);
static int number(term *p, char *in, char **out);
static int funcname(unsigned short *f, char *in, char **out);
static int intervalterm(term expr, term *ans, char *in, char **out);
static int ptype(term *t, char *in, char **out);
static int integer(term *t, char *in, char **out);
static int lambda_tail(term *ans, char *in, char ** out);
/*___________________________________________________________________*/
static int complex, separator, unwritten_mult,
long_identifiers, letflag;
/*___________________________________________________________________*/
/* The first time the parser is called, it will call setup_parser;
so the programmer doesn't have to remember to do that.
The parser uses heap.dll to create its terms, so the
program calling the parser should have already initialized the heap,
using create_heap (if multiple heaps are in use) or init_heap (for a
single heap). The space used by the heap belongs to the calling
program.
*/
/*___________________________________________________________________*/
static void setup_parser( parser_control * flags)
/* the control variables are packed into a structure of type parser_control,
which is passed by reference. */
/* Set the static globals corresponding to the args */
{ complex = flags->complex;
separator= flags->separator;
decimalchar = flags->decimalchar;
unwritten_mult = flags->unwritten_mult;
long_identifiers = flags->long_identifiers;
strncpy(function_letters,flags->functions,8);
letflag = flags->letflag;
function_letters[sizeof(function_letters)-1] = '\0'; /* just to be sure it's null-terminated */
parser_initialized = 1; /* if parser.dll is unloaded, when it is
reloaded this static variable will be
zero again. */
}
/*___________________________________________________________________*/
int parse(parser_control *flags, term *expr,char *in,char **out)
/* the return value is the error code; 0 is success */
/* Parses string "in" returning term expr. Note: bignums are
returned as character strings.
"out" returns indirectly the first character not processed. If
there is no error, that will be the null at the end of "in". */
{ int err;
pminus = NULL; /* set global variable */
if(flags == NULL)
{ parser_initialized = 0;
return 1;
/* Next time, setup_parser will be called */
}
if(!parser_initialized)
setup_parser(flags);
err = lexpr(expr,in,out);
letflag = flags->letflag; /* restore original value; parser can
change this variable and if you don't
reset it, next parse can be wrong */
if (err)
return err;
/* but even if err==0 it can still be an error, if there is unused input*/
if (*out[0] == '\0')
{ // char buffer[256];
// pstring(*expr,buffer,256); // use these lines to test pstring.
return 0;
}
if (*out[0] == ')' )
return 313; /* Parentheses unbalanced */
if (*out[0] == ']' )
return 314; /* Brackets unbalanced */
if (*out[0] == '}' )
return 315; /* Braces unbalanced */
else
return 316; /* Can't understand this */
}
/*___________________________________________________________________*/
/* lexpr --> lterm, lexpr1. */
static int lexpr(term *expr,char *in,char **out)
{ term t;
int err;
char *next;
err = lterm(&t,in,&next);
if (err < 0)
{ *out = in;
return 0; /* succeed eating nothing */
}
if (err > 0)
{ *out = next;
return err; /* failure to parse */
}
err = lexpr1(t,expr,next,out);
return err;
}
/*_________________________________________________________________*/
static void blank_list(char *in, char **out)
/* eat blanks */
{ *out = in;
while( (**out == 32) && (**out != '\0'))
++ *out;
}
/* _________________________________________________________________*/
/* lexpr1 --> OR, lterm, lexpr1 | []. */
static int lexpr1(term x, term *expr,char *in,char **out)
/* x is the lexpr already processed */
/* Several functions, like this one, pass a term x in and get a new
term out indirectly. Space allocation has to be handled carefully in
this situation: (1) if the term-out is made equal to the term-in,
then we have to be sure that it is given permanent space. If the term-in
is in local space and we simply set the term-out equal to it, it will not
be in safe space. (2) If, on the other hand, the term-in is allocated
by calloc, and the term-out is not made equal to it, then we'll be using
up space.
*/
{ term t;
int err;
term nextx;
unsigned short f = FUNCTOR(x);
char *next,*rest;
int i;
if ((in[0] == '|') && (in[1] == '|')) // accept || for OR
blank_list(in+2,&next);
else if (in[0] == '|') // accept | for OR
blank_list(in+1,&next);
else if (in[0] == ';' )
{ *out = in;
return 328;
/*Semicolon can only be used after 'if' in a definition by cases.
Separate elements of a list by comma. */
}
else
{ *out = in;
*expr = x;
return 0; /* lexpr1 --> []. */
}
/* now have received an OR */
err = lterm(&t,next,&rest);
if (err > 0)
{ *out = next;
return err;
}
if (err < 0) /* failure to get another lterm, which we had to do,
so this is an error */
{ *out = next;
err = 257; /* "Logical expression must follow logical OR" */
return err;
}
if(f == OR || f == CASES) /* then append the arguments */
{ nextx = pmake_term(f,(unsigned short) (ARITY(x) + 1));
for(i=0;i<ARITY(x);i++)
ARGREP(nextx,i,ARG(i,x));
RELEASE(x); /* since ARG(i,x) has been copied to new space
pointed to by nextx.args */
ARGREP(nextx,ARITY(x),t);
err = lexpr1(nextx,expr,rest,out); /* no error */
return err;
}
else /* x doesn't have functor OR or CASES */
{ nextx = pmake_term((unsigned short)(in[0] == ';' ? CASES : OR),2);
ARGREP(nextx,0,x);
ARGREP(nextx,1,t);
err = lexpr1(nextx,expr,rest,out); /* no error */
return err;
}
}
/*__________________________________________________________________*/
static int lterm(term *t, char *in, char **out)
{ term f;
char *next;
int err;
err = lfactor(&f,in, &next) ;
if(err > 0)
{ *out = next;
return err;
}
if(err < 0)
{ *out = in;
return 259; /* Term expected */
}
err = lterm1(f,t,next,out);
return err;
}
/*______________________________________________________________________*/
/* lterm1 --> AND, lfactor,lterm1 | []. */
/* starts with something like ",b,c)" for example where x is the
term representing "a" which has already been processed.*/
static int lterm1(term x, term *expr,char *in,char **out)
/* x is the lterm already processed */
{ term t;
term nextx;
char *next, *rest;
int i,err;
if ((in[0] == '&') && (in[1] == '&'))
blank_list(in+2,&next);
else if (in[0] == '&' )
blank_list(in+1,&next);
else if (in[0] == ',' )
blank_list(in+1,&next);
else /* lterm1 --> []. */
{ *out = in;
*expr = x;
return 0;
}
/* now have received an AND */
err = lfactor(&t,next,&rest);
if (err > 0)
{ *out = next;
return err;
}
if (err < 0) /* failure to get another lfactor, which we had to do,
so this is an error */
{ *out = next;
err = 258; /* "Logical expression must follow logical AND" */
return err;
}
if( FUNCTOR(x) == AND && !ISINTERVAL(x) ) /* then append the arguments */
/* but if x is an interval don't append args */
{ nextx = pmake_term(AND,(unsigned short) (ARITY(x) + 1));
for(i=0;i<ARITY(x);i++)
ARGREP(nextx,i,ARG(i,x));
RELEASE(x);
ARGREP(nextx,ARITY(x),t);
err = lterm1(nextx,expr,rest,out); /* no error */
return err;
}
else /* neither x nor t has functor AND, or x is an interval */
{ nextx = pmake_term(AND,2);
ARGREP(nextx,0,x);
ARGREP(nextx,1,t);
err = lterm1(nextx,expr,rest,out); /* no error */
return err;
}
}
/*_________________________________________________________________*/
static int lfactor(term *f, char *in, char **out)
{ char *next;
char *nextafterblanks;
term arg;
int err;
if( in[0] == '~')
next = in + 1;
else
{ err = rexpr(f,in,out); /* in doesn't begin with NOT */
if(!err && **out == '<' && (FUNCTOR(*f) == '<' || FUNCTOR(*f) == LE))
/* check for an interval term a <= x <= b */
{ char *temp;
term ans;
err = intervalterm(*f,&ans,*out,&temp);
if(!err)
{ *out = temp;
*f = ans;
return 0;
}
}
return err;
}
/* Now in DOES begin with NOT */
*f = pmake_term(NOT,1);
blank_list(next,&nextafterblanks);
err = lfactor(&arg,nextafterblanks,out);
if (err > 0)
return err;
if (err < 0)
{ *out = nextafterblanks;
return 256; /* "Logical expression must follow NOT" */
}
ARGREP(*f,0,arg);
return 0;
}
/*___________________________________________________________________*/
static int rexpr(term *t, char *in, char **out)
/* relational expression, or just plain old expression */
{ term e,e1;
char *next;
char *rest;
int err,saveletflag;
unsigned short functor;
err = expr(&e,in,&next);
if (err > 0)
{ *out = next;
return err;
}
if (err < 0)
{ *out = in;
return 261; /* Expression expected */
}
err = relop(&functor,next,&rest);
if(err > 0)
{ *out = rest;
return err;
}
if(err < 0) /* no relop follows the first expression */
{ *out = next;
*t=e;
return 0;
}
if (err == 0) /* we did find a relop */
{ saveletflag = letflag;
letflag = 0;
err = expr(&e1,rest,out);
letflag = saveletflag;
if( err > 0 )
return err;
if( err < 0 )
{ *out = rest;
return 261; /* expression expected */
}
*t = pmake_term(functor,2);
ARGREP(*t,0,e);
ARGREP(*t,1,e1);
return 0;
}
return 0; /* just to keep Turbo C from complaining */
}
/*_____________________________________________________________________*/
static int relop(unsigned short *functorp, char *in, char **out)
#if 0
/* const char *le = "�"; // these are three-byte UTF-8 characters.
In Xcode this line generates a warning, illegal character encoding in string,
even though this source file is UTF-8 encoded; it works fine from command-line gcc or cc.
So in the code, I just use the three raw bytes:
Less than or equal to (�): 0xE2 0x89 0xA4
Greater than or equal to (�): 0xE2 0x89 0xA5
And the comment is if-0'd out as it also generates a warning.
*/
#endif
{
const char *le = "\xE2\x89\xA4";
const char *ge = "\xE2\x89\xA5";
if( in[0] == '<' && in[1] == '=')
{ *functorp = LE;
*out = in + 2;
return 0;
}
if(in[0] == '=' && in[1] == '<')
{ *functorp = LE;
*out = in + 2;
return 0;
}
if( in[0] == le[0] && in[1] == le[1] && in[2] == le[2])
{ *functorp = LE;
*out = in + 3;
return 0;
}
if(in[0] == '=' && in[1] == '>')
{ *functorp = SEQ;
*out = in + 2;
return 0;
}
if(in[0] == '=' )
{ *functorp = (char) '=';
*out = in + 1;
return 0;
}
if(in[0] == '\\' && in[1] == 'l' && in[2] == 'e') /* accept "\le" as in TeX */
{ *functorp = LE;
*out = in + 3;
return 0;
}
if(in[0] == '>' && in[1] == '=')
{ *functorp = GE;
*out = in + 2;
return 0;
}
if(in[0] == '\\' && in[1] == 'g' && in[2] == 'e') /* accept "\ge" as in TeX */
{ *functorp = GE;
*out = in + 3;
return 0;
}
if ( in[0] == ge[0] && in[1] == ge[1] && in[2] == ge[2])
{ *functorp = GE;
*out = in + 3;
return 0;
}
if(in[0] == '>' )
{ *functorp = '>';
*out = in + 1;
return 0;
}
if(in[0] == '<' )
{ *functorp = '<' ;
*out = in + 1;
return 0;
}
if(in[0] == '-' && in[1] == '>' )
{ *functorp = ARROW; /* as in lim(x->0,f(x)) */
*out = in + 2;
return 0;
}
if( (in[0] == '/' || in[0] == '\\') && in[1] == '=')
{ *functorp = NE;
*out = in + 2;
return 0;
}
if(in[0] == '\\' && in[1] == 'n' && in[2] == 'e') /* accept "\ne" as in TeX */
{ *functorp = NE;
*out = in + 3;
return 0;
}
return -1; /* can't get a relop */
}
/*______________________________________________________________________*/
static int expr(term *e, char *in, char **out)
{ int err;
char *next, *rest, *last;
term t;
blank_list(in,&next);
err = term0(&t,next,&rest);
if(err > 0)
{ *out = rest;
return err;
}
if (err < 0)
{ *out = in;
return 262; /* expression expected */
}
blank_list(rest,&last);
err = expr1(t,e,last,out);
if (err > 0)
return err;
if (err < 0)
{ *out = last;
return 263; /* expression expected */
}
return 0;
}
/*_________________________________________________________________*/
static int ineq(term *t, char *in, char **out)
/* ineq --> expr, relop, expr */
{ term e,e1;
char *next;
char *rest;
int err;
unsigned short functor;
err = expr(&e,in,&next);
if (err > 0)
{ *out = next;
return err;
}
if (err < 0)
{ *out = in;
return 261; /* Expression expected */
}
err = relop(&functor,next,&rest);
if(err > 0)
{ *out = rest;
return err;
}
if(err < 0 || functor == ARROW || functor == SEQ)
{ *out = rest;
return 326; /* Inequality expected */
}
/* we did find a relop */
err = expr(&e1,rest,out);
if( err > 0 )
return err;
if( err < 0 )
{ *out = rest;
return 261; /* expression expected */
}
*t = pmake_term(functor,2);
ARGREP(*t,0,e);
ARGREP(*t,1,e1);
return 0;
}
/*_________________________________________________________________*/
static int expr1(term x, term *e, char *in, char **out)
/* x is the sum built up so far */
/* expr1 reads a sum, adding in new terms to x */
{ int err,i;
char *next, *rest, *last, *next3;
term t,minusterm;
term newt;
if( (in[0] == '-' ) && (in[1] == '>')) /* to parse x -> -3 for example */
{ blank_list(in+2,&next);
err = expr(&t,next,&last); /* make t the term following the arrow */
if(err > 0)
{ *out = last;
return err;
}
if(err < 0)
{ *out = next;
return 264; /* "expression expected" */
}
newt = pmake_term(ARROW,2);
ARGREP(newt,0,x);
ARGREP(newt,1,t);
*out = last;
*e = newt;
return 0;
}
if( in[0] == '-' )
{ blank_list(in+1,&next);
err = pterm(&t,next,&rest);
if (err > 0)
{ *out = rest;
return err;
}
if (err < 0)
{ *out = next;
return 265; /* expression expected */
}
minusterm = pmake_term('-',1);
ARGREP(minusterm,0,t);
if(TYPE(t) != NOTYPE)
SETTYPE(minusterm,TYPE(t));
if(FUNCTOR(x) == '+') /* then return x + (-t) but in flattened form */
{ newt = pmake_term('+',(unsigned short)( ARITY(x) + 1));
for(i=0;i<ARITY(x);i++)
ARGREP(newt,i,ARG(i,x));
RELEASE(x);
ARGREP(newt,ARITY(x),minusterm);
}
else
{ newt = pmake_term('+', 2);
ARGREP(newt,0,x);
ARGREP(newt,1,minusterm);
}
err = expr1(newt,e,rest,out);
return err;
}
if( in[0] == '+' )
{ blank_list(in+1,&next);
/* Now check for the case in which use has entered something like
a + (-b) which will print like a-b; we want to be able to
tell confirm_problem to print it as a+(-b) */
if ( (next[0] == '(') || (next[0] == '[') )
{ blank_list(next+1,&next3);
if(next3[0] == '-') /* then we are in that situation */
pminus = next3; /* point pminus to the minus sign; */
}
err = pterm(&t,next,&rest);
if(err > 0)
{ *out = rest;
return err;
}
if(err < 0)
{ *out = next;
return 266; /*expression expected */
}
if( FUNCTOR(x) == '+')
{ if(PROVISIONAL(x))
{ UNSETPROVISIONAL(x);
newt = pmake_term('+',2);
ARGREP(newt,0,x);
ARGREP(newt,1,t);
}
else
{ newt = pmake_term('+',(unsigned short)(ARITY(x)+1));
for(i=0;i<ARITY(x);i++)
ARGREP(newt,i,ARG(i,x));
RELEASE(x);
ARGREP(newt,ARITY(x),t);
}
}
else
{ newt = pmake_term('+',2);
ARGREP(newt,0,x);
ARGREP(newt,1,t);
}
err = expr1(newt,e,rest,out);
if(err > 0)
return err;
if(err < 0)
{ *out = rest;
return 267; /* expression expected */
}
return 0;
}
*out = in;
*e = x;
return 0; /* expr1 --> []. */
}
/*______________________________________________________________________*/
static int term0( term *ans, char *in, char **out) /* either a term or minus a term */
{ int err;
term t;
char *next;
if( in[0] == '-' )
{ blank_list(in+1,&next);
err = pterm(&t,next,out);
if (err > 0)
return err;
if (err < 0)
{ *out = next;
return 268; /* expression expected */
}
*ans = pmake_term('-',1);
ARGREP(*ans,0,t);
if(TYPE(t) != NOTYPE)
SETTYPE(*ans,TYPE(t));
return 0;
}
err = pterm(ans,in,out);
if(err > 0)
return err;
if(err < 0)
return -1;
return 0;
}
/*_____________________________________________________________________*/
static int pterm(term *t, char *in, char **out)
{ int err;
char *next;
term f;
err = pfactor(&f,in,&next);
if( err > 0)
{ *out = next;
return err;
}
if( err<0)
{ *out = in;
if((in[0] == '-') && (pminus != NULL && *pminus !=in[0])) /* e.g. if input is a + -b */
return 282; /* Use parentheses before minus here */
return 269; /* Expression expected (factor actually)*/
}
err = term1(f,t,next,out);
if(err > 0)
return err;
if(err < 0)
{ *out = next;
return 269; /* Expression expected (term actually) */
}
return 0;
}
/*____________________________________________________________________*/
static int ifterm(term *t, char *in, char **out)
/* ifterm --> expr, blank_list, 'if', blank_list, ineq. */
/* to parse '1 if x>0' for example */
/* There's a problem here because "if" could be i times f. This function
is only called by 'casesterm', so we know we're looking for an "if". We
can't just pass 'in' to expr, because expr will try to parse the "if" as well,
and we don't want to prevent that except when parsing a cases term,
since it could occur, for example, in i*f or i*f(x), written as if or if(x).
Also, the arguments of this 'if' term could contain nested cases terms with
further if's, so we need to look for an if at zero paren nesting level.
*/
{ term f,newt,x;
char *next,*marker;
int err;
int count = 0;
char openbrace;
if(in[0] == 'i' && in[1] == 'f')
{ blank_list(in+2,&next);
if(next[0] != '(' && next[0] != '[')
{ *out = in+2;
return 294; /* Open parentheses or bracket expected */
}
openbrace = next[0];
blank_list(next+1,&marker);
err = ineq(&x,marker,&next);
if(err)
{ *out = next;
return err;
}
blank_list(next,&next);
if(next[0] != ',')
{ *out = next;
return 296; /* Comma expected */
}
blank_list(next+1,&marker);
err = expr(&f,marker,&next);
if(err)
{ *out = next;
return err;
}
blank_list(next,&marker);
if(openbrace == '(' && marker[0] != ')')
{ *out = marker;
return 278; /* Right parenthesis expected */
}
if(openbrace == '[' && marker[0] != ']')
{ *out = marker;
return 279; /* Right bracket expected */
}
*out = marker+1;
*t = pmake_term(IF,2);
ARGREP(*t,0,x);
ARGREP(*t,1,f);
return 0;
}
/* it remains to accept "a if b" */
/* locate the "if" */
for(marker=in; marker[0] && marker[1]; marker++)
{ if(*marker == '(' || *marker == '[' || *marker == '{')
++count;
else if(*marker == ')' || *marker == ']' || *marker == '}')
--count;
if(count == 0 && marker[0] == 'i' && marker[1] == 'f')
break;
}
if(marker[1] == 0)
{ *out = in;
return 335; /* "Expecting 'if'. Example: cases(0 if x > 0, 1 if x < 0, 0)." */
}
/* Now the "if" begins at marker. */
marker[0] = 0; /* temporarily */
err = expr(&x,in,&next);
if(err)
{ *out = next;
return err;
}
marker[0] = 'i'; /* restore it */
blank_list(next,&next);
if(next[0] != 'i' || next[1] != 'f')
{ *out = next;
return 335; /* "Expecting 'if'. Example: cases(0 if x > 0, 1 if x < 0, 0)." */
}
blank_list(next+2,&next);
err = ineq(&f,next,out);
if(err > 0)
return err;
if(err < 0)
{ *out = next;
return 326; /* "Inequality expected" */
}
if((*out)[0] == '<' || (*out)[0] == '>' || (*out)[0] == '#')
{ next = *out;
err = intervalterm(f,&newt,next,out);
if(err)
{ *out = next;
return 327;
/* Expecting an inequality or interval after 'if'. */
}
/* got an interval */
f = newt;
}
newt = pmake_term(IF,2);
ARGREP(newt,1,x); /* switch the order of arguments, making if(ineq,term) */
ARGREP(newt,0,f);
*t = newt;
return 0;
}
/*____________________________________________________________________*/
static int casesterm(int n, term *t, char *in, char **out)
/* casesterm--> "cases",blank_list, '(',ifterm,blank_list,ifterm1,blank_list, ')'.
casesterm--> "cases",blank_list, '(',ifterm,blank_list,ifterm1,blank_list,term0 ')'.
last arg doesn't have to be an ifterm.
n is the arity of the expected CASES term.
*/
{ char *next,*rest;
char openbrace;
int err,i;
if(in[0] != 'c' || in[1] != 'a' || in[2] != 's' || in[3] != 'e' || in[4] != 's')
return 1;
blank_list(in+5,&next);
if(next[0] != '(' && next[0] != '[' && next[0] != '{')
return 1;
openbrace = next[0];
blank_list(next+1,&next);
*t = pmake_term(CASES,n);
for(i=0;i<n-1;i++)
{ err = ifterm(ARGPTR(*t)+i,next,&rest);
if(err)
{ RELEASE(*t);
return err;
}
blank_list(rest,&next);
if(next[0] != ',')
return 296; /* comma expected */
blank_list(next+1,&next);
}
/* the last argument doesn't have to be an ifterm */
err = ifterm(ARGPTR(*t) + i, next,&rest);
if(err)
err = term0(ARGPTR(*t)+i, next, &rest);
if(err)
{ RELEASE(*t);
return err;
}
blank_list(rest,&next);
if(next[0] != (openbrace == '(' ? ')' : openbrace == '[' ? ']' : '}'))
{ RELEASE(*t);
return openbrace == '(' ? 278 : openbrace == '[' ? 279 : 280; /* close parenthesis expected (or bracket, or brace) */
}
*out = next + 1;
return 0;
}
/*____________________________________________________________________*/
/* the first argument of term1 is the product so far built up */
static int term1(term x, term *t, char *in, char **out)
{ int err,i;
char *next, *rest;
int skipstar = 0;
term f,newt,newx;
if( in[0] == '/' ) /* term1 --> '/', blank_list, pfactor, term1. */
{ blank_list(in+1,&next);
err = pfactor(&f,next,&rest);
if(err>0)
{ *out = rest;
return err;
}
if(err<0)
{ if(in[1]== '=') /* as in x /= y for example; this is just the
end of the term, and /= is a relop */
{ *out = in;
*t = x;
return 0; /* term1 --> blank_list */
}
*out = next;
return 270; /* expression expected*/
}
newt = pmake_term('/',2);
ARGREP(newt,0,x);
ARGREP(newt,1,f);
err = term1(newt,t,rest,out);
if(err > 0)
{ /* destroy_term(f); */
RELEASE(newt);
/* but not destroy_term(newt) which would call destroy_term(x) */
return err;
}
if(err<0)
{ *out = rest;
return 271; /* expression expected*/
}
return 0;
}
if( in[0] == '\\' && in[1] == 'o' && in[2] == 'v' && in[3] == 'e' && in[4] == 'r' )
/* accept plain TeX "\over" notation */
{ blank_list(in+5,&next);
err = pfactor(&f,next,&rest);
if(err>0)
{ *out = rest;
return err;
}
if(err<0)
{ *out = next;
return 270; /* expression expected*/
}
newt = pmake_term('/',2);
ARGREP(newt,0,x);
ARGREP(newt,1,f);
err = term1(newt,t,rest,out);
if(err > 0)
{ /* destroy_term(f); */
RELEASE(newt);
/* but not destroy_term(newt) which would call destroy_term(x) */
return err;
}
if(err<0)
{ *out = rest;
return 271; /* expression expected*/
}
return 0;
}
if( in[0] == '*' ) /* term1 --> '*', blank_list, pfactor, term1. */
{ skipstar = 1;
blank_list(in+1,&next);
}
else if(in[0] == ':') /* term1 --> ':', blank_list, type */
{ term tp;
blank_list(in+1,&next);
err = ptype(&tp,next,&rest);
if(err > 0)
{ *out = rest;
return err;
}
if(err < 0)
{ *out = next;
return 330; /* Type expected. The colon is used to specify the kind or 'type' of a variable. */
}
*t = pmake_term(':',2);
SETTYPE(x,(unsigned char) INTDATA(tp));
ARGREP(*t,0,x);
ARGREP(*t,1,tp);
*out = rest;
return 0;
}
else if(unwritten_mult) /* a global variable */
blank_list(in,&next);
else /* 7.21.05 */
{ blank_list(in,&next);
if(isalpha(next[0]))
{ *out = in;
return 272; /* expression expected */
}
}
err = pfactor(&f,next,&rest);
if (err > 0)
{ *out = rest;
return err;
}
if (err < 0) /* term1 --> blank_list. */
{ if(skipstar)
*out = in;
else
blank_list(next,out);
*t = x;
return 0;
}
if (FUNCTOR(x) == '*' ) /* then append the arguments */
{ if(PROVISIONAL(x))
{ UNSETPROVISIONAL(x);
newx = pmake_term('*',2);
ARGREP(newx,0,x);
ARGREP(newx,1,f);
}
else
{ newx = pmake_term('*',(unsigned short) (ARITY(x)+1));
for(i=0;i<ARITY(x);i++)
ARGREP(newx,i,ARG(i,x));
ARGREP(newx,ARITY(x),f);
}
err = term1(newx,t,rest,out);
if(err > 0)
{ RELEASE(newx);
return err;
}
if(err < 0)
{ *out = rest;
RELEASE(newx);
return 273; /* expression expected */
}
return 0;
}
else /* FUNCTOR(x) != '*' */
{ newx = pmake_term('*',2);
ARGREP(newx,0,x);
ARGREP(newx,1,f);
err = term1(newx,t,rest,out);
if(err > 0)
return err;
if(err < 0)
{ *out = rest;
return 274; /* expression expected */
}
}
return 0;
}
/*________________________________________________________________________*/
/* pfactor --> primary, factor1. */
static int pfactor(term *f, char *in, char **out)
{ int err;
char *next;
term p;
err = primary(0,&p,in,&next);
if (err > 0)
{ *out = next;
return err;
}
if (err < 0)
{ *out = in;
return -1;
}
if(err == 0 &&
(FUNCTOR(p) == '+' || FUNCTOR(p) == '*') &&
(in[0] == '(' || in[0] == '[')
)
SETPROVISIONAL(p); /* mark it so we don't flatten those parens */
err = factor1(p,f,next,out);
if (err > 0)
return err;
if (err < 0)
{ *out = in;
return -1;
}
return 0;
}
/*______________________________________________________________*/
/* factor1 --> '^', blank_list, primary, blank_list, factor1.
factor1 --> '^', blank_list, '-', primary, blank_list,factor1.
factor1 --> '!', blank_list. (future postfix functions go here)
factor1 --> {'}*, blank_list.
factor1 --> blank_list */
/* factor 1 (x,&ans,"^ab"... should return ans = (x^a) * b */
static int factor1(term x, term *ans, char *in, char **out)
{ int err;
char *next, *next2, *rest, *last;
term p,exponent;
if(in[0] == '^')
{ blank_list(in+1,&next);
if(next[0] == '-')
{ blank_list(next+1,&next2);
err = primary(0,&p,next2,&rest);
exponent = pmake_term('-',1);
ARGREP(exponent,0,p);
if(err > 0)
{ *out = rest;
return err;
}
if(err < 0)
{ *out = next;
return 275; /* expression expected */
}
blank_list(rest,out);
}
else /* if next[0] != '-' */
{ err = primary(0,&p,next,&rest);
if(err > 0)
{ *out = rest;
return err;
}
if(err < 0)
{ *out = next;
return 275; /* expression expected */
}
blank_list(rest,&last);
err = factor1(p,&exponent,last,out);
if(err > 0)
return err;
if(err < 0)
{ *out = last;
return err;
}
}
*ans = pmake_term('^',2);
ARGREP(*ans,0,x);
ARGREP(*ans,1,exponent);
assert(err==0);
return 0;
}
if (in[0] == '\xC2' && in[1] == '\xB0') /* postfix degree symbol, two bytes in UTF8 */
{
*ans = pmake_term(DEG,1);
ARGREP(*ans,0,x);
blank_list(in+2,out);
return 0;
}
if( in[0] == (char) '!') /* postfix factorial function */
{
*ans = pmake_term(FACTORIAL,1);
ARGREP(*ans,0,x);
blank_list(in+1,out);
return 0;
}
if( in[0] == 39 ) /* 39 is ascii of '; this is a term like u'' */
{ char *marker= in;
long nprimes = 0;
term arg;
while ((*marker == 39) || (*marker == 32)) /* count the primes */
{ if(*marker==39)
++nprimes;
++marker;
}
*ans = pmake_term(PR,2);
arg = pmake_int(nprimes);
ARGREP(*ans,1,arg);
ARGREP(*ans,0,x);
*out = marker; /* first nonblank char after all the primes */
return 0;
}
blank_list(in,out); /* factor1 --> blank_list */
*ans = x;
return 0;
}
/*_________________________________________________________________________*/
/* primary --> number, blank_list.
primary --> '(', blank_list, lexpr, paren(')'), blank_list. (etc.)
primary --> function_term.
primary --> ident.
Known and unknown funcnames are treated together in the C version of the
parser.
*/
static int primary( int flag, term *p, char *in, char **out)
{ int err;
char *next, *rest;
if( in[0] == '|')
{ blank_list(in+1,&next);
term temp;
char *q;
err = expr(&temp,next,&q);
if(!err && q[0] == '|')
{ *p = absolute(temp); // it worked to treat '|' as an opening absolute(
*out = q+1;
return 0;
}
// return 318; // "Missing | to finish absolute value";
// This prevents parsing A | B as or(A,B)
}
if( in[0] == '(' || in[0] == '[' || /* left brackets */
in[0] == '{' /* vector, matrix, or absolute value signs */
)
{ blank_list(in+1,&next);
err = lexpr(p,next,&rest); /* eats trailing blanks */
if(err)
{ *out = rest;
return err;
}
switch(in[0])
{ case '(' : if(rest[0] != ')' )
{ *out = rest;
return 278; /* right ')' missing */
}
else break;
case '[' : if(rest[0] != ']' )
{ *out = rest;
return 279; /* right ']' missing */
}
else break;
case '{' : if(rest[0] != '}' )
{ *out = rest;
return 280; /* right '}' missing */
}
else
break;
}
blank_list(rest+1,out); /* eat any blanks following the close paren */
if (in[0] == '{' && (FUNCTOR(*p)==AND))
/* then parse as VECTOR or MATRIX instead */
{ /* which is it, VECTOR or MATRIX? */
int i;
unsigned short newfunctor;
if(FUNCTOR(ARG(0,*p))==VECTOR) /* a vector of vectors is a matrix */
{ /* check: if one entry is a vector all should be */
for(i=0;i<ARITY(*p);i++)
{ if (FUNCTOR(ARG(i,*p)) != VECTOR)
{ *out = in+1;
return 317; /* nested braces that don't form a legal matrix */
}
} /* I observed with Codeview that the next line was
being executed IN THE FOR-LOOP without these brackets
which it shouldn't be. */
newfunctor = MATRIX;
}
else
newfunctor = VECTOR;
SETFUNCTOR(*p,newfunctor,ARITY(*p));
}
return 0;
}
if ((in[0] > 0 && isdigit(in[0])) || (in[0] == decimalchar && in[1] > 0 && isdigit(in[1])) )
/* primary -> number,blank_list */
/* a decimal point standing alone is not a number; that's why the isdigit(in[1]) */
{ err = number(p,in,&next);
if(err > 0)
{ *out = next;
return err;
}
if(err < 0 && decimalchar != ',')
{ *out = in+1;
return 281; /* number expected */
}
if(err == 0)
{ blank_list(next,out);
return 0;
}
/* and if decimalchar == ',' and err < 0, just go on and try something else */
}
err = function_term(p,in,out);
if( err > 0)
return err; /* input error */
if( err == 0)
{ if (flag==0) /* this is the nonterminal 'primary' */
return 0; /* got a function term */
else /* this is 'aprimary' */
return -1; /* don't accept a function term */
}
if( err < 0)
{ err = ident(p,in,out); /* just get an identifier */
if(err)
{ *out = in;
return err;
}
else return 0;
}
return 0; // can't get here, but may prevent a warning message
}
/*_______________________________________________________________________*/
/* function_term --> funcname, after_funcname. */
/* 'function term' does not include terms with functor +, *, AND, OR */
/* If a term f(x) is encountered, where f is not a built-in functor and
also not (yet) recognized as a user-defined functor, there is an ambiguity:
should this be f*x or f(x)? Mathpert's rule is this:
(1) if the argument x is an atom, then it's a function term f(x).
(2) if the argument is a compound term, as in f(x+y),
then it's a function term if the function symbol is f,g, or h,
(or F,G, or H), and otherwise it's a multiplication.
(3) EXCEPT: when the problemtype is LIMITS or DIFFERENTIATE_FROM_DEFN,
then h is probably a number, not a function, so only f and g are
treated as in (2).
A user-defined function will first be encountered in a definition f(x)=...,
so one might argue that only if followed by an = should we accept f(x) as
a function term. But what about this example: d/dx( f(x)g(x));
and there may be other situations in which the user enters what amounts to
a function variable. Consider d/dx(f(x+a)g(x)); this will come out
right, but if the user puts c instead of f, it will be treated as
d/dx( c*(x+a)*g(x)), which is quite probably what's meant.
Another ambiguity: Even when long_identifiers==0, the user should ideally
be able to define function names that are longer than one character, but
this turns out to be impossible:
What about cf(x): is it c*f(x), or is 'cf' a function name?
And what about when 'f' is a known function name? we don't want to
parse clog x as a new function name 'clog'. Therefore we do require
defined functors to be governed by the rules for identifiers: if
long_identifiers==0, then they must be only one character long.
*/
static int function_term(term *ans, char *in, char **out)
{ int err,count=0,i;
char c;
long nprimes=0;
int newfunctionflag=0;
term arg,arg2;
char newfuncname[32];
unsigned short f;
char *marker, *next, *firstarg;
short arity; /* actual arity of term generated */
int prefix; /* set it nonzero when this function term uses prefix notation */
err = funcname(&f,in,&next);
/* BUILT IN funcname or known functor or previously defined functor */
/* or, if (err == 2), new functor of one character */
if(err == 2)
{ newfunctionflag = 1;
err = -1;
}
if( err > 0)
{ *out = next;
return err;
}
if (! (in[0] >= 0 && isalpha(in[0])) &&
! (in[0] == '\\' && in[1] >= 0 && isalpha(in[1])) /* accept "\sin" etc. */
)
return -1; /* definitely not a function term */
if( err < 0) /* new function name */
{ newfunctionflag=1;
if( long_identifiers != 0)
{ newfuncname[0] = in[0];
newfuncname[1] = '\0';
next = in+1;
}
else
{ i=0;
while(in[i] >= 0 && isalpha(in[i]) && (i<31))
{ newfuncname[i] = in[i];
++i;
}
newfuncname[i] = '\0';
if(in[i] >= 0 && isalpha(in[i]))
{ *out = in;
return 312; /* new function names limited to 31 characters */
}
next = in + i;
}
}
marker = next;
/* Catch Bessel functions: */
if(f == BESSELK || f == BESSELJ || f == BESSELY || f == BESSELI)
{ if((*marker <= 0 || !isdigit(*marker)) && *marker != 39 && *marker != '(' && *marker != '[')
return -1; /* Not a Bessel function after all, only an identifier */
while(*marker > 0 && isdigit(*marker))
++marker;
}
/* Now, does a parenthesis or bracket or prime (ascii 39)
follow this funcname? */
while (*marker == 32)
++ marker; /* advance to first non-blank character */
if(*marker == '\0')
{ if (newfunctionflag)
return -1; /* not a function term */
*out = marker; /* else it's an error */
return 310; /* argument expected */
}
if( *marker == 39 ) /* then this is a term like f''(x) */
{ while ((*marker == 39) || (*marker==32))
/* count primes, ignoring blanks */
{ if (*marker == 39)
++nprimes;
++ marker;
} /* now nprimes is how many primes there are */
next = marker; /* advance next to the position past the primes */
*ans = pmake_term(PR,2);
} /* now the marker is past all the primes and on the next character */
if( (*marker != '(') && (*marker != '['))
{ if (newfunctionflag)
return -1; /* this isn't a function term */
c = in[0];
if((c == 'Y' || c == 'J' || c == 'I' || c == 'K') && !isalnum(in[1]))
return -1; /* fail, it isn't really a Bessel function as
we were hoping up to here, just an identifier after all. */
if(f == LAM)
return -1; /* "lambda" can still be parsed as an identifier. */
if(!PREFIX(f))
{ *out = marker;
return 311; /* parentheses expected */
}
prefix = 1; /* set this so we know not to require a paren after the args */
}
else
{ ++marker; /* pass the open paren that precedes the args */
prefix = 0; /* close paren must follow the last argument */
}
while(*marker == 32)
++ marker; /* advance to first arg */
firstarg = marker; /* save position of first argument */
/* Next we will count the arguments by counting commas at the
right level of parentheses nesting. This isn't any easier
than parsing if the functor is prefix (and being used without parentheses)
so we only do it for non-prefix functors. */
if(prefix == 0)
{ count = 1; /* at this point *marker is past the opening paren */
arity = 0;
while( count > 0 && *marker != '\0')
{ switch (*marker)
{ case ')' : --count; break;
case ']' : --count; break;
case '}' : --count; break;
case '(' : ++count; break;
case '[' : ++count; break;
case '{' : ++count; break;
}
if( count == 1 && *marker == ',' &&
( decimalchar != ',' ||
!(isdigit(marker[-1]) && isdigit(marker[1])) ||
((f == SUM || f == PRODUCT) && arity == 2) ||
(f == ROOT && arity == 0) ||
/* log(0,2) will be log to base 10 of 0.2 in French,
but root(3,9) will parse as arity 2 */
(f == INTEGRAL && arity == 2 && ncommas(marker+1) == 0) ||
/* integral(x^2,x,2,3) should parse; the 2,3 is not a decimal */
(f == LIMIT && arity == 0 && ncommas(marker+1) == 0)
/* lim(x->0,2) should parse; the 0,2 is not a decimal */
)
)
++arity;
++marker;
}
++arity; /* last argument wasn't followed by a comma */
}
else
arity = 1;
/* now the arity is set to the ACTUAL arity except for prefix functors */
if((*marker == '\0') && (count > 0) && !prefix )
{ *out = next;
return 313; /* parentheses unbalanced */
}
if(f== LOG) /* log/2 and log/1 are entered the same by the user,
so we have to find out here which one it is */
{ if (arity == 2)
f = LOGB;
else if (arity != 1)
{ *out = next;
return 283; /* wrong number of args*/
}
}
if( (f==DIFF) && (arity != 2) && (arity != 3))
{ *out = next;
return 283; /* wrong number of arguments */
}
if( (f==INTEGRAL) && (arity != 2) && (arity != 4))
{ *out = next;
return 283; /* wrong number of arguments */
}
if( (f == SUM || f == PRODUCT) &&
arity != 4 && arity != 5
)
{ *out = next;
return 283; /* wrong number of arguments */
}
if( (f==LIMIT) && (arity != 2))
/* at this point even a one-sided limit has arity 2
because it's entered as lim(x->0+,f(x)) */
{ *out = next;
return 283; /* wrong number of arguments */
}
if( f == CASES)
return casesterm(arity,ans, in,out);
if( !newfunctionflag) /* check number of arguments */
{ if(f == BESSELJ || f == BESSELK || f == BESSELY || f == BESSELI)
{ if( (isdigit(*next) && arity != 1)
/* j43(x) entered, index arg not in parentheses */
|| (!isdigit(*next) && arity != 2)
/* j(n,x) entered with parentheses */
)
{ *out = next;
return 283; /* wrong number of arguments */
}
}
else if(f == LAM && arity == 1)
return -1; /* so it will go ahead and parse lambda as an identifier */
else if (f != LOG && f != LOGB && f != DIFF && f != INTEGRAL
&& f != CASES && f != LIMIT && f != SUM && f != PRODUCT &&
arity != correct_arity(f)
)
{ *out = next;
return 283; /* wrong number of arguments */
}
}
if( newfunctionflag ) /* is this a function term or a multiplication? */
{ if( letflag /* global variable signalling user's intention to define */
|| arity > 1 || strchr(function_letters, in[0])
|| nprimes > 0 /* read a'(x) as a function term */
|| !unwritten_mult // 7.21.05
)
/* then it's definitely a function term, so enter it */
{ assert(newfunctor != NULL);
f = newfunctor(newfuncname,arity);
if(f == ILLEGAL)
return 325; /* Too many long function names */
letflag = 1; /* signalling the presence of undefined function symbols */
err = 0;
}
else /* if arity == 1 and the function name doesn't begin with f,g,h */
{ err = ident(&arg,firstarg,out);
if(err)
return -1; /* not a function term unless the argument
is an identifier */
if((**out == ')') || (**out == ']'))
{ assert(newfunctor != NULL);
f = newfunctor(newfuncname,arity);
letflag = 1;
err = 0;
}
else
return -1; /* it was something like a(x+y) with a
letter not f,g,h and a non-atomic arg */
}
}
if(err == 0)
{ if(f== LIMIT)
return limit_tail(ans,next,out);
else if (nprimes > 0)
{ arg2 = pmake_int(nprimes);
ARGREP(*ans,1,arg2);
arg = ARG(1,*ans);
return primary_tail(f,arity,ARGPTR(*ans),next,out);
}
else
{ err = after_funcname(f,arity,ans,next,out);
if(prefix && (err == 284))
return 320; /* can't understand function argument, try using parentheses */
else if(
(f == SUM || f == PRODUCT) &&
!err &&
arity == 5
)
{ if(ISINTEGER(ARG(4,*ans)))
return 0;
if(NEGATIVE(ARG(4,*ans)) && ISINTEGER(ARG(0,ARG(4,*ans))))
return 0;
return 283; /* wrong number of arguments. An arity-5
sum is created by the program only; the last arg must
be a positive or negative integer. The user isn't
supposed to enter such a term, so this error is
appropriate if an error is going to the user. */
}
else
return err;
}
}
return 0; /* just to keep the C compiler from complaining */
}
/*_______________________________________________________________________*/
static int after_funcname(unsigned short x, unsigned short nargs, term *p, char *in, char **out)
/* x is passed as either one of the #-defined known functors, or as
an index into the array of user-defined functions */
/* nargs is passed as the count of number of arguments to follow x */
/* p is used for the indirect return of a term with functor x whose
args are in the string in */
{ int err,i;
char *next,*rest,*last;
term temp;
term exponent;
term a1;
blank_list(in,&next);
if( isdigit(in[0]) /* subscripted function, as in J43(x) */
&& SUBSCRIPTABLE(x)
)
{ number(&temp,next,&rest);
if(TYPE(temp) == BIGNUM)
return 321; /* subscript too large */
if(TYPE(temp) != INTEGER)
return 322; /* subscript must be an integer */
if(INTDATA(temp) > 1000)
return 321; /* subscript can't exceed 1000 */
*p = pmake_term(x,(unsigned short)(nargs+1)); /* nargs comes in not counting the index */
after_funcname(x,nargs,&a1,rest,out);
ARGREP(*p,0,temp);
for(i=1;i<nargs+1;i++)
{ ARGREP(*p,i,ARG(i-1,a1));
}
RELEASE(a1); /* created by the call to after_funcname */
return 0;
}
#if 0
/* This code processed the OEM characters superscript n
and superscript 2, which are obsolete.
if(next[0] == (char) '�' )
{ blank_list(next+1,&rest);
err = primary_tail(x,nargs,&temp,rest,out);
if(err>0)
return err;
if(err<0)
{ *out = rest;
return 284; // can't understand argument
}
*p = pmake_term('^',2);
ARGREP(*p,0,temp);
a1 = make_atom_from_string2("n");
ARGREP(*p,1,a1);
return 0;
}
if(next[0] == (char) '�' )
{ blank_list(next+1,&rest);
err = primary_tail(x,nargs,&temp,rest,out);
if(err>0)
return err;
if(err<0)
{ *out = rest;
return 284; // can't understand argument
}
*p = pmake_term('^',2);
ARGREP(*p,0,temp);
a1 = pmake_int(2L);
ARGREP(*p,0,a1);
return 0;
}
*/
#endif
if(next[0] == (char) '^' )
{ blank_list(next+1,&rest);
err = pfactor(&exponent,rest,&last);
if (err>0)
{ *out = rest;
return err;
}
if(err<0)
{ *out = next+1;
return 285; /* can't understand exponent */
}
err = primary_tail(x,nargs,&temp,last,out);
if (err>0)
{ *out = last;
return err;
}
if(err<0)
{ *out = last;
return 284; /* can't understand argument */
}
*p = pmake_term('^',2);
ARGREP(*p,0,temp);
ARGREP(*p,1,exponent);
return 0;
}
/* now there are no superscripts between functor x and its args */
if(x==LAM)
/* lambda terms must be followed by a variable, comma, and then
the second argument can be a relop as well as a term. */
err = lambda_tail(p,next,out);
else if(x == LIMIT)
err = limit_tail(p,next,out);
else
err = primary_tail(x,nargs,p,next,out);
if(err > 0)
return err;
if (err < 0)
{ *out = next;
return 284; /* Can't understand function argument */
}
return 0;
}
/*__________________________________________________________________________*/
static int primary_tail(unsigned short x, unsigned short nargs, term *ans, char *in, char **out)
/* x is a functor passed in to this function;
ans is returned as a term with functor x and nargs arguments. */
/* The primary_tail may or may not include parentheses or brackets */
{ int err;
char *next;
char *marker1, *marker2;
term f,t,temp;
int i;
if(PREFIX(x) && in[0] != '(' && in[0] != '[')
/* x is declared prefix, like sin, log, and so on */
/* ABSFUNCTOR isn't prefix on output, but can be used prefix on input */
/* and is being used here without parentheses */
{ err = pfactor(&f,in,&next);
if(err > 0)
{ *out = next;
return err;
}
if(err < 0)
{ *out = in;
return 284; /* can't understand function argument */
}
err = aterm(f,&t,next,out);
if (err > 0)
{ *out = next;
return err;
}
if (err < 0)
{ *out = in;
return 284; /* can't understand function argument */
}
*ans = pmake_term(x,1);
ARGREP(*ans,0,t);
return 0;
}
/* So now x is not a prefix functor, or at least if it is,
it is being used with parentheses */
if( (in[0] != '(') && (in[0] != '[') )
{ *out = in;
return 294; /* open parentheses expected */
}
*ans = pmake_term(x,nargs);
marker1 = in+1; /* beginning of zero-th argument */
for(i=0; i< nargs; i++) /* marker1 is at beginning of i-th arg */
{ if( decimalchar == ',' &&
(
(i==0 && (x==ROOT || x == BESSELJ || x == BESSELY || x == BESSELI || x == BESSELK))
||
(i==2 && (x == SUM || x == PRODUCT))
||
/* example, integral(x^2,x,2,3), we know 2,3 is not a decimal */
(nargs > 1 && i==nargs-2 && ncommas(marker1) == 1)
)
)
{ /* then the i-th arg cannot be a decimal number, so root(3,9) should
be interpreted as having two arguments, even if decimalchar == ','.
*/
marker2 = marker1;
while(*marker2 == 32)
++marker2;
if(x != ROOT && *marker2 == '-')
++marker2;
while(isdigit(*marker2))
++marker2;
if( *marker2 == ',')
{ if(*marker1 == '-')
{ term w;
err = integer(&temp,marker1+1,&marker2);
if(err)
assert(0);
w = pmake_term('-',1);
ARGREP(w,0,temp);
ARGREP(*ans,i,w);
}
else
{ err = integer(ARGPTR(*ans)+i,marker1,&marker2);
if(err)
assert(0);
}
}
else
err = expr(ARGPTR(*ans)+i, marker1,&marker2);
}
else if(x== AND || x == OR)
// err = rexpr(ARGPTR(*ans)+i,marker1,&marker2); // 7.23.05
// this permits parsing and(p,q) where p,q are equations or inequalities
err = lfactor(ARGPTR(*ans)+i,marker1,&marker2); // 1.14.25
// using lfactor instead of rexpr permits parsing or(J(n,x),-10 < x < 10)
// because lfactor calls interval_term at the right place
else
err = expr(ARGPTR(*ans) + i, marker1,&marker2);
/* eat one expression and put it in the i-th arg of *ans */
if(err > 0)
{ *out = marker2;
return err;
}
if(err < 0)
{ *out = marker1;
return 295; /* expected more arguments */
}
if(i==1 && (x==SUM || x == PRODUCT))
{ if(!(ISATOM(ARG(1,*ans))))
{ *out = marker1;
return 319; /* second argument of sum must be a variable */
}
if(FUNCTOR(ARG(1,*ans)) == 'i')
SETTYPE(ARG(1,*ans),INTEGER);
/* it was set to COMPLEX by make_atom_from_string2 */
}
marker1 = marker2; /* advance the marker */
while(*marker1 == 32 )
++marker1; /* eat blanks */
if( (*marker1 != ',' ) && i < nargs-1)
{ *out = marker1;
return 296; /* comma expected */
}
if( *marker1 == ',')
++marker1; /* pass the comma */
while(*marker1 == 32 )
++ marker1; /* eat blanks */
}
if ((in[0] == '(') && (*marker1 != ')') )
{ *out = marker1;
return 278; /* close parentheses expected */
}
if ((in[0] == '[') && (*marker1 != ']') )
{ *out = marker1;
return 279; /* close bracket expected */
}
*out = marker1+1;
return 0; /* everything ok */
}
/*________________________________________________________________________*/
static int limit_tail(term *ans, char *in, char ** out)
/* eats the (x->0,f(x)) part of lim(x->0,f(x))
Must take (x->0+,f(x)) etc. for one-sided limits.
Must take the args in either order, i.e. both
lim(x->0,f(x)) and lim(f(x),x->0) are acceptable and equivalent. */
{ char *arg2,*rest,*next,*firstarg;
char sign = 0;
char *buffer;
int err,i,j,count;
if(in[0] != '(' )
{ *out = in;
return 294; /* Open parentheses or brackets expected */
}
blank_list(in+1,&firstarg); /* leave firstarg pointing to first arg */
/* Now locate the comma and determine if this is a one-sided or
two-sided limit */
count = 0;
i=1;
while((count>0) ||
(in[i] != ',') ||
(decimalchar == ',' && isdigit(in[i-1]) && isdigit(in[i+1]) && ncommas(in +i+1))
/* example, lim(x->3,4, f(x)), don't stop at the first comma,
but in lim(x->3,4), DO stop. That's why we need ncommas here. */
)
{ if((in[i] == '(') || (in[i]== '[') || (in[i] == '{'))
++count;
else if ((in[i] == ')') || (in[i]== ']') || (in[i] == '}'))
--count;
++i;
}
/* Now in[i] is the comma; back up to last preceding non-blank symbol;
but first, mark the beginning of the second argument for reference */
blank_list(in+i+1,&arg2);
--i;
while(in[i] == 32)
--i;
/* Now in[i] is the last non-blank symbol in the first arg */
buffer = calloc(i+2,sizeof(char));
strncpy(buffer,in,i+1);
buffer[i+1] = 0;
if((in[i] == '+') || (in[i]== '-')) /* it's a one-sided limit */
{ sign = in[i];
buffer[i] = 32; /* replace the sign by a blank in buffer */
}
if(sign)
*ans = pmake_term(LIMIT,3);
else
*ans = pmake_term(LIMIT,2);
err = expr(ARGPTR(*ans),buffer + (int)(firstarg-in),&next); /* parse first argument */
free(buffer);
if(err > 0)
{ *out = next;
return err;
}
if(err < 0)
{ *out = in;
return 277; /* expression expected */
}
if (sign == '+')
ARGREP(*ans,1,pmake_term(RIGHT,0));
else if (sign == '-')
ARGREP(*ans,1,pmake_term(LEFT,0));
j = sign ? 2 : 1; /* where to put next arg */
err = expr(((term *)ARGPTR(*ans)) + j, arg2,&rest);
if(err >0)
{ *out = rest;
return err;
}
if(err <0)
{ *out = arg2;
return 260; /* expression expected */
}
if((in[0] == '(') && (*rest != ')'))
{ *out = rest;
return 278; /* closing parenthesis expected */
}
if ((in[0] == '[') && (*rest != ']'))
{ *out = rest;
return 279; /* closing bracket expected */
}
*out = rest + 1;
return 0;
}
/*________________________________________________________________________*/
static int lambda_tail(term *ans, char *in, char ** out)
/* eats the (x,f(x)) part of lambda(x,f(x)).
Must allow f(x) to be a relop as well as a term.
*/
{ char *arg2,*rest,*next,*firstarg;
int err;
if(in[0] != '(' )
{ *out = in;
return 294; /* Open parentheses or brackets expected */
}
blank_list(in+1,&firstarg); /* leave firstarg pointing to first arg */
*ans = pmake_term(LAM,2);
err = ident(ARGPTR(*ans),firstarg,&next);
if(err)
{ *out = in;
return 334; /* first argument of lambda must be a variable. */
}
blank_list(next,&arg2);
if(*arg2 != ',')
{ *out = in;
return 296; /* comma expected */
}
blank_list(arg2+1,&rest);
err = rexpr(ARGPTR(*ans)+1,rest,out);
if(err)
{ *out = in;
return err;
}
blank_list(*out,&rest);
if((in[0] == '(') && (*rest != ')'))
{ *out = rest;
return 278; /* closing parenthesis expected */
}
if ((in[0] == '[') && (*rest != ']'))
{ *out = rest;
return 279; /* closing bracket expected */
}
*out = rest + 1;
return 0;
}
/*____________________________________________________________________*/
#define MAXIDENTIFIER 64 /* maximum length of an identifier */
static int ident(term *ans,char *in, char **out)
/* read an identifier (and any following blanks) */
{ char *marker = in;
char space[MAXIDENTIFIER + 1];
int count,i,err;
if(in[0] == '?') /* needed to display some reason strings */
{ *out = in+1;
*ans = pmake_term('?',0);
ans->args = NULL;
return 0;
}
if(in[0] < 0 && !((unsigned char)in[0] == 0xE2 && (unsigned char)in[1] == 0x89))
/* non-ascii symbol, reject it usually, but
don't reject it if in contains the first two bytes of UTF-8 for le or ge. */
{
return 331; /* To enter a Greek symbol or ... */
}
if (in[0] < 0 || ! isalpha(in[0]))
return -1; /* not a variable name */
err = greek(ans,in,out); /* take 'alpha', etc., even if long_identifiers == 0 */
if(!err)
return 0;
switch(long_identifiers)
{ case 0: /* single-letter identifiers only */
*out = in + 1;
marker = space; /* use stack space */
marker[0] = in[0];
marker[1] = '\0';
*ans = make_atom_from_string2(marker);
i=1;
while(in[i]==32)
++i; /* eat any subsequent blanks */
*out = in+i;
return 0;
case 2: /* one letter and possibly numbers after that */
++marker;
count = 1;
while( *marker > 0 && isdigit(*marker) )
{ ++ marker;
++ count;
}
if(count >= MAXIDENTIFIER)
return 329; /* variable name too long */
marker = space;
for(i=0; i< count; i++)
marker[i] = in[i];
marker[count] = '\0';
*ans = make_atom_from_string2( marker);
if(FUNCTOR(*ans) == ILLEGAL)
return 323; /* Too many subscripted variables. */
/* Out of string space in newatom */
while(in[count] == 32)
++count; /* eat any subsequent blanks */
*out = in + count;
return 0;
case 3: /* begin with letter, then any alphanumerics */
++marker;
count = 1;
while( isalnum(*marker) )
{ ++ marker;
++ count;
}
if(count >= MAXIDENTIFIER)
return 329; /* variable name too long */
marker = space;
for(i=0; i< count; i++)
marker[i] = in[i];
marker[count] = '\0';
*ans = make_atom_from_string2( marker);
if(FUNCTOR(*ans) == ILLEGAL)
return 324; /* Too many long variable names. */
while(in[count] == 32) ++count; /* eat any subsequent blanks */
*out = in + count;
return 0;
}
return 0; /* just to keep Turbo C from complaining */
}
/*_______________________________________________________________*/
/* recognize strings like 'alpha'; return terms with specified greek functors */
/* These terms should be made with make_atom_from_string2 so that
an entry in the value list gets created, because they might be used
as parameters or otherwise evaluated. */
#define DIM 16
static int greek( term *ans, char *in, char **out)
{ int i=0;
char z[DIM];
if(in[0] == '\\')
++in; /* accept TeX notation such as \beta */
while(in[i] >= 0 && isalpha(in[i]) )
{ z[i] = in[i];
i++; /* make a string out of it */
if(i==DIM)
return -1; /* don't overflow the buffer; all Greek letter names
are shorter than this. */
}
z[i] = '\0';
switch(z[0])
{ case 'a': if (!strcmp(z,"alpha"))
break;
return -1;
case 'f': if (!strcmp(z,"false"))
break;
return -1;
case 'b' : if (!strcmp(z,"beta"))
break;
if (!strcmp(z,"bigphi"))
break;
return -1;
case 'i' : if (!strcmp(z,"infinity"))
break;
if (!strcmp(z,"infty"))
break; /* accept TeX notation for infinity */
return -1;
case 'g' : if (!strcmp(z,"gamma"))
break;
return -1;
case 'd' : if (!strcmp(z,"delta"))
break;
return -1;
case 'E' :
case 'e' : if (!strcmp(z,"epsilon"))
break;
if (!strcmp(z,"Eulergamma"))
break;
if(!strcmp(z,"eulergamma"))
break;
if(!strcmp(z,"EulerGamma"))
break;
return -1;
case 'l' : if (!strcmp(z,"lambda"))
break;
return -1;
case 'm' : if (!strcmp(z,"mu"))
break;
return -1;
case 'n': if(!strcmp(z,"nu"))
break;
return -1;
case 'o': if (!strcmp(z,"omega"))
break;
return -1;
case 'p' : if (!strcmp(z,"phi"))
break;
if (!strcmp(z,"pi"))
break;
if (!strcmp(z, "psi"))
break;
return -1;
case 'r' : if (!strcmp(z,"rho"))
break;
return -1;
case 's' : if (!strcmp(z,"sigma"))
break;
return -1;
case 't' : if (!strcmp(z,"true"))
break;
if (!strcmp(z,"theta"))
break;
if (!strcmp(z,"tau"))
break;
return -1;
default : return -1;
}
*ans = make_atom_from_string2(z);
*out = in+i;
return 0;
}
#undef DIM
/*_______________________________________________________________*/
/* number must recognize integers, even ones which must be bignums.
But it must not call bignums.c, so that bignums.c can be overlaid
in the same space as the parser. Hence the parser does not actually
create bignums. Instead, when it processes a bignum it creates an
object with functor INTEGER, but the argument, instead of a bignum, is
just a string for display by confirm_problem.
Number must also recognize floats.
But it does NOT recognize negative numbers, which are parsed as
terms with functor -. Negative numbers don't enter MATHPERT at all.
*/
int number( term *p, char *in, char **out)
{ int i;
int initialzerocount = 0;
unsigned long m;
char *marker = in;
char *marker2;
double ans;
int count = 0;
if (! isdigit(*in) && *in != decimalchar )
return -1;
/* Ignore initial zeroes: */
while(*marker == '0')
{ ++marker;
++initialzerocount;
}
if( initialzerocount && !isdigit(*marker) && *marker != decimalchar)
{ *p = pmake_int(0);
*out = marker;
return 0;
}
if(initialzerocount && *marker == ',' && decimalchar == ',' && !isdigit(marker[1]))
{ *p = pmake_int(0);
*out = marker;
return 0;
}
if(initialzerocount)
in += initialzerocount;
/* decide if this is a floating-point or integer number */
while( isdigit(*marker) )
{ ++marker;
++ count;
}
if( decimalchar == ',' && count == 0 && *marker == decimalchar && initialzerocount == 0)
return -1; /* in French, ,3 must be written 0,3 */
if( *marker == decimalchar &&
(isdigit(marker[1]) || /* it's a decimal number */
(marker[1] == 'e' && (marker[2] == '+' || marker[2] == '-') && isdigit(marker[3]) && isdigit(marker[4]) && isdigit(marker[5]))
/* or is an e-notation number produced by atof */
)
)
{ if(count >= 308)
{ *out = in;
return 301; /* too large a decimal number */
/* a VERY unlikely error--user enters 308 digits ! */
}
++marker;
++count; /* pass the decimal point */
while(isdigit(*marker) )
{ ++ marker;
++ count; /* fractional part */
}
if(marker[0] == 'e' && (marker[1] == '+' || marker[1] == '-') &&
isdigit(marker[2]) && isdigit(marker[3]) && isdigit(marker[4])
)
/* an e-notation number like 4.56e+002 */
count += 5;
marker = callocate(count + 1, sizeof(char));
if(marker == NULL)
nospace();
for(i=0; i< count; i++)
{ if(in[i] == decimalchar)
marker[i] = '.' ;
else
marker[i] = in[i];
}
marker[count] = '\0';
if(count == 1 && marker[0] == '.')
return -1; /* e.g. in French, "," is not a number. But atof will succeed
on it and make it zero. */
/* because atof is locale-sensitive, this probably doesn't work right
in French Win32. I don't know what atof does in French Win16 or when
compiled as a 16-bit program and run on French Win32.
*/
ans = atof(marker);
free2(marker);
*p = pmake_double(ans);
*out = in + count;
return 0;
}
/* Now it's not a float, so it must be an integer */
marker = callocate(count+1,sizeof(char));
if(marker ==NULL)
nospace();
for(i=0; i<count; i++)
marker[i] = in[i];
marker[count] = '\0';
m = atol(marker);
/* Now, was there overflow, or not? */
marker2 = callocate(count+1,sizeof(char));
if(marker2 == NULL)
nospace();
sprintf(marker2,"%ld",m); /* convert m back to a string */
if( strcmp(marker,marker2)) /* overflow, use bignums */
/* Note bignums are used if a LONG overflows, not
only if an UNSIGNED LONG overflows, because Mathpert
uses signed longs for integers */
{ free2(marker2);
*p = make_fake_bignum(marker);
free2(marker); /* make_fake_bignum allocates a new copy */
bignumflag = 1; /* this global variable is set and examined by bparse */
*out = in + count;
return 0;
}
else /* no overflow */
{ *p = pmake_int(m);
*out = in+count;
free2(marker);
free2(marker2);
return 0;
}
}
/*_____________________________________________________________________*/
/* aterm --> '*', blank_list,afactor, aterm.
aterm --> '/', blank_list,afactor,term1.
aterm --> afactor,aterm.
aterm --> blank_list.
Thus identical to 'term1' but won't take a factor which is a function_term.
It's called after a prefix function like log or sqrt to get
sqrt x sqrt y parsed as (sqrt x) * (sqrt y)
*/
static int aterm(term x, term *t, char *in, char **out)
{ int err,i;
char *next, *rest;
term f,newt,newx;
if( in[0] == '/' ) /* aterm --> '/', blank_list, pfactor, term1. */
{ blank_list(in+1,&next);
err = afactor(&f,next,&rest);
if(err>0)
{ *out = rest;
return err;
}
if(err<0)
{ *out = next;
return 270; /* expression expected */
}
newt = pmake_term('/',2);
ARGREP(newt,0,x);
ARGREP(newt,1,f);
err = term1(newt,t,rest,out);
if(err>0)
return err;
if(err<0)
{ *out = rest;
return 271; /* expression expected*/
}
return 0;
}
if (in[0] == '*' ) /* aterm --> '*', blank_list, afactor, aterm. */
blank_list(in+1,&next);
else if( unwritten_mult ) /* a global variable */
blank_list(in,&next);
else
{ *out = in;
return 272; /* expression expected */
}
err = afactor(&f,next,&rest);
if (err > 0)
{ *out = rest;
return err;
}
if (err < 0) /* aterm --> blank_list. */
{ blank_list(next,out);
*t = x;
return 0;
}
if (FUNCTOR(x) == '*' ) /* then append the arguments */
{ newx = pmake_term('*',(unsigned short)(ARITY(x)+1));
for(i=0;i<ARITY(x);i++)
ARGREP(newx,i,ARG(i,x));
RELEASE(x);
ARGREP(newx,ARITY(x),f);
err = aterm(newx,t,rest,out);
if(err>0)
return err;
if(err<0)
{ *out = rest;
return 274; /* expression expected */
}
}
else /* FUNCTOR(x) != '*' */
{ newx = pmake_term('*',2);
ARGREP(newx,0,x);
ARGREP(newx,1,f);
err = aterm(newx,t,rest,out);
if(err>0)
return err;
if(err<0)
{ *out = rest;
return 275; /* expression expected */
}
}
return 0;
}
/*_____________________________________________________________________*/
/* afactor --> aprimary, factor1. */
static int afactor(term *f, char *in, char **out)
{ int err;
char *next;
term p;
err = primary(1,&p,in,&next); /* the 1 says this is 'aprimary' */
if(err > 0)
{ *out = next;
return err;
}
if (err < 0)
{ *out = in;
return -1;
}
err = factor1(p,f,next,out);
if (err > 0)
return err;
if (err < 0)
{ *out = in;
return -1;
}
return 0;
}
/*______________________________________________________________________*/
static int funcname( unsigned short *f, char *in, char **out)
/* returns indirectly a value *f for use as a functor by make_term;
Return value -1 when the input is not a function name
2 when the function symbol is new (so may not turn out to
be a function name)
0 for success
some other error returns are possible, see comments in the code.
*/
/* It must not be case-sensitive with regard to known functors; thus
'sin' and 'Sin' and 'SIN' are all the same; but it must be case-sensitive
with regard to unknown functors or defined functions. The main exception is
one-character built-in functors: these must be typed in upper-case. This applies
also to Bessel functions (which parse to binary functions with one-character
functors, even though typed as J0(x) or Y0(x)). Another exception is
Re[x] and Im[x], which have to be typed with capital R and I.
*/
{ char buffer[32]; /* maximum length of functor names is 31 */
char *marker,*marker1, *marker2;
int i=0;
int j=0;
int len;
long g;
int TeXflag = 0;
if(in[0] == '\\')
{ TeXflag = 1;
++in; /* ignore initial backslash, as in "\sin x" */
}
if (in[0] < 0 || ! isalpha(in[0]))
return -1; /* this is no function name */
/* check for a user-defined function */
for(i=0;i<NFUNCTIONS;i++)
{ if(defined_functions[i])
{ marker1 = in;
marker2 = defined_functions[i];
while(*marker1 && *marker2 && *marker1 == *marker2)
{ ++marker1;
++marker2;
}
if(*marker2 == 0 && (*marker1 == ' ' || *marker1 == '(' || *marker1 == '[' || *marker1 == '{'))
{ *f = defined_functors[i];
*out = marker1;
return 0;
}
}
}
i=0;
if(in[1] >= 0 && isalpha(in[1])) /* convert names longer than one character to uppercase */
{ while( (i<31) && in[i] >= 0 && isalpha(in[i]))
{ buffer[i] = (char) toupper(in[i]);
i++;
}
}
else
{ i=1;
buffer[0] = in[0];
}
if (in[i] >= 0 && isalpha(in[i]))
{ *out = TeXflag ? in-1 : in;
return 312; /* names cannot exceed 31 characters */
}
buffer[i] = '\0'; /* now buffer contains an upper-case copy of the name,
unless the name was only one character, in which
case it contains it lower-case or upper-case, as
it originally occurred. */
g = strip_functor(buffer,&len); /* so now check if it begins with a built-in functor */
*f = (unsigned short) g;
if( (*f==REALPART || *f==IMAGPART || *f==BETAFUNCTION || *f==GAMMA) && in[0] > 96)
return -1;
/* accept only upper-case first letter for Re, Im, Gamma, and Beta */
if (g > 0) /* a built-in functor */
{ i = len;
while(in[i] == 32)
++i;
*out = in+i;
if(
(g == BESSELI || g == BESSELY || g == BESSELK || g == BESSELJ) &&
(**out == '(' || **out == '[')
)
{ /* we want to accept Y(x) as a new (non-Bessel) function */
marker = *out + 1;
while(*marker == 32 || isalnum(*marker))
++marker;
if(*marker == ')' || *marker == ']')
{ *f = in[0]; /* e.g. 'K', not BESSELK */
return 2;
}
}
return 0;
}
/* now, is buffer equal to any entry in the 'functors' array? */
/* There will typically be zero or only one or two entries in this
array, so it's not worthwhile to keep hash tables */
while( (j<31) && in[j] > 0 && isalnum(in[j]))
/* in[j] > 0 : don't pass high ascii, which will be negative since j is signed, to isalnum */
{ buffer[j] = in[j]; /* copy the putative function name into
buffer retaining case sensitivity */
j++;
}
buffer[j] = '\0';
if(i==1) /* a one-character functor */
{ if(in[0] >= 0 && isalpha(in[0])) /* accept it just like that */
{ *f = in[0];
while(in[i] == 32) ++i;
*out = in+i;
return 2; /* signifying a new 1-character function */
}
else
return -1; /* not an acceptable function name */
}
return -1; /* not a built-in or pre-defined funcname */
}
/*______________________________________________________________________*/
short strip_functor(char *buffer, int *len)
/* if buffer contains a string that begins with a built-in functor
name of length 3 or more, return the corresponding #defined index, e.g. SQRT, and the
length of the name, e.g. 4 for "sqrt". If buffer is exactly equal to
a functor of length 1 or 2, return the functor index and length in that
case also. The buffer may contain
more characters, e.g. "sqrtx". For example if the buffer contains
"coshx", then COSH will be returned with 4 in *len. The hyperbolic
functions are the only cases in which one function name has another
for an initial segment. Return -1 in case there is no built-in
functor name as an initial segment of buffer. Buffer is presumed to
contain only upper-case characters.
This way, "sqrtx" will parse as sqrt(x).
*/
{ switch(buffer[0])
{ case 'A':
switch (buffer[1])
{ case 'B' :
if(buffer[2] == 'S')
{ *len = 3;
return ABSFUNCTOR;
}
break;
case 'C' :
if(buffer[2] == '0' && buffer[3] == 'S' && buffer[4] == 'H')
{ *len = 5;
return ACOSH;
}
if (buffer[2] == '0' && buffer[3] == 'T' && buffer[4] == 'H')
{ *len = 5;
return ACOTH;
}
if (buffer[2] == 'S' && buffer[3] == 'C' && buffer[4] == 'H')
{ *len = 5;
return ACSCH;
}
if (buffer[2] == '0' && buffer[3] == 'S' )
{ *len = 5;
return ACOS;
}
if (buffer[2] == '0' && buffer[3] == 'T')
{ *len = 5;
return ACOT;
}
if (buffer[2] == 'S' && buffer[3] == 'C')
{ *len = 5;
return ACSC;
}
break;
case 'L' :
if (buffer[2] == 'L')
{ *len = 3;
return FORALL;
}
break;
case 'N' :
if(buffer[2] == 'D')
{ *len = 3;
return AND;
}
break;
case 'R' :
if(buffer[2] == 'C')
switch(buffer[3])
{ case 'S':
if(buffer[4] == 'I' && buffer[5] == 'N' && buffer[6] == 'H')
{ *len = 7;
return ASINH;
}
if(buffer[4] == 'I' && buffer[5] == 'N')
{ *len = 6;
return ASIN;
}
if(buffer[4] == 'E' && buffer[5] == 'C' && buffer[6] == 'H')
{ *len = 7;
return ASECH;
}
if(buffer[4] == 'E' && buffer[5] == 'C')
{ *len = 6;
return ASEC;
}
break;
case 'C':
if(buffer[4] == 'O' && buffer[5] == 'S' && buffer[6] == 'H')
{ *len = 7;
return ACOSH;
}
if(buffer[4] == 'O' && buffer[5] == 'S')
{ *len = 6;
return ACOS;
}
if(buffer[4] == 'O' && buffer[5] == 'T' && buffer[6] == 'H')
{ *len = 7;
return ACOTH;
}
if(buffer[4] == 'O' && buffer[5] == 'T')
{ *len = 6;
return ACOT;
}
if(buffer[4] == 'S' && buffer[5] == 'C' && buffer[6] == 'H')
{ *len = 7;
return ACSCH;
}
if(buffer[4] == 'S' && buffer[5] == 'C')
{ *len = 6;
return ACSC;
}
break;
case 'T':
if(buffer[4] == 'A' && buffer[5] == 'N' && buffer[6] == 'H')
{ *len = 7;
return ATANH;
}
if(buffer[4] == 'A' && buffer[5] == 'N')
{ *len = 6;
return ATAN;
}
break;
}
break;
case 'S' :
if(buffer[2] == 'E' && buffer[3] == 'C' && buffer[4] == 'H')
{ *len = 5;
return ACSCH;
}
if(buffer[2] == 'E' && buffer[3] == 'C')
{ *len = 4;
return ASEC;
}
if(buffer[2] == 'I' && buffer[3] == 'N' && buffer[4] == 'H')
{ *len = 5;
return ASINH;
}
if(buffer[2] == 'I' && buffer[3] == 'N')
{ *len = 3;
return ASIN;
}
break;
case 'T':
if(buffer[2] == 'A' && buffer[3] == 'N' && buffer[4] == 'H')
{ *len = 5;
return ATANH;
}
if(buffer[2] == 'A' && buffer[3] == 'N')
{ *len = 4;
return ATAN;
}
break;
}
break;
case 'B':
if(!strncmp(buffer,"BINOMIAL",8))
{ *len = 8;
return BINOMIAL;
}
if(!strncmp(buffer,"BETA",4))
{ *len = 4;
return BETAFUNCTION;
}
if(!strncmp(buffer,"BERNOULLI",9))
{ *len = 9;
return BERNOULLI;
}
break;
case 'C':
switch(buffer[1])
{ case 'O':
if(buffer[2] == 'S' && buffer[3] == 'H')
{ *len = 4;
return COSH;
}
if(buffer[2] == 'S' && !strncmp(buffer,"COSINTEGRAL",11))
{ *len = 11;
return COSINTEGRAL;
}
if(buffer[2] == 'S')
{ *len = 3;
return COS;
}
if(buffer[2] == 'F' && buffer[3] == 'I')
{ *len = 4;
return CONSTANTOFINTEGRATION;
}
if(buffer[2] == 'T' && buffer[3] == 'H')
{ *len = 4;
return COTH;
}
if(buffer[2] == 'T')
{ *len = 3;
return COT;
}
break;
case 'S':
if(buffer[2] == 'C' && buffer[3] == 'H')
{ *len = 4;
return CSCH;
}
if(buffer[2] == 'C')
{ *len = 3;
return CSC;
}
break;
case 'A':
if(!strncmp(buffer,"CASES",5))
{ *len = 5;
return CASES;
}
break;
}
break;
case 'D':
if(!strncmp(buffer,"DEG",3))
{ *len = 3;
return DEG;
}
if(!strncmp(buffer,"DET",3))
{ *len = 3;
return DET;
}
if(!strncmp(buffer,"DIFF",4))
{ *len = 4;
return DIFF;
}
if(!strncmp(buffer,"DIGAMMA",7))
{ *len = 7;
return DIGAMMA;
}
break;
case 'E':
if(!strncmp(buffer,"ERFC",4))
{ *len = 4;
return ERFC;
}
if(!strncmp(buffer,"ERF",3))
{ *len = 3;
return ERF;
}
if(!strncmp(buffer,"EVAL",4))
{ *len = 4;
return EVAL;
}
if(!strncmp(buffer,"EXPINTEGRALE",12))
{ *len = 12;
return EXPINTEGRALE;
}
if(!strncmp(buffer,"EXPINTEGRALI",12))
{ *len = 12;
return EXPINTEGRALE;
}
if(!strncmp(buffer,"EXISTS",6))
{ *len = 6;
return EXISTS;
}
if(!strncmp(buffer,"EULERNUMBER",9))
{ *len = 11;
return EULERNUMBER;
}
break;
case 'F':
if(!strncmp(buffer,"FLOOR",5))
{ *len = 5;
return FLOOR;
}
if(!strncmp(buffer,"FACTORIAL",9))
{ *len = 9;
return FACTORIAL;
}
break;
case 'G':
if(!strncmp(buffer,"GCD",3))
{ *len = 3;
return GCD;
}
if (!strncmp(buffer,"GAMMA",5))
{ *len = 5;
return GAMMA;
}
break;
case 'I' :
if(!strncmp(buffer,"INTEGRAL",8))
{ *len = 8;
return INTEGRAL;
}
if(!strncmp(buffer,"IF",2))
{ *len = 2;
return IF;
}
if(!strncmp(buffer,"INCOMPLETEBETA",14))
{ *len = 14;
return INCOMPLETEBETA;
}
if(!strncmp(buffer,"INCOMPLETEGAMMAP",16))
{ *len = 16;
return INCOMPLETEGAMMAP;
}
if(!strncmp(buffer,"INCOMPLETEGAMMA",15))
{ *len = 15;
return INCOMPLETEGAMMA;
}
if(buffer[1] == 'M')
{ *len = 2;
return IMAGPART;
}
if(!strncmp(buffer,"INVERSE",7))
{ *len = 7;
return MATRIXINVERSE;
}
if(!strcmp(buffer,"I"))
/* Not strncmp; Ix will be parsed as I times x */
{ *len = 1;
return BESSELI;
}
break;
case 'J':
if (!strcmp(buffer,"J"))
{ *len = 1;
return BESSELJ;
}
break;
case 'K':
if (!strcmp(buffer,"K"))
{ *len = 1;
return BESSELK;
}
break;
case 'L':
if (!strncmp(buffer,"LOG",3))
{ *len = 3;
return LOG;
}
if (buffer[1] == 'N')
{ *len = 2;
return LN;
}
if(!strncmp(buffer,"LIMIT",5))
{ *len = 5;
return LIMIT;
}
if (!strncmp(buffer,"LIM",3))
{ *len = 3;
return LIMIT;
}
if(!strncmp(buffer,"LOGINTEGRAL",11))
{ *len = 11;
return LOGINTEGRAL;
}
if (!strncmp(buffer,"LAMBDA",3))
{ *len = 6;
return LAM;
}
if (!strncmp(buffer,"LAM",3))
{ *len = 3;
return LAM;
}
break;
case 'M':
if(!strncmp(buffer,"MATRIX",5))
{ *len = 5;
return MATRIX;
}
if (!strncmp(buffer,"MOD",3))
{ *len = 3;
return MOD;
}
if(!strncmp(buffer,"MIN",3))
{ *len = 3;
return MINFUNCTOR;
}
if(!strncmp(buffer,"MAX",3))
{ *len = 3;
return MAXFUNCTOR;
}
break;
case 'N':
if (!strncmp(buffer,"NOT",3))
{ *len = 3;
return NOT;
}
break;
case 'O':
if (!strncmp(buffer, "OR",2))
{ *len = 2;
return OR;
}
break;
case 'P':
if (!strcmp(buffer,"PE"))
/* strcmp, not strncmp; pex parses as p times e time x */
{ *len = 2;
return WEIERSTRASSP;
}
if (!strncmp(buffer,"PRODUCT",7))
{ *len = 7;
return PRODUCT;
}
if (!strncmp(buffer,"POLYGAMMA",9))
{ *len = 9;
return POLYGAMMA;
}
if (!strncmp(buffer,"PRIME",5))
{ *len = 5;
return PR;
}
break;
case 'R':
if (!strncmp(buffer,"ROOT",4))
{ *len = 4;
return ROOT;
}
if (!strcmp(buffer,"RE")) /* not strncmp; rex parses as r time e time x */
{ *len = 2;
return REALPART;
}
break;
case 'S':
if (!strncmp(buffer,"SINH",4))
{ *len = 4;
return SINH;
}
if (!strncmp(buffer,"SININTEGRAL",11))
{ *len = 11;
return SININTEGRAL;
}
if (!strncmp(buffer,"SIN",3))
{ *len = 3;
return SIN;
}
if (!strncmp(buffer,"SECH",4))
{ *len = 4;
return SECH;
}
if (!strncmp(buffer,"SEC",3))
{ *len = 3;
return SEC;
}
if (!strncmp(buffer,"SQRT",4))
{ *len = 4;
return SQRT;
}
if (!strncmp(buffer,"SUM",3))
{ *len = 3;
return SUM;
}
if (!strcmp(buffer,"SGN")) /* accept sgn(x) or sg(x) */
{ *len = 3;
return SG;
}
if (!strcmp(buffer,"SG")) /* not strncmp; sgx parses as s times g times x */
{ *len = 2;
return SG;
}
break;
case 'T':
if (!strncmp(buffer,"TANH",4))
{ *len = 4;
return TANH;
}
if (!strncmp(buffer,"TAN",3))
{ *len = 3;
return TAN;
}
break;
case 'V':
if (!strncmp(buffer,"VECTOR",6))
{ *len = 6;
return VECTOR;
}
break;
case 'W':
if (!strncmp(buffer,"WEIERSTRASSP",12))
{ *len = 12;
return WEIERSTRASSP;
}
break;
case 'Y':
if (!strcmp(buffer,"Y")) /* not strncmp */
{ *len = 1;
return BESSELY;
}
break;
case 'Z':
if (!strncmp(buffer,"ZETA",4))
{ *len = 4;
return RIEMANNZETA;
}
break;
}
return -1; /* not a known functor */
}
/*________________________________________________________________________*/
short string_functor(char *buffer)
/* buffer contains an all-upper-case string. If it is a built-in functor,
return the corresponding #-defined value; else return -1 */
/* Elliptic integrals, hypergeometric functions, Legendre polynomials
can't be parsed--they only arise as answers, at least for now. Since this
is also called by readdoc, documents involving such answers can't be
opened yet either. */
{
switch(buffer[0])
{ case 'A':
switch (buffer[1])
{ case 'B' : if(!strcmp(buffer,"ABS")) return ABSFUNCTOR;
break;
case 'C' : if (!strcmp(buffer,"ACOS")) return ACOS;
if (!strcmp(buffer,"ACOT")) return ACOT;
if (!strcmp(buffer,"ACSC")) return ACSC;
if (!strcmp(buffer,"ACOSH")) return ACOSH;
if (!strcmp(buffer,"ACOTH")) return ACOTH;
if (!strcmp(buffer,"ACSCH")) return ACSCH;
if (!strcmp(buffer,"CASES")) return CASES;
break;
case 'L' : if (!strcmp(buffer,"ALL")) return FORALL;
break;
case 'N' : if (!strcmp(buffer,"AND")) return AND;
break;
case 'R' : if (!strcmp(buffer,"ARCSIN")) return ASIN;
if (!strcmp(buffer,"ARCCOS")) return ACOS;
if (!strcmp(buffer,"ARCTAN")) return ATAN;
if (!strcmp(buffer,"ARCSEC")) return ASEC;
if (!strcmp(buffer,"ARCCSC")) return ACSC;
if (!strcmp(buffer,"ARCCOT")) return ACOT;
if (!strcmp(buffer,"ARCSINH")) return ASINH;
if (!strcmp(buffer,"ARCCOSH")) return ACOSH;
if (!strcmp(buffer,"ARCTANH")) return ATANH;
if (!strcmp(buffer,"ARCSECH")) return ASECH;
if (!strcmp(buffer,"ARCCSCH")) return ACSCH;
if (!strcmp(buffer,"ARCCOTH")) return ACOTH;
break;
case 'S' : if (!strcmp(buffer, "ASEC")) return ASEC;
if (!strcmp(buffer, "ASECH")) return ASECH;
if (!strcmp(buffer,"ASIN")) return ASIN;
if (!strcmp(buffer,"ASINH")) return ASINH;
break;
case 'T' : if (!strcmp(buffer, "ATAN")) return ATAN;
if (!strcmp(buffer, "ATANH")) return ATANH;
break;
}
break;
case 'B': if (!strcmp(buffer,"BINOMIAL")) return BINOMIAL;
if (!strcmp(buffer,"BETA")) return BETAFUNCTION;
if (!strcmp(buffer,"BERNOULLI")) return BERNOULLI;
break;
case 'C': if (!strcmp(buffer,"COS")) return COS;
if (!strcmp(buffer,"COSH")) return COSH;
if (!strcmp(buffer,"COT")) return COT;
if (!strcmp(buffer,"COTH")) return COTH;
if (!strcmp(buffer,"CSC")) return CSC;
if (!strcmp(buffer,"CSCH")) return CSCH;
if (!strcmp(buffer,"CASES")) return CASES;
if (!strcmp(buffer,"COFI")) return CONSTANTOFINTEGRATION;
/* must be parseable for cut-and-paste to work */
if (!strcmp(buffer,"COSINTEGRAL")) return COSINTEGRAL;
break;
case 'D': if (!strcmp(buffer,"DEG")) return DEG;
if (!strcmp(buffer,"DET")) return DET;
if (!strcmp(buffer,"DIFF")) return DIFF;
if (!strcmp(buffer,"DIGAMMA")) return DIGAMMA;
break;
case 'E': if (!strcmp(buffer,"ERF")) return ERF;
if (!strcmp(buffer,"ERFC")) return ERFC;
if (!strcmp(buffer,"EVAL")) return EVAL;
if (!strcmp(buffer,"EXPINTEGRALE")) return EXPINTEGRALE;
if (!strcmp(buffer,"EXPINTEGRALI")) return EXPINTEGRALE;
if (!strcmp(buffer,"EXISTS")) return EXISTS;
if (!strcmp(buffer,"EULERNUMBER")) return EULERNUMBER;
if (!strcmp(buffer,"EULERGAMMA")) return EULERGAMMA;
break;
case 'F': if (!strcmp(buffer,"FLOOR")) return FLOOR;
if( !strcmp(buffer,"FACTORIAL")) return FACTORIAL;
break;
case 'G': if (!strcmp(buffer,"GCD")) return GCD;
if (!strcmp(buffer,"GAMMA")) return GAMMA;
break;
case 'I' : if (!strcmp(buffer,"INTEGRAL")) return INTEGRAL;
if (!strcmp(buffer,"IF")) return IF;
if (!strcmp(buffer,"I")) return BESSELI;
if (!strcmp(buffer,"INCOMPLETEBETA")) return INCOMPLETEBETA;
if (!strcmp(buffer,"INCOMPLETEGAMMA")) return INCOMPLETEGAMMA;
if (!strcmp(buffer,"INCOMPLETEGAMMAP")) return INCOMPLETEGAMMAP;
if (!strcmp(buffer,"IM")) return IMAGPART;
if (!strcmp(buffer,"INVERSE")) return MATRIXINVERSE;
break;
case 'J': if (!strcmp(buffer,"J")) return BESSELJ;
break;
case 'K': if (!strcmp(buffer,"K")) return BESSELK;
break;
case 'L': if (!strcmp(buffer,"LOG")) return LOG;
if (!strcmp(buffer,"LN")) return LN;
if (!strcmp(buffer,"LIM")) return LIMIT;
if (!strcmp(buffer,"LIMIT")) return LIMIT;
if (!strcmp(buffer,"LOGINTEGRAL")) return LOGINTEGRAL;
if (!strcmp(buffer,"LAM")) return LAM;
if (!strcmp(buffer,"LAMBDA")) return LAM;
break;
case 'M': if (!strcmp(buffer,"MATRIX")) return MATRIX;
if (!strcmp(buffer,"MOD")) return MOD;
if(!strcmp(buffer,"MIN")) return MINFUNCTOR;
if(!strcmp(buffer,"MAX")) return MAXFUNCTOR;
break;
case 'N': if (!strcmp(buffer,"NOT")) return NOT;
break;
case 'P': if (!strcmp(buffer,"PE")) return WEIERSTRASSP;
if (!strcmp(buffer,"PRODUCT")) return PRODUCT;
if (!strcmp(buffer,"POLYGAMMA")) return POLYGAMMA;
break;
case 'R': if (!strcmp(buffer,"ROOT")) return ROOT;
if (!strcmp(buffer,"RE")) return REALPART;
break;
case 'S': if (!strcmp(buffer,"SIN")) return SIN;
if (!strcmp(buffer,"SINH")) return SINH;
if (!strcmp(buffer,"SEC")) return SEC;
if (!strcmp(buffer,"SECH")) return SECH;
if (!strcmp(buffer,"SQRT")) return SQRT;
if (!strcmp(buffer,"SUM")) return SUM;
if (!strcmp(buffer,"SININTEGRAL")) return SININTEGRAL;
if (!strcmp(buffer,"SG")) return SG;
break;
case 'T': if (!strcmp(buffer,"TAN")) return TAN;
if (!strcmp(buffer,"TANH")) return TANH;
break;
case 'V': if (!strcmp(buffer,"VECTOR")) return VECTOR;
break;
case 'W': if (!strcmp(buffer,"WEIERSTRASSP")) return WEIERSTRASSP;
break;
case 'Y': if (!strcmp(buffer,"Y")) return BESSELY;
break;
case 'Z': if (!strcmp(buffer,"ZETA")) return RIEMANNZETA;
break;
}
return -1; /* not a known functor */
}
/*______________________________________________________________________*/
short correct_arity(short x)
/* return the correct arity of a built-in functor or user-defined functor */
/* or -1 if it isn't determined */
/* is not used for log, logb, diff, or integral, or for +, *, and, or; */
/* returns 1 for Bessel functions even though the index gets parsed as an
argument; so after_funcname gets 1 for nargs and adds an extra arg
for the subscript. */
{ int i;
if (UNARY(x) || x == CONSTANTOFINTEGRATION)
return 1;
/* check for user-defined functor */
for(i=0;i<NFUNCTIONS;i++)
{ if(x == defined_functors[i])
return defined_arities[i];
}
if ((x) < BINARYBOUND)
return 2;
if ((x == SUM) || (x == PRODUCT))
return 4; /* but 5 is also acceptable; the last arg gives display info */
/* now for 'special functions' >= GAMMA: */
switch(x)
{ case GAMMA : /* fall-through */
case DIGAMMA:
case COSINTEGRAL:
case SININTEGRAL:
case LOGINTEGRAL:
case ERF:
case ERFC:
case EXPINTEGRALI:
case RIEMANNZETA:
case BERNOULLI:
case EULERNUMBER:
case COMPLETE_ELLIPTIC1:
case COMPLETE_ELLIPTIC2: return 1;
case COMPLETE_ELLIPTIC3: return 2;
case ELLIPTICF: return 2;
case ELLIPTICE: return 2;
case ELLIPTICPI: return 3;
case EXPINTEGRALE: return 2;
case BETAFUNCTION: return 2;
case INCOMPLETEBETA: return 3;
case INCOMPLETEGAMMA: return 2;
case INCOMPLETEGAMMAP: return 2;
case EXISTS: return 2;
case FORALL: return 2;
case EVAL: return 4;
case LAM: return 2; // for lambda calculus
case POLYGAMMA: return 2;
}
return -1;
}
/*_________________________________________________________________*/
static int intervalterm(term expr, term *ans, char *in, char **out)
/* parse a<b<c ; a <= b < c etc. */
/* in has the form <= c where e.g. a<b has already been parsed;
expr holds the term (a<b) and we want to return
and(expr,b<=c) in *ans */
{ term c,right;
int err;
unsigned short g;
if(in[1] == '=')
{ g = LE;
err = lfactor(&c,in+2,out);
}
else
{ g = '<';
err = lfactor(&c,in+1,out);
}
if(err)
{ *out = in;
return err;
}
right = pmake_term(g,2);
ARGREP(right,1,c);
parser_copy(ARG(1,expr),ARGPTR(right));
/* Not ARGREP(right,0,ARG(1,expr)) because
then there are two pointers to this same term in the
result *ans of this parse; when we call destroy_term on it,
the second time we come to the subterm it will crash.
In short: destroy_term can only be used on TREE terms,
not DAGs, so the parser must make only TREES */
*ans = pmake_term(AND,2);
ARGREP(*ans,0,expr);
ARGREP(*ans,1,right);
SETINTERVAL(*ans); /* mark a bit to indicate this is an interval */
return 0;
}
/*_____________________________________________________________________*/
static term make_fake_bignum(char *x)
/* make a term that looks like a bignum but only points to a display
string of digits and commas. This is the kind of term returned
by the parser so that it doesn't have to call bignum.c */
/* display of bignums is controlled by global variable 'separator'.
separator == 0 means print using space, (blocks of 6 characters)
== 1 means no separation of digits
== 2 means blocks of 3 digits separated by commas
> 2 means blocks of 3 digist separated by ascii code specified
by separator.
*/
{ term ans;
int length = (int) strlen(x);
char sepchar;
SETFUNCTOR(ans,0,1);
ans.info = 0; /* initialize the info field to zero */
SETTYPE(ans,BIGNUM); /* but don't SETAE; thus a fake bignum has no value */
switch (separator)
{ case 1: /* no separation of digits */
if( (ans.args = (void *) callocate(length+1,sizeof(char))) == NULL)
{ SETFUNCTOR(ans,ILLEGAL,0); nospace();}
else strcpy((char *)ARGPTR(ans),x);
return ans;
case 0: /* print using blocks of 6 chars separated by space */
if( ( ans.args = (void *) callocate( 6*(length+2)/6,sizeof(char)))==NULL)
{ SETFUNCTOR(ans,ILLEGAL,0); nospace();}
else
{ int i=0,j=0;
int comma = (length % 6);
if( comma == 0) comma = 6;
while(i < length)
{ ((char *) ans.args)[j] = x[i];
i++;
j++;
switch (comma)
{ case 0 : comma = 6; break;
default : --comma; break;
}
if(comma==0) { ((char *) ans.args)[j] = 32; ++j; comma=6;}
}
((char *) ans.args)[j-1] = '\0'; /* overwrite last space */
}
return ans;
case 2: /* print using comma */
default:
sepchar = separator == 2 ? ',' : separator;
if( ( ans.args = (void *) callocate( 4*(length+2)/3,sizeof(char)))==NULL)
{ SETFUNCTOR(ans,ILLEGAL,0);
nospace();
return ans;
}
else
{ int i=0,j=0;
int comma = (length % 3);
if( comma == 0)
comma = 3;
while(i < length)
{ ((char *) ans.args )[j] = x[i];
i++;
j++;
switch (comma)
{ case 0 : comma = 3; break;
default : --comma; break;
}
if(comma==0)
{ ((char *) ans.args)[j] = sepchar;
++j;
comma=3;
}
}
((char *) ans.args)[j-1] = '\0'; /* overwrite last comma */
}
return ans;
}
}
/* _________________________________________________________________*/
static unsigned short string_to_atom(char *x)
/* This must stay in sync with the non-static copy in vaux.c */
{ char *marker;
if(x[1] == '\0') /* a one-symbol atom */
return x[0]; /* return the ASCII code of that symbol */
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':
case 'e':
if( !strcmp(x,"epsilon")) return EPSILON;
if( !strcmp(x,"eulergamma") || !strcmp(x,"Eulergamma")
|| !strcmp(x,"EulerGamma")
)
return EULERGAMMA;
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 INFINITYFUNCTOR;
if( !strcmp(x,"infty")) return INFINITYFUNCTOR;
break;
case 'l':
if( !strcmp(x,"lambda")) return LAMBDA;
break;
case 'm':
if( !strcmp(x,"mu")) return MU;
break;
case 'n':
if( !strcmp(x,"nu")) return NU;
break;
case 'o':
if( !strcmp(x,"omega")) return OMEGA;
break;
case 'p':
if( !strcmp(x,"phi")) return PHI;
if( !strcmp(x,"pi")) return PI_ATOM;
if( !strcmp(x,"psi")) return PSI;
break;
case 'r':
if( !strcmp(x,"rho")) return RHO;
break;
case 's':
if( !strcmp(x,"sigma")) return SIGMA;
break;
case 't':
if( !strcmp(x,"theta")) return THETA;
if( !strcmp(x,"true")) return TRUEFUNCTOR;
if( !strcmp(x,"tau")) return TAU;
break;
case 'z':
if( !strcmp(x,"zeta")) return RIEMANNZETA;
break;
}
/* Check for a subscripted variable */
for(marker = x+1; *marker; ++marker)
{ if(!isdigit(*marker))
break;
}
if(*marker == '\0')
{ /* a subscripted variable */
unsigned subscript = atoi(x+1);
if(subscript > MAXSUBSCRIPT)
subscript = subscript % (MAXSUBSCRIPT+1);
/* truncate, see comments above */
return (unsigned short) SUBSCRIPTEDFUNCTOR(x[0],subscript);
}
/* If we get here, it's a multi-character (user-defined) atom. */
if(long_identifiers == 0)
/* then it's an error */
return 329; /* variable name too long */
assert(newatom != NULL);
return newatom(x);
}
/*______________________________________________________________________*/
/* make_atom_from_string2 is the way in which atoms are originally to be
created, even if the string has length 1. This function calls permalloc
for string space, through "newatom".
*/
static term make_atom_from_string2( char *a)
/* DON'T CHANGE THIS without ensuring that it's the
same as make_atom_from_string in maketerm.c
*/
{ short atom;
term ans;
atom = string_to_atom(a);
if(atom == PI_ATOM)
return parser_pi; /* Use predefined atoms for pi and eulere */
if(atom == EULERGAMMA)
return eulergamma; /* and for Eulergamma too */
if(atom == 'e')
return eulere;
/* but not for 'i' even if 'complex' is nonzero, since we may
be changing it later to be a normal variable, and so we don't
want the value pointer to point into the static space of the
value pointer of complex i. */
SETFUNCTOR(ans,atom,0);
/* Now set the type of the variable */
ZEROINFO(ans); /* make sure the .info field is zero */
if(atom == 'i')
{ if(complex)
SETCOMPLEX(ans);
else
SETTYPE(ans,INTEGER);
}
else if( *a == 'n' || *a == 'm' || *a == 'k' || *a == 'j')
SETTYPE(ans,INTEGER);
else if (complex)
{ if(*a == 'x' || *a == 'y' || *a == 'u' || *a == 'v' ||
*a == 'X' || *a == 'Y' || *a == 'U' || *a == 'V'
)
SETTYPE(ans,R);
else
SETTYPE(ans,DCOMPLEX);
}
else
SETTYPE(ans,R);
return ans;
}
/*________________________________________________________________________*/
static int fix_bignums(term *t)
/* replace 'fake' bignums with the real McCoy */
/* must take term * so it can affect the term in the calling environment */
/* calls free2 on the display strings in *t, which are allocated by
parse in the first place. */
{ char *x, *y, *marker, *savex;
unsigned short n;
bignum b;
int i,err;
if(OBJECT(*t) && TYPE(*t)==BIGNUM && !AE(*t) ) /* a fake bignum */
{ x= (char *) ARGPTR(*t); /* pointer to display string */
savex = x;
n = (unsigned short) strlen(x);
if (n== 0xffff)
return 1; /* very unlikely but theoretically possible */
y = callocate(n+1,sizeof(char));
if(y==NULL)
return 1;
/* now copy x to y but delete all spaces and commas */
marker = y;
while(*x)
{ if(*x != 32 && *x != ',')
{ *marker = *x;
++marker;
}
++x;
}
*marker = '\0'; /* terminate string y */
err= string_bignum(y, (int) strlen(y),(bignum *) &b);
free2(y);
free2(savex); /* allocated by parse */
if(err)
return err;
t->args = callocate(1,sizeof(bignum));
if(t->args == NULL)
{ nospace();
return 1;
}
*((bignum *)(t->args)) = b;
SETAE(*t); /* make it a real, not a fake, bignum */
return 0;
}
/* so if we get here t was not a fake bignum */
if(ATOMIC(*t))
return 0; /* do nothing */
for(i=0; i< ARITY(*t);i++)
{ err = fix_bignums((term *) ARGPTR(*t) + i);
if (err)
return err;
}
return 0;
}
/*___________________________________________________________________________*/
static void strip_provisional(term *t)
/* set all PROVISIONAL bits of subterms of t with functor '+' or '*' to zero */
{ unsigned short i,n;
if(ATOMIC(*t))
return;
if(FUNCTOR(*t) == '+' || FUNCTOR(*t) == '*')
UNSETPROVISIONAL(*t);
n = ARITY(*t);
for(i=0;i<n;i++)
strip_provisional(ARGPTR(*t)+i);
}
/*___________________________________________________________________________*/
int bparse(parser_control *flags, term *expr, char *in, char **out)
/* parse 'in' producing term expr, if successful,
or pointing out to the unprocessed string if not successful.
Zero return for success */
{ int err;
bignumflag = 0; /* this global variable is set to 1 when bignums parsed */
err = parse(flags, expr,in,out); /* this leaves bignums as 'fakes' */
if (err)
return err;
strip_provisional(expr); /* remove PROVISIONAL bits set during parsing */
if(bignumflag==0)
return 0; /* so don't have to waste time with fix_bignums */
err = fix_bignums(expr);
if (err)
return err;
return 0;
}
/*__________________________________________________________________*/
static void parser_copy(term t, term *ans) /* copy a term */
/* This is similar to copy, but uses make_fake_bignum. */
{ int i;
if(OBJECT(t))
{ switch(TYPE(t))
{ case INTEGER:
*ans = pmake_int(INTDATA(t));
break;
case DOUBLE:
*ans = pmake_double(DOUBLEDATA(t));
break;
case BIGNUM:
*ans = make_fake_bignum((char *) t.args);
break;
}
ans->info = t.info;
return;
}
if(ISATOM(t))
{ *ans = pmake_term(FUNCTOR(t),0);
ans->args = t.args;
ans->info = t.info;
return;
}
*ans = pmake_term(FUNCTOR(t),ARITY(t));
for(i=0;i<ARITY(t);i++)
parser_copy(ARG(i,t),ARGPTR(*ans) + i);
ans->info = t.info;
}
/*____________________________________________________________________*/
static int ptype(term *t, char *in, char **out)
/* accept a legal type expression. In Mathpert these are only atomic types.
In Weierstrass we will eventually want compound types too.
*/
{ char a = in[0];
unsigned short p;
switch(a)
{ case 'C': p = DCOMPLEX; break;
case 'R': p = R; break;
case 'N': p = NATNUM; break;
case 'Z': p = INTEGER; break;
case 'Q': p = RATIONAL; break;
default:
return -1;
}
*t = pmake_int(p);
*out = in+1;
return 0;
}
/*____________________________________________________________________*/
static int integer(term *t, char *in, char **out)
/* read an integer if possible */
{ char *marker = in;
int count = 0;
int err;
char *buffer;
while (*marker == 32)
++marker; /* skip initial blanks */
while(isdigit(marker[count]))
++count;
if(count == 0)
return -1;
buffer = (char *) callocate(count+1,sizeof(char));
strncpy(buffer,marker,count);
buffer[count] = 0;
*out = in + count;
err = number(t,buffer,&marker);
return err ? -1 : 0;
}
/* ___________________________________________________________________*/
static int ncommas(char *x)
/* return the number of commas at top parentheses-level in x before
the paren count goes negative or a null character is encountered.
Thus it returns 1 on "2,3)" and also 1 on "2,3),," and
also 1 on "2,log(3,4))"
*/
{ char *marker = x;
int count = 0;
int parencount = 0;
while(*marker != 0 && parencount >= 0)
{ if(*marker == '(' || *marker == '{' || *marker == '[')
++parencount;
if(*marker == ',')
++count;
if(*marker == ')' || *marker == '}' || *marker == ']')
--parencount;
++marker;
}
return count;
}
/*_______________________________________________________________________*/
static double const constvals[8] = {E_DECIMAL,0.0,PI_DECIMAL,0.0,1.0,0.0, EULERGAMMA_DECIMAL, 0.0};
/* where the value pointers of e,parser_pi, and i point */
/* two doubles for each of the three */
static const long intvals[] = { 0L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L};
/* for the values of one, two, ... ten, but 11 and 12 are just padding*/
static const term zero = {0,1,AE_BIT | INTEGER,(void *)intvals};
static const term one = {0,1,AE_BIT | INTEGER,(void *)(intvals+1)};
static const term two = {0,1,AE_BIT | INTEGER,(void *)(intvals+2)};
static const term three = {0,1,AE_BIT | INTEGER,(void *)(intvals+3)};
static const term four = {0,1,AE_BIT | INTEGER,(void *)(intvals+4)};
static const term five = {0,1,AE_BIT | INTEGER,(void *)(intvals+5)};
static const term six = {0,1,AE_BIT | INTEGER,(void *)(intvals+6)};
static const term seven = {0,1,AE_BIT | INTEGER,(void *)(intvals+7)};
static const term eight = {0,1,AE_BIT | INTEGER,(void *)(intvals+8)};
static const term nine = {0,1,AE_BIT | INTEGER,(void *)(intvals+9)};
static const term ten = {0,1,AE_BIT | INTEGER,(void *)(intvals+10)};
static const term minusone = { '-',1, AE_BIT | INTEGER,(void *)&one};
static const term eulere = { 'e',0, R,(void *) constvals};
static const term eulergamma = { EULERGAMMA, 0,R, (void *) (constvals+6)};
static const term parser_pi = {PI_ATOM, 0, R, (void *)(constvals+2)};
/*____________________________________________________________________*/
static term constant_int2( int i)
{ switch(i)
{ case 0: return zero;
case 1: return one;
case 2: return two;
case 3: return three;
case 4: return four;
case 5: return five;
case 6: return six;
case 7: return seven;
case 8: return eight;
case 9: return nine;
case 10: return ten;
default: assert(0);
}
return zero; /* avoid a warning message */
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists