simple-lisp/src/main.c

#include "lisp.h"
#include "read.h"

static int exit_status = 0;

LispVal *Ftoplevel_exit_handler(LispVal *except);
static LispFunction _Ftoplevel_exit_handler_function = {
    .type = TYPE_FUNCTION,
    .is_builtin = true,
    .is_macro = false,
    .builtin = (lisp_function_ptr_t) &Ftoplevel_exit_handler,
    .args = Qnil,
    .kwargs = Qnil,
    .rargs = Qnil,
    .oargs = Qnil,
    .rest_arg = Qnil,
    .lexenv = Qnil,
};
#define Ftoplevel_exit_handler_function \
    LISPVAL(&_Ftoplevel_exit_handler_function)
LispVal *Ftoplevel_exit_handler(LispVal *except) {
    LispVal *detail = TAIL(HEAD(except));
    if (NILP(detail) || NILP(HEAD(detail))) {
        exit_status = 0;
    } else if (!INTEGERP(HEAD(detail))) {
        exit_status = 1;
    } else {
        exit_status = ((LispInteger *) HEAD(detail))->value;
    }
    return Qnil;
}

LispVal *Ftoplevel_error_handler(LispVal *except);
static LispFunction _Ftoplevel_error_handler_function = {
    .type = TYPE_FUNCTION,
    .is_builtin = true,
    .is_macro = false,
    .builtin = (lisp_function_ptr_t) &Ftoplevel_error_handler,
    .args = Qnil,
    .kwargs = Qnil,
    .lexenv = Qnil,
    .rargs = Qnil,
    .oargs = Qnil,
    .rest_arg = Qnil,
};
#define Ftoplevel_error_handler_function \
    LISPVAL(&_Ftoplevel_error_handler_function)
LispVal *Ftoplevel_error_handler(LispVal *except) {
    LispVal *type = HEAD(HEAD(except));
    LispVal *detail = TAIL(HEAD(except));
    LispVal *backtrace = HEAD(TAIL(except));
    fprintf(stderr, "Caught signal of type ");
    debug_dump(stderr, type, true);
    if (!NILP(detail)) {
        fprintf(stderr, "Details: ");
        debug_dump(stderr, detail, true);
    }
    fprintf(stderr, "\nBacktrace (toplevel comes last):\n");
    FOREACH(frame, backtrace) {
        fprintf(stderr, "  ");
        debug_dump(stderr, frame, true);
    }
    exit_status = 1;
    return Qnil;
}

DEF_STATIC_SYMBOL(toplevel_read, "toplevel-read");

int main(int argc, const char **argv) {
    if (argc < 2) {
        fprintf(stderr, "No input file!\n");
        return 1;
    }
    FILE *in = fopen(argv[1], "r");
    if (!in) {
        perror("fopen");
        return 1;
    }
    fseek(in, 0, SEEK_END);
    off_t file_len = ftello(in);
    rewind(in);
    char buffer[file_len];
    fread(buffer, 1, file_len, in);
    fclose(in);
    lisp_init();
    REGISTER_SYMBOL(toplevel_read);
    REGISTER_STATIC_FUNCTION(Ftoplevel_error_handler_function, "(e)", "");
    REGISTER_STATIC_FUNCTION(Ftoplevel_exit_handler_function, "(e)", "");
    size_t pos = 0;
    WITH_PUSH_FRAME(Qtoplevel, Qnil, false, {
        LispVal *err_var = INTERN_STATIC("err-var");
        puthash(the_stack->handlers, Qt,
                // simply call the above function
                const_list(true, 3, err_var, Ftoplevel_error_handler_function,
                           err_var));
        puthash(the_stack->handlers, Qshutdown_signal,
                // simply call the above function
                const_list(true, 3, err_var, Ftoplevel_exit_handler_function,
                           err_var));
        LispVal *nil_nil = Fpair(Qnil, Qnil);
        puthash(the_stack->handlers, Qeof_error,
                // ignore
                nil_nil);
        refcount_unref(nil_nil);
        refcount_unref(err_var);
        while (true) {
            LispVal *tv;
            WITH_PUSH_FRAME(Qtoplevel_read, Qnil, false, {
                size_t res =
                    read_from_buffer(buffer + pos, file_len - pos, &tv);
                if (res == LISP_EOF) {
                    break;
                }
                pos += res;
            });
            WITH_CLEANUP(tv, {
                refcount_unref(Feval(tv)); //
            });
        }
    });
    lisp_shutdown();
    return exit_status;
}