git @ Cat's Eye Technologies Pixley / master impl / mignon / eval.c
master

Tree @master (Download .tar.gz)

eval.c @masterraw · history · blame

#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>

#include "sexp.h"
#include "eval.h"

struct value *lookup(struct env *env, struct atom *name)
{
    for (; env != NULL; env = env->next) {
        if (env->name == name) {
            return env->value;
        }
    }
    return NULL;
}

struct env *bind(struct env *env, struct atom *name, struct value *value)
{
    struct env *e = malloc(sizeof *e);
    e->name = name;
    e->value = value;
    e->next = env;
    return e;
}

#ifdef DEBUG
static void dump_env(struct env *env)
{
    printf("env: {\n");
    while (env != NULL) {
        printf("  %s = ", env->name->string);
        dump(env->value);
        printf(";\n");
        env = env->next;
    }
    printf("}\n");
}

static void debug(const char *msg)
{
    printf("%s\n", msg);
    msg = msg;
}
#else
#define debug(x)
#endif

struct value *eval(struct value *sexp, struct env *env)
{
    struct value *car = atom("car");
    struct value *cdr = atom("cdr");
    struct value *cond = atom("cond");
    struct value *cons_ = atom("cons");
    struct value *else_ = atom("else");
    struct value *equalp = atom("equal?");
    struct value *lambda_ = atom("lambda");
    struct value *let = atom("let*");
    struct value *listp = atom("list?");
    struct value *quote = atom("quote");
    struct value *truth = atom("#t");
    struct value *falsehood = atom("#f");

    int done = 0;
    while (!done) {
        done = 1;
        switch (sexp->type) {
            case V_ATOM:
            {
                struct atom *name = (struct atom *)sexp;
                struct value *value = lookup(env, name);
                if (value == NULL) {
                    printf("Atom ");
                    dump(sexp);
                    printf(" has no meaning\n");
                    exit(1);
                }
                return value;
            }
            case V_CONS:
            {
                struct value *h = head(sexp);
                struct value *t = tail(sexp);
                struct value *bound = lookup(env, (struct atom *)h);
                debug("V_CONS");
                if (bound != NULL) {
                    debug("*(bound)");
                    debug(((struct atom *)h)->string);
                    sexp = cons(bound, t); /* pair of a lambda and a list */
                    done = 0; /* "tail call" */
                } else if (h == car) {
                    struct value *k = eval(head(t), env);
                    debug("*car");
                    return head(k);
                } else if (h == cdr) {
                    struct value *k = eval(head(t), env);
                    debug("*cdr");
                    return tail(k);
                } else if (h == cond) {
                    struct value *branch = head(t);
                    debug("*cond");
                    /* this will error out with car(nil) if no 'else' in cond */
                    while (done) {
                        struct value *test = head(branch);
                        struct value *expr = head(tail(branch));
                        if (test == else_) {
                            sexp = expr;
                            done = 0; /* "tail call" */
                        } else {
                            test = eval(test, env);
                            if (test != falsehood) {
                                sexp = expr;
                                done = 0; /* "tail call" */
                            } else {
                                t = tail(t);
                                branch = head(t);
                            }
                        }
                    }
                } else if (h == cons_) {
                    struct value *j = eval(head(t), env);
                    struct value *k = eval(head(tail(t)), env);
                    debug("*cons");
                    return cons(j, k);
                } else if (h == equalp) {
                    struct value *j = eval(head(t), env);
                    struct value *k = eval(head(tail(t)), env);
                    debug("*equalp");
                    if (equal(j, k)) {
                        return truth;
                    } else {
                        return falsehood;
                    }
                } else if (h == lambda_) {
                    debug("*lambda");
                    return lambda(env, head(t), head(tail(t)));
                } else if (h == let) {
                    struct value *pairs = head(t);
                    struct value *body = head(tail(t));
                    debug("*let*");
                    while (pairs != nil) {
                        struct value *pair = head(pairs);
                        struct value *name = head(pair);
                        struct value *value = eval(head(tail(pair)), env);
                        /* TODO: check that head(pair) is an atom! */
                        debug("binding");
                        debug(((struct atom *)name)->string);
                        env = bind(env, (struct atom *)name, value);
                        pairs = tail(pairs);
                    }
#ifdef DEBUG
                    dump_env(env);
#endif
                    sexp = body;
                    done = 0; /* "tail call" */
                } else if (h == listp) {
                    struct value *k = eval(head(t), env);
                    debug("*list?");
                    while (k->type == V_CONS) {
                        k = tail(k);
                    }
                    if (k == nil) {
                        return truth;
                    } else {
                        return falsehood;
                    }
                } else if (h == quote) {
                    debug("*quote");
                    if (t == nil)
                        return t;
                    return head(t);
                } else if (h->type == V_LAMBDA) {
                    struct lambda *l = (struct lambda *)h;
                    struct value *formals = l->formals;
                    struct env *l_env = l->env;
                    debug("*(lambda)");
                    while (t->type == V_CONS) {
                        struct value *formal = head(formals);
                        struct value *value = eval(head(t), env);
                        l_env = bind(l_env, (struct atom *)formal, value);
                        formals = tail(formals);
                        t = tail(t);
                    }
                    env = l_env;
                    sexp = l->body;
                    done = 0; /* "tail call" */       
                } else {
                    struct value *k = eval(h, env);
                    struct value *m = cons(eval(k, env), t);
                    debug("*(inner sexp)*");
                    return eval(m, env);
                }
                break;
            }
            case V_LAMBDA:
            {
                debug("V_LAMBDA\n");
                return sexp;
            }
        }
    }
    return sexp;
}