/* parse.c 612d */
static Exp parseexp(Par p) {
switch (p->alt) {
case ATOM:
/* parseexp [[atom]] and return the result 612e */
{
const char *s = nametostr(p->u.atom);
char *t;
long l = strtol(s, &t, 10);
if (*t == '\0') /* the number is the whole string */
return mkLiteral(l);
else
return mkVar(p->u.atom);
}
case LIST:
/* parseexp [[list]] and return the result 613a */
{
Parlist pl;
Name first;
Explist argl;
pl = p->u.list;
if (pl == NULL)
error("%p: empty list in input", p);
if (pl->hd->alt != ATOM)
error("%p: first item of list not name", p);
first = pl->hd->u.atom;
argl = parselist(pl->tl);
if (first == strtoname("begin")) {
/* parseexp [[begin]] and return the result 613b */
return mkBegin(argl);
} else if (first == strtoname("if")) {
/* parseexp [[if]] and return the result 613c */
if (lengthEL(argl) != 3)
error("%p: usage: (if cond true false)", p);
return mkIfx(nthEL(argl, 0), nthEL(argl, 1), nthEL(argl, 2));
} else if (first == strtoname("set")) {
/* parseexp [[set]] and return the result 613e */
if (lengthEL(argl) != 2)
error("%p: usage: (set var exp)", p);
if (nthEL(argl, 0)->alt != VAR)
error("%p: set needs variable as first param", p);
return mkSet(nthEL(argl, 0)->u.var, nthEL(argl, 1));
} else if (first == strtoname("while")) {
/* parseexp [[while]] and return the result 613d */
if (lengthEL(argl) != 2)
error("%p: usage: (while cond body)", p);
return mkWhilex(nthEL(argl, 0), nthEL(argl, 1));
} else {
/* parseexp function application and return the result 614a */
return mkApply(first, argl);
}
}
default:
assert(0);
return NULL;
}
}
/* parse.c 720f */
Exp parseexp(Par p) {
switch (p->alt) {
case ATOM:
/* parseexp [[ATOM]] and return 721 */
{
Name n = p->u.atom;
const char *s; /* string form of n */
char *t; /* nondigits in s, if any */
long l; /* number represented by s, if any */
if (n == strtoname("#t"))
return mkLiteral(truev);
else if (n == strtoname("#f"))
return mkLiteral(falsev);
s = nametostr(n);
l = strtol(s, &t, 10);
if (*t == '\0' && *s != '\0')
/* all the characters in s are digits base 10 */
return mkLiteral(mkNum(l));
else
return mkVar(n);
}
case LIST:
/* parseexp [[LIST]] and return 722a */
{
Parlist pl; /* parenthesized list we are parsing */
Name first;
/* first element, as a name (or NULL if not name) */
Explist el; /* remaining elements, as expressions */
Exp rv; /* result of parsing */
pl = p->u.list;
if (pl == NULL)
error("%p: empty list in input", p);
first = pl->hd->alt == ATOM ? pl->hd->u.atom : NULL;
if (first == strtoname("lambda")) {
/* parseexp [[lambda]] and put the result in [[rv]] 722b */
Par q;
if (lengthPL(pl->tl) != 2)
error("%p: usage: (lambda (formals) exp)", p);
q = nthPL(pl->tl, 0);
if (q->alt != LIST)
error("%p: usage: (lambda (formals) exp)", p);
rv = mkLambdax(mkLambda(getnamelist(p, q->u.list), parseexp(
nthPL(pl->tl, 1))));
} else if (first == strtoname("let")
|| first == strtoname("let*")
|| first == strtoname("letrec")) {
/* parseexp let and put the result in [[rv]] 723a */
Letkeyword letword;
Par letbindings;
if (first == strtoname("let"))
letword = LET;
else if (first == strtoname("let*"))
letword = LETSTAR;
else if (first == strtoname("letrec"))
letword = LETREC;
else
assert(0);
if (lengthPL(pl->tl) != 2)
error("%p: usage: (%n (letlist) exp)", p, first);
letbindings = nthPL(pl->tl, 0);
if (letbindings->alt != LIST)
error("%p: usage: (%n (letlist) exp)", p, first);
rv = mkLetx(letword, NULL, NULL, parseexp(nthPL(pl->tl, 1)));
parseletbindings(p, letbindings->u.list, rv);
} else if (first == strtoname("quote")) {
/* parseexp [[quote]] and put the result in [[rv]] 723d */
{
if (lengthPL(pl) != 2)
error("%p: quote needs exactly one argument", p);
rv = mkLiteral(parsesx(nthPL(pl, 1)));
}
} else {
el = parselist(pl->tl);
if (first == strtoname("begin")) {
/* parseexp [[begin]] and put the result in [[rv]] 724e */
rv = mkBegin(el);
} else if (first == strtoname("if")) {
/* parseexp [[if]] and put the result in [[rv]] 724f */
if (lengthEL(el) != 3)
error("%p: usage: (if cond true false)", p);
rv = mkIfx(nthEL(el, 0), nthEL(el, 1), nthEL(el, 2));
} else if (first == strtoname("set")) {
/* parseexp [[set]] and put the result in [[rv]] 725b */
if (lengthEL(el) != 2)
error("%p: usage: (set var exp)", p);
if (nthEL(el, 0)->alt != VAR)
error("%p: set needs variable as first param", p);
rv = mkSet(nthEL(el, 0)->u.var, nthEL(el, 1));
} else if (first == strtoname("while")) {
/* parseexp [[while]] and put the result in [[rv]] 725a */
if (lengthEL(el) != 2)
error("%p: usage: (while cond body)", p);
rv = mkWhilex(nthEL(el, 0), nthEL(el, 1));
/* [[RBR else LBR]] possibly parse expressions that are in \uschemeplus 723e */
/* nothing happens */
} else {
/* parseexp application and put the result in [[rv]] 724d */
rv = mkApply(parseexp(pl->hd), el);
}
}
return rv;
}
default:
assert(0);
return NULL;
}
}
/*
* <parse.c>=
*/
static Exp parseexp(Par p) {
switch (p->alt) {
case ATOM:
/*
* If we have a name, it must be either a literal value
* or a variable.
* <parseexp [[atom]] and return the result>=
*/
{
const char *s = nametostr(p->u.atom);
char *t;
long l = strtol(s, &t, 10);
if (*t == '\0') /* the number is the whole string */
return mkLiteral(l);
else
return mkVar(p->u.atom);
}
case LIST:
/*
* If we have a list, we need to look at the first
* element, which must be a name.
* <parseexp [[list]] and return the result>=
*/
{
Parlist pl;
Name first;
Explist argl;
pl = p->u.list;
if (pl == NULL)
error("%p: empty list in input", p);
if (pl->hd->alt != ATOM)
error("%p: first item of list not name", p);
first = pl->hd->u.atom;
argl = parselist(pl->tl);
if (first == strtoname("begin")) {
/*
* A [[begin]] expression can have any number of
* parameters.
* <parseexp [[begin]] and return the result>=
*/
return mkBegin(argl);
} else if (first == strtoname("if")) {
/*
* An [[if]] expression needs three parameters.
* <parseexp [[if]] and return the result>=
*/
if (lengthEL(argl) != 3)
error("%p: usage: (if cond true false)", p);
return mkIfx(nthEL(argl, 0), nthEL(argl, 1), nthEL(argl, 2));
} else if (first == strtoname("set")) {
/*
* A [[set]] expression requires a variable and a value.
* <parseexp [[set]] and return the result>=
*/
if (lengthEL(argl) != 2)
error("%p: usage: (set var exp)", p);
if (nthEL(argl, 0)->alt != VAR)
error("%p: set needs variable as first param", p);
return mkSet(nthEL(argl, 0)->u.var, nthEL(argl, 1));
} else if (first == strtoname("while")) {
/*
* A [[while]] loop needs two.
* <parseexp [[while]] and return the result>=
*/
if (lengthEL(argl) != 2)
error("%p: usage: (while cond body)", p);
return mkWhilex(nthEL(argl, 0), nthEL(argl, 1));
} else {
/*
* Anything else must be a function application. We
* can't check the number of parameters here, because
* the function definition might change before
* evaluation, or might not be present yet (as occurs,
* for example, when defining recursive functions).
* <parseexp function application and return the result>=
*/
return mkApply(first, argl);
}
}
default:
assert(0);
return NULL;
}
}
