toma@tekgvs.LABS.TEK.COM (Tom Almy) (01/16/90)
These problems were pointed out to me by Paul van Niekerk
(nikkie@duteca2.tudelft.nl). They are applicable to XLISP versions 2.0 or 2.1.
PROBLEM: (last '(a b . c)) returns c rather than (b . c)
SOLUTION: in xllist.c, replace xlast with:
/* xlast - return the last cons of a list */
LVAL xlast()
{
LVAL list;
/* get the list */
list = xlgalist();
xllastarg();
/* find the last cons */
if (consp(list))
while (consp(cdr(list))) list = cdr(list);
/* return the last element */
return (list);
}
PROBLEM: functions boundp, fboundp, symbol-name, symbol-value, and
symbol-plist fail on NIL (which *is* a symbol), and symbol-function fails
improperly (wrong error message).
SOLUTION:
In xlisp.h, add:
#define xlgasymornil() (*xlargv==NIL || symbolp(*xlargv) ? nextarg() : xlbadtype(*xlargv))
In xlbfun.c, change functions to the following:
/* xboundp - is this a value bound to this symbol? */
LVAL xboundp()
{
LVAL sym;
sym = xlgasymornil();
xllastarg();
return (sym == NIL || boundp(sym) ? true : NIL);
}
/* xfboundp - is this a functional value bound to this symbol? */
LVAL xfboundp()
{
LVAL sym;
sym = xlgasymornil();
xllastarg();
return (sym != NIL && fboundp(sym) ? true : NIL);
}
/* xsymname - get the print name of a symbol */
LVAL xsymname()
{
LVAL sym;
/* get the symbol */
sym = xlgasymornil();
xllastarg();
/* handle NIL, which is not internally represented as a symbol */
if (sym == NIL) {
sym = newstring(4);
strcpy(getstring(sym), "NIL");
return sym;
}
/* return the print name */
return (getpname(sym));
}
/* xsymvalue - get the value of a symbol */
LVAL xsymvalue()
{
LVAL sym,val;
/* get the symbol */
sym = xlgasymornil();
xllastarg();
/* handle NIL */
if (sym == NIL) return (NIL);
/* get the global value */
while ((val = getvalue(sym)) == s_unbound)
xlunbound(sym);
/* return its value */
return (val);
}
/* xsymfunction - get the functional value of a symbol */
LVAL xsymfunction()
{
LVAL sym,val;
/* get the symbol */
sym = xlgasymornil();
xllastarg();
/* handle NIL */
if (sym == NIL) {
while (1)
xlfunbound(sym);
}
/* get the global value */
while ((val = getfunction(sym)) == s_unbound)
xlfunbound(sym);
/* return its value */
return (val);
}
/* xsymplist - get the property list of a symbol */
LVAL xsymplist()
{
LVAL sym;
/* get the symbol */
sym = xlgasymornil();
xllastarg();
/* return the property list */
return (sym == NIL ? NIL : getplist(sym));
}
Tom Almy
toma@tekgvs.labs.tek.com
Standard Disclaimers Apply