Sindbad~EG File Manager
/* M. Beeson, for Mathpert
7.28.93 modified
3.12.99 last modified
1.9.00 removed pragma argsused; modified newfunctor.
7.22.00 added GreekString
10.02.02 modified GreekString on LITTLEGAMMA
9.14.03 removed include conio.h
6.30.04 changed "lam" to "lambda" to facilitate communication with Otter-lambda
9.5.04 modified atom_string to handle subscripts directly, eliminating dependence on varinfo.
Moved the file to parser.dll
5:20 pm modified atom_string again, to handle subscripts on Greek atoms.
and again at 9:15.
9.10.04 Added a case for FLOOR to functor_string.
*/
#include <string.h>
#include <stdio.h>
#include <assert.h>
#include <stdlib.h> /* atoi */
#define PARSER_DLL
#include "export.h"
#include "charcode.h" /* ALPHACHAR etc. */
#include "terms.h"
#include "constant.h" /* externs for constant terms zero, one, etc. */
#include "functors.h"
#include "dispfunc.h"
#define MAXATOMS 16
#define MAXFUNCTORS 16
/*___________________________________________________________________*/
static char *symbols[MAXATOMS];
static int nextatom;
static char *functors[MAXFUNCTORS];
static int nextfunctor;
/*______________________________________________________________________*/
static char latoms[] = {'a',0,'b',0,'c',0,'d',0,'e',0,'f',0,'g',0,
'h',0,'i',0,'j',0,'k',0,'l',0,'m',0,'n',0,
'o',0,'p',0,'q',0,'r',0,'s',0,'t',0,'u',0,
'v',0,'w',0,'x',0,'y',0,'z',0,'?',0};
static char uatoms[] = {'A',0,'B',0,'C',0,'D',0,'E',0,'F',0,'G',0,
'H',0,'I',0,'J',0,'K',0,'L',0,'M',0,'N',0,
'O',0,'P',0,'Q',0,'R',0,'S',0,'T',0,'U',0,
'V',0,'W',0,'X',0,'Y',0,'Z',0};
static char greek_atoms[] =
{ (char) ALPHACHAR,0,
(char) BETACHAR,0,
(char) LITTLEGAMMACHAR,0,
(char) SIGMACHAR,0,
(char) MUCHAR,0,
(char) THETACHAR,0,
(char) DELTACHAR,0,
(char) INFINITYCHAR,0,
(char) PHICHAR,0,
(char) EPSILONCHAR,0,
(char) PICHAR,0,
(char) LAMBDACHAR,0,
(char) NUCHAR,0,
(char) BIGPSICHAR,0,
(char) PSICHAR,0,
(char) OMEGACHAR,0,
(char) BIGOMEGACHAR,0,
(char) SETMEMBERSHIPCHAR,0
};
static char oem_greek_atoms[] =
{ (char) 224,0, /* alpha */
(char) 225,0, /* beta */
(char) 231,0, /* gamma */
(char) 229,0, /* sigma */
(char) 230,0, /* mu */
(char) 233,0, /* theta */
(char) 235,0, /* delta */
(char) 236,0, /* infinity */
(char) 237,0, /* phi */
(char) 238,0, /* epsilon */
(char) 227,0, /* pi */
(char) 239,0, /* used for lambda; actually intersection, but lambda
isn't in the OEM font. It will get translated back
to Symbol font by SymbolTextOut */
(char) NUCHAR,0, /* These 4 characters aren't used at present anyway */
(char) BIGPSICHAR,0,
(char) PSICHAR,0,
(char) OMEGACHAR,0,
(char) 234,0, /* Omega */
(char) 238,0 /* SETMEMBERSHIPCHAR */
};
static char relation_atoms[] =
{ (char) '=',
(char) 0,
(char) '<',
(char) 0,
(char) '>',
(char) 0,
(char) LECHAR,
(char) 0,
(char) GECHAR,
(char) 0,
(char) PRIMECHAR,
(char) 0
};
static char oem_relation_atoms[] =
{ (char) '=',
(char) 0,
(char) '<',
(char) 0,
(char) '>',
(char) 0,
(char) 243,
(char) 0,
(char) 242,
(char) 0,
(char) '\'',
(char) 0,
(char) 'V',
(char) 0,
(char) ILLEGAL,
(char) 0
};
/*__________________________________________________________________*/
/* get the string to be printed when the atom 'atom' is printed */
/* It returns a static string, using character codes from charcode.h,
(not OEM codes) except for subscripted variables, in which case
it mallocates a string.
*/
MEXPORT_PARSER char *atom_string(term atom)
{ short f = FUNCTOR(atom);
char *ans;
char buf[40];
if(SUBSCRIPT(f))
{ /* Then the atom should usually be a single character followed by a subscript,
but a Greek atom could be subscripted too, and that sort of variable is
created by fillbinders. It shouldn't ever need to be written though,
so we don't need to handle it here. */
buf[0] = (char) VARNAME(f);
sprintf(buf+1,"%d",SUBSCRIPT(f));
ans = (char *) mallocate(strlen(buf)+1);
strcpy(ans,buf);
return ans;
}
if(PREDEFINED_ATOM(f))
switch(f)
{ case FALSEFUNCTOR:
return "false";
case TRUEFUNCTOR:
return "true";
case ALPHA: return greek_atoms;
case BETA: return greek_atoms+2;
case LITTLEGAMMA: return greek_atoms+4;
case SIGMA: return greek_atoms+6;
case MU: return greek_atoms+8;
case THETA: return greek_atoms+10;
case DELTA: return greek_atoms+12;
case INFINITY: return greek_atoms+14;
case PHI: return greek_atoms+16;
case EPSILON: return greek_atoms+18;
case PI_ATOM: return greek_atoms+20;
case LAMBDA: return greek_atoms+22;
case LEFT: return "-";
case RIGHT: return "+";
/* These functors are not defined:
case NU: return greek_atoms+24;
case BIGPSI: return greek_atoms+26;
case PSI: return greek_atoms+28;
case OMEGA: return greek_atoms+30;
case BIGOMEGA: return greek_atoms+32;
*/
case BOUNDED_OSCILLATIONS: /* fall-through */
case UNBOUNDED_OSCILLATIONS: /* fall-through */
case UNDEFINED: return "undefined";
default:
assert(0);
}
if (DIRECT_ATOM(f))
{ if('a'<= f && f <= 'z')
ans = latoms + 2*(f - 'a');
else if('A' <= f && f <= 'Z')
ans = uatoms + 2*(f - 'A');
else if(f == '?') /* needed in certain menu strings */
ans = latoms + 52;
else if(f == PSEUDOATOM)
/* used in displaying some terms, such as PR terms */
ans = (char *) ARGPTR(atom);
else
{ switch(f)
{ case '=' : return relation_atoms;
case '<' : return relation_atoms+2;
case '>' : return relation_atoms+4;
case LE : return relation_atoms+6;
case GE : return relation_atoms+8;
case '\'': return relation_atoms+10;
/* this comes in printing y' */
}
assert(0);
}
}
else
{ if(ATOMINDEX(f) >= MAXATOMS)
assert(0);
ans = symbols[ATOMINDEX(f)];
}
return ans;
}
/*__________________________________________________________________*/
MEXPORT_PARSER char *GreekString(term atom)
/* get the string "$�$" for atom THETA, etc.
That is, the OEM character enclosed in dollar signs,
returned as a static string so the memory will last indefinitely.
and the same as oem_functor for other PREDEFINED_ATOM atoms.
You can't use "\\alpha" here, because it isn't drawn properly
on parameter buttons in the Graph Toolbar, which expects a
single character.
Returns NULL for other functors.
*/
{ short f = FUNCTOR(atom);
if (!PREDEFINED_ATOM(f))
return NULL;
switch(f)
{ case FALSEFUNCTOR:
return "false";
case TRUEFUNCTOR:
return "true";
case ALPHA: return "$$";
case BETA: return "$�$";
case LITTLEGAMMA: return "$\0xc7$";
case SIGMA: return "$�$";
case MU: return "$�$";
case THETA: return "$�$";
case DELTA: return "$�$";
case INFINITY: return "$�$";
case PHI: return "$�$";
case EPSILON: return "$�$";
case PI_ATOM: return "$�$";
case LAMBDA: return "$�$"; /* see explanation in greek_atoms */
/* These functors are not defined:
case NU:
case BIGPSI:
case PSI:
case OMEGA:
case BIGOMEGA:
case TAU:
*/
case BOUNDED_OSCILLATIONS: /* fall-through */
case UNBOUNDED_OSCILLATIONS: /* fall-through */
case UNDEFINED:
return "undefined";
}
return NULL;
}
/*__________________________________________________________________*/
MEXPORT_PARSER char *oem_atom_string(term atom)
/* get the string to be printed when the atom 'atom' is printed.
It returns a static string, using OEM character codes. This
is used in preparing reason and menu strings.
*/
{ short f = FUNCTOR(atom);
char *ans;
char buf[40];
if(SUBSCRIPT(f))
{ /* Then the atom should be a single character followed by a subscript */
/* Greek atoms cannot be subscripted */
buf[0] = (char) VARNAME(f);
sprintf(buf+1,"%d",SUBSCRIPT(f));
ans = (char *) mallocate(strlen(buf)+1);
strcpy(ans,buf);
return ans;
}
if (PREDEFINED_ATOM(f))
switch(f)
{ case FALSEFUNCTOR:
return "false";
case TRUEFUNCTOR:
return "true";
case ALPHA: return oem_greek_atoms;
case BETA: return oem_greek_atoms+2;
case LITTLEGAMMA: return oem_greek_atoms+4;
case SIGMA: return oem_greek_atoms+6;
case MU: return oem_greek_atoms+8;
case THETA: return oem_greek_atoms+10;
case DELTA: return oem_greek_atoms+12;
case INFINITY: return oem_greek_atoms+14;
case PHI: return oem_greek_atoms+16;
case EPSILON: return oem_greek_atoms+18;
case PI_ATOM: return oem_greek_atoms+20;
case LAMBDA: return oem_greek_atoms+22;
/* These functors are not defined:
case NU: return greek_atoms+24;
case BIGPSI: return greek_atoms+26;
case PSI: return greek_atoms+28;
case OMEGA: return greek_atoms+30;
case BIGOMEGA: return greek_atoms+32;
*/
case BOUNDED_OSCILLATIONS: /* fall-through */
case UNBOUNDED_OSCILLATIONS: /* fall-through */
case UNDEFINED: return "undefined";
default:
assert(0);
}
if (DIRECT_ATOM(f))
{ if('a'<= f && f <= 'z')
ans = latoms + 2*(f - 'a');
else if('A' <= f && f <= 'Z')
ans = uatoms + 2*(f - 'A');
else if(f == PSEUDOATOM)
/* used in displaying some terms, such as PR terms */
ans = (char *) ARGPTR(atom);
else
{ switch(f)
{ case '=' : return oem_relation_atoms;
case '<' : return oem_relation_atoms+2;
case '>' : return oem_relation_atoms+4;
case LE : return oem_relation_atoms+6;
case GE : return oem_relation_atoms+8;
case '\'': return oem_relation_atoms+10;
/* this comes in printing y' */
case VAR: return oem_relation_atoms+12;
/* ssolve can call operations that create a reason
string using mstring; if var0 is passed to
ssolve we hit this, even though var0 isn't supposed
to ever see the light of day. */
case ILLEGAL: return oem_relation_atoms+14;
}
assert(0);
}
}
else
{ if(ATOMINDEX(f) >= MAXATOMS)
assert(0);
ans = symbols[ATOMINDEX(f)];
}
return ans;
}
/*_________________________________________________________________________*/
MEXPORT_PARSER void functor_string(unsigned short f, int where , char *name)
/* f is the integer in the first eight bits of the functor field of a term.
The string to be displayed will be written in space pointed to by 'name'.
The 'where' parameter controls whether the string produced is the one
needed for string display (where = 1)
or for generating a parseable internal form (where = 0).
Only seven-bit ascii should be used when where == 0, since these strings
will be used in saving .mxp files.
*/
{ int k;
if(LITERALFUNCTOR(f))
{ name[0] = (char) f;
name[1] = '\0';
return;
}
if(f < GAMMA) /* not a special function */
{ switch(f)
{ case ABS:
strcpy(name,"abs");
return;
case AND :
strcpy(name,"and"); /* not used for display */
return;
case ACOS:
strcpy(name,"arccos");
return;
case ASIN:
strcpy(name,"arcsin");
return;
case ATAN:
strcpy(name,"arctan");
return;
case ACOT:
strcpy(name,"arccot");
return;
case ASEC:
strcpy(name,"arcsec");
return;
case ACSC:
strcpy(name,"arccsc");
return;
case ACOSH:
strcpy(name,"arccosh");
return;
case ASINH:
strcpy(name,"arcsinh");
return;
case ATANH:
strcpy(name,"arctanh");
return;
case ACOTH:
strcpy(name,"arccoth");
return;
case ASECH:
strcpy(name,"arcsech");
return;
case ACSCH:
strcpy(name,"arccsch");
return;
case ARROW:
if(where)
{ name[0] = (char)ARROWCHAR;
name[1] = '\0';
return;
}
strcpy(name,"->");
return;
case BIGOH: strcpy(name,"O");
return;
case BINOMIAL:
strcpy(name,"binomial"); /* not used for display */
return;
case CIS:
strcpy(name,"cis"); /* not used for display */
return;
case COS:
strcpy(name,"cos");
return;
case COSH:
strcpy(name,"cosh");
return;
case COT:
strcpy(name,"cot");
return;
case COTH:
strcpy(name,"coth");
return;
case CSC:
strcpy(name,"csc");
return;
case CSCH:
strcpy(name,"csch");
return;
case CASES:
strcpy(name,"cases"); /* not used for display */
return;
case DEFINED:
strcpy(name,"defined");
return;
case DEG:
if(where)
{ name[0] = (char) DEGREECHAR;
name[1] = '\0';
}
else
strcpy(name,"deg");
return;
case DET:
strcpy(name,"det");
return; /* not used for display */
case DIFF:
strcpy(name,"diff");
return; /* not used for display */
case EVAL:
strcpy(name,"eval");
return; /* not used for display */
case EVEN1:
strcpy(name,"even");
return;
case FACTORIAL:
if( where )
strcpy(name,"!");
else
strcpy(name, "factorial");
return;
case FLOOR:
strcpy(name,"floor");
return;
case GE:
if(where)
{ name[0] =(char) GECHAR;
name[1] = '\0';
return;
}
strcpy(name,">=");
return;
case GCD:
strcpy(name,"gcd");
return;
case MAXFUNCTOR:
strcpy(name,"max");
return;
case MINFUNCTOR:
strcpy(name,"min");
return;
case INTEGRAL:
strcpy(name,"integral");
return; /* not used for display */
case IF:
strcpy(name,"if");
return;
case IMAGPART:
strcpy(name,"Im");
return;
case BESSELJ:
strcpy(name,"J");
return;
case BESSELK:
strcpy(name,"K");
return;
case BESSELY:
strcpy(name,"Y");
return;
case BESSELI:
strcpy(name,"I");
return;
case LIMIT:
strcpy(name,"lim");
return;
case LE:
if(where)
{ name[0] = (char) LECHAR;
name[1] = '\0';
return;
}
strcpy(name,"<=");
return;
case LOG:
strcpy(name,"log");
return;
case LN:
strcpy(name,"ln");
return;
case LOGB:
if(where)
strcpy(name,"log");
else
strcpy(name,"logb");
return;
case MOD:
strcpy(name,"mod");
return;
case MATRIX:
if(where == 0)
strcpy(name,"matrix");
return; /* not used for display */
case MATRIXINVERSE:
if(where == 0)
strcpy(name,"inverse");
return; /* used only in saving documents */
case MULTIPLICITY:
strcpy(name,"multiplicity");
return;
case NE:
if(where)
{ name[0] = (char)NECHAR;
name[1] = '\0';
return;
}
strcpy(name,"!=");
return;
case NOT:
strcpy(name,"not");
return;
case ODD1:
strcpy(name,"odd");
return;
case OR:
strcpy(name,"or");
return;
case PR:
if(!where)
strcpy(name,"prime");
return;
case WEIERSTRASSP:
strcpy(name,"Pe");
return;
case REALPART:
strcpy(name,"Re");
return;
case ROOT:
strcpy(name,"root");
return;
case SG:
strcpy(name,"sg");
return;
case SIN:
strcpy(name,"sin");
return;
case SINH:
strcpy(name,"sinh");
return;
case SQRT:
strcpy(name,"sqrt");
return;
case SEC:
strcpy(name,"sec");
return;
case SECH:
strcpy(name,"sech");
return;
case SEQ:
if(where)
strcpy(name,SEQSTRING);
else
strcpy(name,"seq");
return;
case SUM:
if(!where)
strcpy(name,"sum");
return;
case PRODUCT:
if(!where)
strcpy(name,"product");
return;
case TAN:
strcpy(name,"tan");
return;
case TANH:
strcpy(name,"tanh");
return;
case VECTOR:
strcpy(name,"vector");
return; /* not used for display */
case RIEMANNZETA:
strcpy(name,"zeta");
return;
case ':' :
strcpy(name,greek_atoms+34);
return;
}
}
switch(f)
{ static char buffer[2];
case EXISTS:
if(where)
{ buffer[0] = EXISTSCHAR;
strcpy(name,buffer);
}
else
strcpy(name,"exists");
return;
case ALL:
if(where)
{ buffer[0] = FORALLCHAR;
strcpy(name,buffer);
}
else
strcpy(name,"all");
return;
case LAM:
if(where)
{ buffer[0] = LAMBDACHAR;
strcpy(name,buffer);
}
else
strcpy(name,"lambda"); // 6.30.04, now that parser can handle it
return;
case AP:
strcpy(name,"ap");
return;
case NUMERATOR:
strcpy(name,"numerator");
return;
case DENOM:
strcpy(name,"denom");
return;
case CONSTANTOFINTEGRATION:
if(where)
strcpy(name,"c");
else
strcpy(name,"cofi");
return;
}
if(isalpha(f))
{ /* a one-character function name like 'f' */
name[0] = (char) f;
name[1] = '\0';
return;
}
if(PREDEFINED_FUNCTOR(f)) /* a special function (but not Bessel) */
{ switch(f)
{ case POLY:
/* used by writeterm and readterm for saving and opening documents;
otherwise POLY terms are never displayed. */
strcpy(name,"polynomial");
return;
case INCOMPLETEGAMMA: /*fall-through */
case GAMMA:
if (where)
{ name[0] = BIGGAMMACHAR;
name[1] = '\0';
}
else
strcpy(name,"Gamma");
return;
case INCOMPLETEBETA:
strcpy(name, where ? "B" : "IncompleteBeta");
return;
case BETAFUNCTION:
strcpy(name, where ? "B" : "Beta");
return;
case DIGAMMA:
strcpy(name,where ? greek_atoms+26 : "Digamma");
return;
case POLYGAMMA:
strcpy(name, where ? greek_atoms+26: "PolyGamma");
return;
case ERF:
strcpy(name,"Erf");
return;
case ERFC:
strcpy(name,"Erfc");
return;
case INCOMPLETEGAMMAP:
strcpy(name,where ? "P" : "IncompleteGammaP");
return;
case COSINTEGRAL:
strcpy(name,where? "Ci" : "CosIntegral");
return;
case SININTEGRAL:
strcpy(name,where ? "Si" : "SinIntegral");
return;
case LOGINTEGRAL:
strcpy(name, where ? "Li" : "LogIntegral");
return;
case EXPINTEGRALI:
strcpy(name, where ? "Ei" : "ExpIntegralI");
return;
case EXPINTEGRALE:
strcpy(name,where ? "E" : "ExpIntegralE");
return;
case ILLEGAL:
// assert(0);
strcpy(name,"illegal");
return;
default:
assert(0);
}
}
k = INDEX(f);
if(k >= nextfunctor)
assert(0);
strcpy(name,functors[k]);
return;
}
/* _________________________________________________________________*/
/* Print names of user-defined atoms and functors are kept in
parser.dll and shared by all documents. The actual character
strings are stored in the following static array: */
#define MAXSTRINGSPACE 256
char stringspace[MAXSTRINGSPACE];
int nextstring; /* stringspace[nextstring] is available */
/* _________________________________________________________________*/
/* Enter string 'fname' as a new functor and return the functor
to be used, namely INDEX_TO_FUNCTOR(nextfunctor).
If the functor was already there, just return the functor that
was already entered. This is called by the parser, which can be
called at getarg, so it better use permalloc instead of callocate */
MEXPORT_PARSER unsigned short newfunctor(char *fname, unsigned short arity)
{ unsigned short j,ans;
int length;
if(fname[1] == 0)
{ /* one-character function name */
return (unsigned short) fname[0]; /* just use 'f' as the functor for "f" */
}
for(j=0;j<nextfunctor;j++)
{ if(!strcmp(fname,functors[j]))
return (unsigned short) INDEX_TO_FUNCTOR(j);
}
if (nextfunctor == MAXFUNCTORS)
return ILLEGAL;
length = strlen(fname) + 1;
if(nextstring + length > MAXSTRINGSPACE)
return ILLEGAL;
functors[nextfunctor] = stringspace + nextstring;
nextstring += length;
strcpy(functors[nextfunctor],fname);
ans = (unsigned short) INDEX_TO_FUNCTOR(nextfunctor);
++nextfunctor;
return ans;
}
/*_________________________________________________________________*/
/* Given a character string meant to determine an atom, return
the functor that should be used for that atom. Predefined
functors are not sent to this function; it must deal with
single letters, subscripted variables such as x3, and user-defined
atoms such as 'mass'.
In the case of a user-defined atom, first check if x is already
present in the symbols array; if so it isn't necessary to enter it.
If not, enter string x as a new atom
and return FIRST_DEFINED_ATOM + newatom, incrementing newatom.
If there is no more space for the strings, or if too many atoms
are already defined, just return an ILLEGAL atom.
Subscripted variables involving subscripts > MAXSUBSCRIPT
will be processed, but the subscript will be incorrect.
The parser and getnewvar have to not create such variables.
*/
MEXPORT_PARSER unsigned short newatom(char *x)
{ unsigned short ans;
int i,length;
char *marker;
if(x[1] == '\0' && isalpha(x[0]))
return x[0]; /* a single letter */
/* 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);
}
for(i=0;i<nextatom;i++)
{ if(!strcmp(symbols[i],x))
return (unsigned short) (i + FIRST_DEFINED_ATOM); /* this atom is already recorded */
}
if(nextatom == MAXATOMS)
return ILLEGAL;
length = strlen(x)+1;
if(nextstring + length > MAXSTRINGSPACE)
return ILLEGAL;
symbols[nextatom] = stringspace + nextstring;
nextstring += length;
strcpy(symbols[nextatom],x);
ans = (unsigned short) (nextatom + FIRST_DEFINED_ATOM);
++nextatom;
return ans;
}
/*_______________________________________________________________*/
MEXPORT_PARSER char * functorname(unsigned f)
/* return the print name of a multi-character functor */
{ if(isalpha(f) || PREDEFINED_FUNCTOR(f))
return NULL;
return functors[INDEX(f)];
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists