/* 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; }
/* 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; }
/* * 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; }
/* * <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; }