/* parse.c 720d */
Explist parselist(Parlist pl) {
Exp e;
if (pl == NULL)
return NULL;
e = parseexp(pl->hd);
return mkEL(e, parselist(pl->tl));
}
/*
* Now we can move on to parsing [[Exp]]s. The
* [[parselist]] helper function repeatedly calls
* [[parseexp]] to parse a list of [[Par]] expressions,
* eventually returning a list of [[Exp]]s.
* <parse.c>=
*/
static Explist parselist(Parlist pl) {
Exp e;
if (pl == NULL)
return NULL;
e = parseexp(pl->hd); /* force pl->hd to be parsed first */
return mkEL(e, parselist(pl->tl));
}
char *parseword(char *&p) // parse single argument, including expressions
{
p += strspn(p, " \t\r");
if(p[0]=='/' && p[1]=='/') p += strcspn(p, "\n\0");
if(*p=='\"')
{
p++;
const char *word = p;
p += strcspn(p, "\"\r\n\0");
char *s = newstring(word, p-word);
if(*p=='\"') p++;
return s;
};
if(*p=='(') return parseexp(p, ')');
if(*p=='[') return parseexp(p, ']');
char *word = p;
p += strcspn(p, "; \t\r\n\0");
if(p-word==0) return NULL;
return newstring(word, p-word);
};
/* parse.c 723c */
static void parseletbindings(Par p, Parlist bindings, Exp letexp) {
if (bindings) {
Par t = bindings->hd;
Name n; /* name bound in t (if t is well formed) */
Exp e; /* expression on RHS of t (if t is well formed) */
parseletbindings(p, bindings->tl, letexp);
if (t->alt != LIST || lengthPL(t->u.list) != 2
|| nthPL(t->u.list, 0)->alt != ATOM)
error("%p: usage: (letX (letlist) exp)", p);
n = nthPL(t->u.list, 0)->u.atom;
e = parseexp(nthPL(t->u.list, 1));
letexp->u.letx.nl = mkNL(n, letexp->u.letx.nl);
letexp->u.letx.el = mkEL(e, letexp->u.letx.el);
}
}
/* Parses a C preprocessor expression.
*/
char const *parseexptree(struct exptree *t, struct clexer *cl,
char const *input)
{
return parseexp(t, cl, input, 0);
}
/* Parses a C preprocessor expression from the C source code pointed
* to by input, via the given lexer, and creates a expression tree
* representing it. prec gives the precedence of the operator this
* expression is attached to, or zero if there is no such operator.
* The return value points to the source immediately following the
* parsed expression.
*/
static char const *parseexp(struct exptree *t, struct clexer *cl,
char const *input, int prec)
{
struct exptree *x;
char const *tmp;
int found, n;
if (t->exp != expNone)
return input;
if (*input == '(') {
tmp = input;
input = skipwhite(cl, nextchar(cl, input));
input = parseexp(t, cl, input, 0);
if (t->exp == expNone) {
error(errSyntax);
goto failure;
} else if (*input != ')') {
error(errOpenParenthesis);
goto failure;
}
t->begin = tmp;
input = nextchar(cl, input);
t->end = input;
input = skipwhite(cl, input);
} else {
found = FALSE;
for (n = 0 ; n < sizearray(prefixops) ; ++n) {
if (!memcmp(input, prefixops[n].symbol, prefixops[n].size)) {
found = TRUE;
break;
}
}
if (found) {
if (prefixops[n].prec < prec) {
error(errMissingOperand);
goto failure;
}
t->exp = expOperator;
t->op = prefixops[n].op;
t->begin = input;
input = nextchars(cl, input, prefixops[n].size);
input = skipwhite(cl, input);
x = addnewchild(t, -1);
input = parseexp(x, cl, input, prefixops[n].prec);
if (x->exp == expNone) {
error(errSyntax);
goto failure;
}
t->end = x->end;
} else {
input = parseconstant(t, cl, input);
if (t->exp == expNone) {
error(errSyntax);
goto failure;
}
}
}
for (;;) {
found = FALSE;
for (n = 0 ; n < sizearray(infixops) ; ++n) {
if (!memcmp(input, infixops[n].symbol, infixops[n].size)) {
found = TRUE;
break;
}
}
if (!found || infixops[n].prec < prec
|| (infixops[n].prec == prec && infixops[n].l2r))
break;
input = nextchars(cl, input, infixops[n].size);
input = skipwhite(cl, input);
x = initexptree();
tmp = t->begin;
*x = *t;
clearexptree(t);
t->exp = expOperator;
t->op = infixops[n].op;
t->begin = tmp;
addchild(t, x, -1);
x = addnewchild(t, -1);
if (t->op == opConditional) {
input = parseexp(x, cl, input, infixops[n].prec);
if (x->exp == expNone) {
error(errSyntax);
goto failure;
}
if (*input != ':') {
error(errSyntax);
goto failure;
}
input = skipwhite(cl, nextchar(cl, input));
x = addnewchild(t, -1);
}
input = parseexp(x, cl, input, infixops[n].prec);
if (x->exp == expNone) {
error(errSyntax);
goto failure;
}
t->end = x->end;
}
return input;
failure:
t->exp = expNone;
return input;
}
/* parse.c 718b */
XDef parse(Par p) {
switch (p->alt) {
case ATOM:
/* parse ATOM and return 718c */
return mkDef(mkExp(parseexp(p)));
case LIST:
/* parse LIST and return 718d */
{
Parlist pl = p->u.list;
if (pl == NULL)
error("%p: empty list", p);
if (nthPL(pl, 0)->alt == ATOM) {
Name first = nthPL(pl, 0)->u.atom;
if (first == strtoname("define")) {
/* parse define and return 719a */
Name name;
Lambda l;
if (lengthPL(pl) != 4 || nthPL(pl, 1)->alt != ATOM || nthPL(
pl, 2)->alt != LIST)
error("%p: usage: (define fun (args) body)", p);
name = nthPL(pl, 1)->u.atom;
l.formals = getnamelist(p, nthPL(pl, 2)->u.list);
l.body = parseexp(nthPL(pl, 3));
return mkDef(mkDefine(name, l));
}
if (first == strtoname("val")) {
/* parse val and return 719b */
Exp var, exp;
if (lengthPL(pl) != 3)
error("%p: usage: (val var exp)", p);
var = parseexp(nthPL(pl, 1));
if (var->alt != VAR)
error("%p: usage: (val var exp) (bad variable)", p);
exp = parseexp(nthPL(pl, 2));
return mkDef(mkVal(var->u.var, exp));
}
if (first == strtoname("use")) {
/* parse use and return 719c */
if (lengthPL(pl) != 2 || nthPL(pl, 1)->alt != ATOM)
error("%p: usage: (use filename)", p);
return mkUse(nthPL(pl, 1)->u.atom);
}
if (first == strtoname("check-expect")) {
/* parse check-expect and return 719d */
{
Exp check, expect;
if (lengthPL(pl) != 3)
error("%p: usage: (check-expect exp exp)", p);
check = parseexp(nthPL(pl, 1));
expect = parseexp(nthPL(pl, 2));
return mkTest(mkCheckExpect(check, expect));
}
}
if (first == strtoname("check-error")) {
/* parse check-error and return 719e */
{
Exp check;
if (lengthPL(pl) != 2)
error("%p: usage: (check-error exp)", p);
check = parseexp(nthPL(pl, 1));
return mkTest(mkCheckError(check));
}
}
}
return mkDef(mkExp(parseexp(p)));
}
}
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;
}
}
/*
* The parser needs to take concrete syntax, check to
* see that it is well formed, and produce abstract
* syntax. It provides the [[readtop]] function.
*
* At the top level, parsing amounts to looking for top
* level constructs and passing the rest of the work to
* [[parseexp]], which parses the input into [[Exp]]s.
* <parse.c>=
*/
static Def parse(Par p) {
switch (p->alt) {
case ATOM:
/*
* If we have a name, we treat it as an expression.
* <parse [[atom]] and return the result>=
*/
return mkExp(parseexp(p));
case LIST:
/*
* If we have a list, we need to look for [[define]],
* [[val]], and [[use]].
* <parse [[list]] and return the result>=
*/
{
Name first;
Parlist pl = p->u.list;
if (pl == NULL)
error("%p: empty list", p);
if (nthPL(pl, 0)->alt != ATOM)
error("%p: first item of list not name", p);
first = nthPL(pl, 0)->u.atom;
if (first == strtoname("define")) {
/*
* Parsing the top-level expressions requires checking
* the argument counts and then parsing the subpieces.
* For function definitions, we could check that formal
* parameters have distinct names, but that check is
* part of the operational semantics for function
* definition.
* <parse [[define]] and return the result>=
*/
if (lengthPL(pl) != 4 || nthPL(pl, 1)->alt != ATOM || nthPL(pl,
2)->alt != LIST)
error("%p: usage: (define fun (formals) body)", p);
{
Name name = nthPL(pl, 1)->u.atom;
Namelist formals = getnamelist(name, p, nthPL(pl, 2)->u.list);
Exp body = parseexp(nthPL(pl, 3));
return mkDefine(name, mkUserfun(formals, body));
}
}
if (first == strtoname("val")) {
/*
* <parse [[val]] and return the result>=
*/
Exp var, exp;
if (lengthPL(pl) != 3)
error("%p: usage: (val var exp)", p);
var = parseexp(nthPL(pl, 1));
if (var->alt != VAR)
error("%p: usage: (val var exp) (bad variable)", p);
exp = parseexp(nthPL(pl, 2));
return mkVal(var->u.var, exp);
}
if (first == strtoname("use")) {
/*
* <parse [[use]] and return the result>=
*/
if (lengthPL(pl) != 2 || nthPL(pl, 1)->alt != ATOM)
error("%p: usage: (use filename)", p);
return mkUse(nthPL(pl, 1)->u.atom);
}
return mkExp(parseexp(p));
}
}
assert(0);
return NULL;
}
/* parse.c 694a */
static XDef parse(Par p) {
switch (p->alt) {
case ATOM:
/* parse [[atom]] and return the result 694b */
return mkDef(mkExp(parseexp(p)));
case LIST:
/* parse [[list]] and return the result 694c */
{
Name first;
Parlist pl = p->u.list;
if (pl == NULL)
error("%p: empty list", p);
if (nthPL(pl, 0)->alt != ATOM)
error("%p: first item of list not name", p);
first = nthPL(pl, 0)->u.atom;
if (first == strtoname("define")) {
/* parse [[define]] and return the result */
if (lengthPL(pl) != 5 || nthPL(pl, 1)->alt != ATOM ||
nthPL(pl, 2)->alt != LIST || nthPL(pl, 3)->alt != LIST)
error("%p: usage: (define fun (formals) (locals) body)", p);
{
Name name = nthPL(pl, 1)->u.atom;
Namelist formals = getnamelist(name, p, nthPL(pl, 2)->u.list);
Namelist locals = getnamelist(name, p, nthPL(pl, 3)->u.list);
Exp body = parseexp(nthPL(pl, 4));
return mkDef(mkDefine(name, mkUserfun(formals, locals, body)));
}
}
if (first == strtoname("val")) {
/* parse [[val]] and return the result 695c */
Exp var, exp;
if (lengthPL(pl) != 3)
error("%p: usage: (val var exp)", p);
var = parseexp(nthPL(pl, 1));
if (var->alt != VAR)
error("%p: usage: (val var exp) (bad variable)", p);
exp = parseexp(nthPL(pl, 2));
return mkDef(mkVal(var->u.var, exp));
}
if (first == strtoname("use")) {
/* parse [[use]] and return the result 695d */
if (lengthPL(pl) != 2 || nthPL(pl, 1)->alt != ATOM)
error("%p: usage: (use filename)", p);
return mkUse(nthPL(pl, 1)->u.atom);
}
if (first == strtoname("check-expect")) {
/* parse [[check-expect]] and return the result 695e */
Exp check, expect;
if (lengthPL(pl) != 3)
error("%p: usage: (check-expect exp exp)", p);
check = parseexp(nthPL(pl, 1));
expect = parseexp(nthPL(pl, 2));
return mkTest(mkCheckExpect(check, expect));
}
if (first == strtoname("check-error")) {
/* parse [[check-error]] and return the result 696a */
Exp check;
if (lengthPL(pl) != 2)
error("%p: usage: (check-error exp)", p);
check = parseexp(nthPL(pl, 1));
return mkTest(mkCheckError(check));
}
return mkDef(mkExp(parseexp(p)));
}
}
assert(0);
return NULL;
}
