/* 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;
}
}
/* evaldef.c 147e */
Env evaldef(Def d, Env env, Echo echo) {
switch (d->alt) {
case VAL:
/* evaluate [[val]] binding and return new environment 148a */
{
Value v;
if (find(d->u.val.name, env) == NULL)
env = bindalloc(d->u.val.name, unspecified(), env);
v = eval(d->u.val.exp, env);
*find(d->u.val.name, env) = v;
if (echo == ECHOING) {
if (d->u.val.exp->alt == LAMBDAX)
print("%n\n", d->u.val.name);
else
print("%v\n", v);
}
return env;
}
case EXP:
/* evaluate expression, store the result in [[it]], and return new environment 148b */
{
Value v = eval(d->u.exp, env);
Value *itloc = find(strtoname("it"), env);
if (echo == ECHOING)
print("%v\n", v);
if (itloc == NULL) {
return bindalloc(strtoname("it"), v, env);
} else {
*itloc = v;
return env;
}
}
case DEFINE:
/* evaluate function definition and return new environment 148c */
/* if [[d->u.define.lambda.formals]] contains a duplicate, call [[error]] 715d */
if (duplicatename(d->u.define.lambda.formals) != NULL)
error(
"formal parameter %n appears twice in definition of function %n",
duplicatename(d->u.define.lambda.formals), d->u.define.name);
return evaldef(mkVal(d->u.define.name, mkLambdax(d->u.define.lambda)),
env, echo);
}
assert(0);
return NULL;
}
/*
* Access to the desired size of the heap
*
* To control the size of the heap, we might want to use
* the micro-Scheme variable [[ --- gamma-desired]], as
* described in Exercises [->] and [->]. This routine
* gets the value of that variable. [*]
* <loc.c>=
*/
int gammadesired(int defaultval, int minimum) {
Value *gloc;
assert(roots.globals != NULL);
gloc = find(strtoname("&gamma-desired"), *roots.globals);
if (gloc && gloc->alt == NUM)
return gloc->u.num > minimum ? gloc->u.num : minimum;
else
return defaultval;
}
/*
* Other supporting code
*
* To control the size of the heap, we might want to use
* the micro-Scheme variable [[ --- gamma-desired]], as
* described in Exercises [->] and [->]. This routine
* gets the value of that variable. [*]
* <loc.c>=
*/
int gammadesired(int defaultval, int minimum) {
Value *gloc;
assert(rootstacksize > 0 && rootstack[0].alt == ENVROOT);
gloc = find(strtoname("&gamma-desired"), *rootstack[0].u.envroot);
if (gloc && gloc->alt == NUM)
return gloc->u.num > minimum ? gloc->u.num : minimum;
else
return defaultval;
}
int main(int argc, char *argv[]) {
Funenv functions = mkFunenv(NULL, NULL);
Valenv globals = mkValenv(NULL, NULL);
int doprompt = (argc <= 1) || (strcmp(argv[1], "-q") != 0);
Prompts prompts = doprompt ? STD_PROMPTS : NO_PROMPTS;
XDefreader input = xdefreader(filereader("standard input", stdin), prompts);
/* install conversion specifications in print module 50c */
installprinter('d', printdecimal);
installprinter('e', printexp);
installprinter('E', printexplist);
installprinter('f', printfun);
installprinter('n', printname);
installprinter('N', printnamelist);
installprinter('p', printpar);
installprinter('P', printparlist);
installprinter('s', printstring);
installprinter('t', printdef);
installprinter('v', printvalue);
installprinter('V', printvaluelist);
/* install the initial basis in [[functions]] 51a */
{
static char *prims[] = { "+", "-", "*", "/", "<", ">", "=", "print", 0 }
;
char **p;
for (p=prims; *p; p++) {
Name n = strtoname(*p);
bindfun(n, mkPrimitive(n), functions);
}
}
/* install the initial basis in [[functions]] 51c */
{
/* C representation of initial basis for {\impcore} (generated by a script) */
/*Adding empty local evironment to the functions in the initial basis => "()" */
const char *basis=
"(define and (b c) () (if b c b))\n"
"(define or (b c) () (if b b c))\n"
"(define not (b) () (if b 0 1))\n"
"(define <= (x y) () (not (> x y)))\n"
"(define >= (x y) () (not (< x y)))\n"
"(define != (x y) () (not (= x y)))\n"
"(define mod (m n) () (- m (* n (/ m n))))\n";
if (setjmp(errorjmp))
assert(0); /* fail if error in basis */
readevalprint(xdefreader(stringreader("initial basis", basis),
NO_PROMPTS),
globals, functions, SILENT);
}
while (setjmp(errorjmp))
;
readevalprint(input, globals, functions, ECHOING);
return 0;
}
/* eval.c 40b */
Value eval(Exp e, Valenv globals, Funenv functions, Valenv formals, Valenv locals) {
checkoverflow(1000000 * sizeof(char *)); /* OMIT */
switch (e->alt) {
case LITERAL:
/* evaluate [[e->u.literal]] and return the result 40c */
return e->u.literal;
case VAR:
/* evaluate [[e->u.var]] and return the result 41a */
if (isvalbound(e->u.var, locals))
return fetchval(e->u.var, locals);
else if (isvalbound(e->u.var, formals))
return fetchval(e->u.var, formals);
else if (isvalbound(e->u.var, globals))
return fetchval(e->u.var, globals);
else
error("unbound variable %n", e->u.var);
assert(0); /* not reached */
return 0;
case SET:
/* evaluate [[e->u.set]] and return the result 41b */
{
Value v = eval(e->u.set.exp, globals, functions, formals, locals);
if (isvalbound(e->u.set.name, locals))
bindval(e->u.set.name, v, locals);
else if (isvalbound(e->u.set.name, formals))
bindval(e->u.set.name, v, formals);
else if (isvalbound(e->u.set.name, globals))
bindval(e->u.set.name, v, globals);
else
error("set: unbound variable %n", e->u.set.name);
return v;
}
case IFX:
/* evaluate [[e->u.ifx]] and return the result 42a */
if (eval(e->u.ifx.cond, globals, functions, formals, locals) != 0)
return eval(e->u.ifx.true, globals, functions, formals, locals);
else
return eval(e->u.ifx.false, globals, functions, formals, locals);
case WHILEX:
/* evaluate [[e->u.whilex]] and return the result 42b */
while (eval(e->u.whilex.cond, globals, functions, formals, locals) != 0)
eval(e->u.whilex.exp, globals, functions, formals, locals);
return 0;
case BEGIN:
/* evaluate [[e->u.begin]] and return the result 43a */
{
Explist el;
Value v = 0;
for (el=e->u.begin; el; el=el->tl)
v = eval(el->hd, globals, functions, formals, locals);
return v;
}
case APPLY:
/* evaluate [[e->u.apply]] and return the result 43b */
{
Fun f;
/* make [[f]] the function denoted by [[e->u.apply.name]], or call [[error]] 43c */
if (!isfunbound(e->u.apply.name, functions))
error("call to undefined function %n", e->u.apply.name);
f = fetchfun(e->u.apply.name, functions);
switch (f.alt) {
case USERDEF:
/* apply [[f.u.userdef]] and return the result 44b */
{
Namelist locn = f.u.userdef.locals;
Valuelist locv = NULL;
int i = 0;
Namelist nl = f.u.userdef.formals;
Valuelist vl = evallist(e->u.apply.actuals, globals,
functions, formals, locals);
checkargc(e, lengthNL(nl), lengthVL(vl));
/* Setting the local values to 0 */
while (i < lengthNL(locn)) {
locv = mkVL(0, locv);
i = lengthVL(locv);
}
/* make sure the number of names is equal to the number of values*/
checkargc(e, lengthNL(locn), lengthVL(locv));
return eval(f.u.userdef.body, globals, functions, mkValenv(nl, vl), mkValenv(locn, locv));
}
case PRIMITIVE:
/* apply [[f.u.primitive]] and return the result 45a */
{
Valuelist vl = evallist(e->u.apply.actuals, globals,
functions, formals, locals);
if (f.u.primitive == strtoname("print"))
/* apply [[print]] to [[vl]] and return 45b */
{
Value v;
checkargc(e, 1, lengthVL(vl));
v = nthVL(vl, 0);
print("%v\n", v);
return v;
}
else
/* apply arithmetic primitive to [[vl]] and return 46 */
{
const char *s;
Value v, w;
checkargc(e, 2, lengthVL(vl));
v = nthVL(vl, 0);
w = nthVL(vl, 1);
s = nametostr(f.u.primitive);
assert(strlen(s) == 1);
switch (s[0]) {
case '<':
return v < w;
case '>':
return v > w;
case '=':
return v == w;
case '+':
return v + w;
case '-':
return v - w;
case '*':
return v * w;
case '/':
if (w == 0)
error("division by zero in %e", e);
return v / w;
default:
assert(0);
return 0; /* not reached */
}
}
}
}
assert(0);
return 0; /* not reached */
}
}
/* 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>=
*/
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;
}
}
/* 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;
}
/*
* <evaldef.c>=
*/
Env evaldef(Def d, Env env, Echo echo) {
switch (d->alt) {
case VAL:
/*
* According to the operational semantics, the
* right-hand side of a [[val]] binding must be
* evaluated in an environment in which the name [[d->
* u.val.name]] is bound. If the binding is not already
* present, we bind the name to an unspecified value.
* <evaluate [[val]] binding and return new environment>=
*/
{
Value v;
if (find(d->u.val.name, env) == NULL)
env = bindalloc(d->u.val.name, unspecified(), env);
v = eval(d->u.val.exp, env);
*find(d->u.val.name, env) = v;
if (echo == ECHOING) {
if (d->u.val.exp->alt == LAMBDAX)
print("%n\n", d->u.val.name);
else
print("%v\n", v);
}
return env;
}
case EXP:
/*
* As in Impcore, evaluating a top-level expression has
* the same effect on the environment as evaluating a
* definition of [[it]], except that the interpreter
* always prints the value, never the name ``it.''
* <evaluate expression, store the result in [[it]], and return new
environment>=
*/
{
Value v = eval(d->u.exp, env);
Value *itloc = find(strtoname("it"), env);
if (echo == ECHOING)
print("%v\n", v);
if (itloc == NULL) {
return bindalloc(strtoname("it"), v, env);
} else {
*itloc = v;
return env;
}
}
case DEFINE:
/*
* We rewrite \xdefine to \xval.
* <evaluate function definition and return new environment>=
*/
/*
* <if [[d->u.define.lambda.formals]] contains a duplicate, call
[[error]]>=
*/
if (duplicatename(d->u.define.lambda.formals) != NULL)
error(
"formal parameter %n appears twice in definition of function %n",
duplicatename(d->u.define.lambda.formals), d->u.define.name);
return evaldef(mkVal(d->u.define.name, mkLambdax(d->u.define.lambda)),
env, echo);
}
assert(0);
return NULL;
}