Пример #1
0
/*
 * 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;
}