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,
    .ref_count = -1,
    .is_builtin = 1,
    .is_macro = 0,
    .builtin = &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 = Ftail(Fhead(except));
    if (NILP(detail) || NILP(Fhead(detail))) {
        exit_status = 0;
    } else if (!INTEGERP(Fhead(detail))) {
        exit_status = 1;
    } else {
        exit_status = ((LispInteger *) Fhead(detail))->value;
    }
    return Qnil;
}

LispVal *Ftoplevel_error_handler(LispVal *except);
static LispFunction _Ftoplevel_error_handler_function = {
    .type = TYPE_FUNCTION,
    .ref_count = -1,
    .is_builtin = 1,
    .is_macro = 0,
    .builtin = &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 = Fhead(Fhead(except));
    LispVal *detail = Ftail(Fhead(except));
    LispVal *backtrace = Fhead(Ftail(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_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, {
    //     the_stack->hidden = true;
    //     LispVal *err_var = INTERN_STATIC("err-var");
    //     Fputhash(
    //         the_stack->handlers, Qt,
    //         // simply call the above function
    //         const_list(3, err_var, Ftoplevel_error_handler_function,
    //         err_var));
    //     Fputhash(
    //         the_stack->handlers, Qshutdown_signal,
    //         // simply call the above function
    //         const_list(3, err_var, Ftoplevel_exit_handler_function,
    //         err_var));
    //     Fputhash(the_stack->handlers, Qeof_error,
    //              // ignore
    //              Fpair(Qnil, Qnil));
    //     while (pos < file_len) {
    //         LispVal *tv;
    //         WITH_PUSH_FRAME(Qtoplevel_read, Qnil, false, {
    //             pos += read_from_buffer(buffer + pos, file_len - pos, &tv);
    //         });
    //         WITH_CLEANUP(tv, {
    //             IGNORE_REF(Feval(tv)); //
    //         });
    //     }
    // });
    stack_enter(Qtoplevel, (((LispVal *) (&_Qnil))), 0);
    if (_setjmp(the_stack->start) == 0) {
        {
            the_stack->hidden = 1;
            LispVal *err_var =
                (_internal_INTERN_STATIC(("err-var"), sizeof("err-var") - 1));
            Fputhash(
                the_stack->handlers, (((LispVal *) (&_Qt))),
                const_list(3, err_var,
                           ((LispVal *) (&_Ftoplevel_error_handler_function)),
                           err_var));
            Fputhash(
                the_stack->handlers, Qshutdown_signal,
                const_list(3, err_var,
                           ((LispVal *) (&_Ftoplevel_exit_handler_function)),
                           err_var));
            Fputhash(the_stack->handlers, Qeof_error,
                     Fpair((((LispVal *) (&_Qnil))), (((LispVal *) (&_Qnil)))));
            while (pos < file_len) {
                LispVal *tv;
                stack_enter(Qtoplevel_read, (((LispVal *) (&_Qnil))), 0);
                if (_setjmp(the_stack->start) == 0) {
                    {
                        pos +=
                            read_from_buffer(buffer + pos, file_len - pos, &tv);
                    }
                }
                stack_leave();
                ;
                lisp_ref(tv);
                {
                    void *__with_cleanup_cleanup = register_cleanup(
                        (lisp_cleanup_func_t) &lisp_unref_double_ptr, &(tv));
                    {{(lisp_unref(lisp_ref(Feval(tv))));
                }
            };
            cancel_cleanup(__with_cleanup_cleanup);
            lisp_unref(tv);
        };
    }
}
}
stack_leave();
;
lisp_shutdown();
return exit_status;
}