/* parse.c 720b */
Namelist getnamelist(Par p, Parlist pl) {
if (pl == NULL)
return NULL;
if (pl->hd->alt != ATOM)
error("%p: formal parameter list contains %p, which is not a name", p,
pl->hd);
return mkNL(pl->hd->u.atom, getnamelist(p, pl->tl));
}
/*
* <parse.c>=
*/
static Namelist getnamelist(Name f, Par p, Parlist pl) {
if (pl == NULL)
return NULL;
if (pl->hd->alt != ATOM)
error("%p: formal-parameter list of function %n contains "
"something that is not a name", p, f);
return mkNL(pl->hd->u.atom, getnamelist(f, p, pl->tl));
}
/*
* You might think that to add a new binding to an
* environment, we would always have to insert a new
* binding at the beginning of the lists. But we can get
* away with an optimization. If x in dom rho, instead
* of extending rho by making rho{x |->v}, we can
* overwrite the old binding of x. This optimization is
* safe only because no program written in Impcore can
* tell the difference. We can prove this by examining
* the rules of the operational semantics, which show
* that in any context where rho{x |->v} appears, there
* is no way to get to the old rho(x). (See Exercise
* [->].) [*]
* <env.c>=
*/
void bindval(Name name, Value val, Valenv env) {
Value *vp = findval(name, env);
if (vp != NULL)
*vp = val; /* safe optimization */
else {
env->nl = mkNL(name, env->nl);
env->vl = mkVL(val, env->vl);
}
}
/*
* <env.c>=
*/
void bindfun(Name name, Fun fun, Funenv env) {
Fun *fp = findfun(name, env);
if (fp != NULL)
*fp = fun; /* safe optimization */
else {
env->nl = mkNL(name, env->nl);
env->fl = mkFL(fun, env->fl);
}
}
/* 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);
}
}