From e557e58168f72ac2723fd8bbb51fb4144e51bcce Mon Sep 17 00:00:00 2001 From: Alexander Rosenberg Date: Tue, 1 Jul 2025 01:31:44 +0900 Subject: [PATCH] Fix some parsing bugs and allow running files --- src/lisp.c | 76 ++++++++++++++++++++++++++++++++++++++++++++++++++---- src/lisp.h | 8 ++++++ src/main.c | 41 ++++++++++++++++++++++------- src/read.c | 53 ++++++++++++++++++++++--------------- 4 files changed, 142 insertions(+), 36 deletions(-) diff --git a/src/lisp.c b/src/lisp.c index 354a1d7..ee02b46 100644 --- a/src/lisp.c +++ b/src/lisp.c @@ -589,7 +589,7 @@ DEFUN(backtrace, "backtrace", ()) { DEFUN(throw, "throw", (LispVal * signal, LispVal *rest)) { CHECK_TYPE(TYPE_SYMBOL, signal); - LispVal *backtrace = Fbacktrace(); + LispVal *error_arg = make_list(2, Fpair(signal, rest), Fbacktrace()); for (; the_stack; stack_leave()) { if (!the_stack->enable_handlers) { continue; @@ -608,10 +608,9 @@ DEFUN(throw, "throw", (LispVal * signal, LispVal *rest)) { the_stack->hidden = true; if (!NILP(var)) { // TODO make sure this isn't constant - Fputhash(the_stack->lexenv, var, - make_list(2, Fpair(signal, rest), backtrace)); + Fputhash(the_stack->lexenv, var, error_arg); } - WITH_CLEANUP(backtrace, { + WITH_CLEANUP(error_arg, { IGNORE_REF(Feval(form)); // }); }); @@ -619,7 +618,7 @@ DEFUN(throw, "throw", (LispVal * signal, LispVal *rest)) { } } // we never used it, so drop it - lisp_unref(backtrace); + lisp_unref(error_arg); fprintf(stderr, "ERROR: An exception has propogated past the top of the stack!\n"); fprintf(stderr, "Type: "); @@ -633,6 +632,7 @@ DEFUN(throw, "throw", (LispVal * signal, LispVal *rest)) { DEF_STATIC_SYMBOL(shutdown_signal, "shutdown-signal"); DEF_STATIC_SYMBOL(type_error, "type-error"); DEF_STATIC_SYMBOL(read_error, "read-error"); +DEF_STATIC_SYMBOL(eof_error, "eof-error"); DEF_STATIC_SYMBOL(void_variable_error, "void-variable-error"); DEF_STATIC_SYMBOL(void_function_error, "void-function-error"); DEF_STATIC_SYMBOL(circular_error, "circular-error"); @@ -654,6 +654,13 @@ void lisp_init() { REGISTER_SYMBOL(tail); REGISTER_SYMBOL(quote); REGISTER_SYMBOL(exit); + REGISTER_SYMBOL(print); + REGISTER_SYMBOL(println); + REGISTER_SYMBOL(not); + REGISTER_SYMBOL(when); + REGISTER_SYMBOL(add); + REGISTER_SYMBOL(if); + REGISTER_SYMBOL(setq); #undef REGISTER_SYMBOL } @@ -883,6 +890,65 @@ DEFMACRO(quote, "'", (LispVal * form)) { return form; } +DEFUN(print, "print", (LispVal * obj)) { + debug_dump(stdout, obj, false); + return Qnil; +} + +DEFUN(println, "println", (LispVal * obj)) { + debug_dump(stdout, obj, true); + return Qnil; +} + +DEFUN(not, "not", (LispVal * obj)) { + return NILP(obj) ? Qt : Qnil; +} + +DEFMACRO(if, "if", (LispVal * cond, LispVal *t, LispVal *nil)) { + LispVal *res = Feval(cond); + LispVal *retval = Qnil; + WITH_PUSH_FRAME(Qnil, Qnil, true, { + the_stack->hidden = true; + if (!NILP(res)) { + retval = Feval(t); + } else { + retval = Feval(nil); + } + }); + return retval; +} + +DEFMACRO(when, "when", (LispVal * cond, LispVal *t)) { + return Fif(cond, t, Qnil); +} + +DEFUN(add, "+", (LispVal * n1, LispVal *n2)) { + if (INTEGERP(n1) && INTEGERP(n2)) { + return make_lisp_integer(((LispInteger *) n1)->value + + ((LispInteger *) n2)->value); + } else if (INTEGERP(n1) && FLOATP(n2)) { + return make_lisp_float(((LispInteger *) n1)->value + + ((LispFloat *) n2)->value); + } else if (FLOATP(n1) && INTEGERP(n2)) { + return make_lisp_float(((LispFloat *) n1)->value + + ((LispInteger *) n2)->value); + } else if (FLOATP(n1) && FLOATP(n2)) { + return make_lisp_float(((LispFloat *) n1)->value + + ((LispFloat *) n2)->value); + } else { + Fthrow(Qtype_error, Qnil); + } +} + +DEFMACRO(setq, "setq", (LispVal * name, LispVal *value)) { + CHECK_TYPE(TYPE_SYMBOL, name); + LispSymbol *sym = (LispSymbol *) name; + LispVal *evaled = Feval(value); + lisp_unref(sym->value); + sym->value = lisp_ref(evaled); + return evaled; +} + static void debug_dump_real(FILE *stream, void *obj, bool first) { switch (TYPEOF(obj)) { case TYPE_STRING: { diff --git a/src/lisp.h b/src/lisp.h index abd5c6b..d998e59 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -379,6 +379,7 @@ noreturn DECLARE_FUNCTION(throw, (LispVal * signal, LispVal *rest)); extern LispVal *Qshutdown_signal; extern LispVal *Qtype_error; extern LispVal *Qread_error; +extern LispVal *Qeof_error; extern LispVal *Qvoid_variable_error; extern LispVal *Qvoid_function_error; extern LispVal *Qcircular_error; @@ -404,6 +405,13 @@ DECLARE_FUNCTION(apply, (LispVal * function, LispVal *rest)); DECLARE_FUNCTION(head, (LispVal * list)); DECLARE_FUNCTION(tail, (LispVal * list)); noreturn DECLARE_FUNCTION(exit, (LispVal * code)); +DECLARE_FUNCTION(print, (LispVal * obj)); +DECLARE_FUNCTION(println, (LispVal * obj)); +DECLARE_FUNCTION(not, (LispVal * obj)); +DECLARE_FUNCTION(when, (LispVal * cond, LispVal *t)); +DECLARE_FUNCTION(if, (LispVal * cond, LispVal *t, LispVal *nil)); +DECLARE_FUNCTION(add, (LispVal * n1, LispVal *n2)); +DECLARE_FUNCTION(setq, (LispVal * name, LispVal *value)); void debug_dump(FILE *stream, void *obj, bool newline); void debug_print_hashtable(FILE *stream, LispVal *table); diff --git a/src/main.c b/src/main.c index 44eb0f1..deaa09e 100644 --- a/src/main.c +++ b/src/main.c @@ -56,12 +56,26 @@ LispVal *Ftoplevel_error_handler(LispVal *except) { 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(); - char buffer[] = "(t)"; - LispVal *tv; - read_from_buffer(buffer, sizeof(buffer) - 1, &tv); - lisp_ref(tv); + size_t pos = 0; WITH_PUSH_FRAME(Qtoplevel, Qnil, false, { the_stack->hidden = true; LispVal *err_var = INTERN_STATIC("err-var"); @@ -73,12 +87,19 @@ int main(int argc, const char **argv) { the_stack->handlers, Qshutdown_signal, // simply call the above function make_list(3, err_var, Ftoplevel_exit_handler_function, err_var)); - LispVal *out = Feval(tv); - lisp_ref(out); - debug_dump(stdout, out, 1); - lisp_unref(out); - }) - UNREF_INPLACE(tv); + 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)); // + }) + } + }); lisp_shutdown(); return exit_status; } diff --git a/src/read.c b/src/read.c index 4872e29..50b0883 100644 --- a/src/read.c +++ b/src/read.c @@ -26,7 +26,7 @@ static int popc(struct ReadState *state) { int c = *(state->head++); if (c == '\n') { ++state->line; - state->off = 0; + state->col = 0; } else { ++state->col; } @@ -41,24 +41,28 @@ static int peekc(struct ReadState *state) { } static inline void _internal_read_error(struct ReadState *state, size_t len, - LispVal *desc) { - // TODO format better + LispVal *desc, LispVal *cause) { + if (len > state->left) { + len = state->left; + } LispVal *args = make_list( 4, make_lisp_integer(state->line), make_lisp_integer(state->col), make_lisp_string(state->head, len, false, false), desc); - lisp_ref(args); - Fthrow(Qread_error, args); - UNREF_INPLACE(args); + WITH_CLEANUP(args, { + Fthrow(cause, args); // + }); } #define READ_ERROR(state, len, ...) \ - _internal_read_error(state, len, sprintf_lisp(__VA_ARGS__)) -#define EOF_ERROR(state) READ_ERROR(state, 1, "unexpected end of file") + _internal_read_error(state, len, sprintf_lisp(__VA_ARGS__), Qread_error) +#define EOF_ERROR(state) \ + _internal_read_error(state, 1, sprintf_lisp("unexpected end of file"), \ + Qeof_error) #define SKIP_WHILE(cond, state) \ while (cond) { \ popc(state); \ } -#define SKIP_WHITESPACE(state) SKIP_WHILE(isblank(peekc(state)), state) +#define SKIP_WHITESPACE(state) SKIP_WHILE(isspace(peekc(state)), state) static bool is_symbol_end(int c) { return c == EOS || isspace(c) || c == '(' || c == ')' || c == '[' @@ -123,47 +127,46 @@ static LispVal *read_string(struct ReadState *state) { bool backslash = false; int c; char *str = lisp_malloc(1); + str[0] = '\0'; size_t str_len = 0; - while (backslash || (c = peekc(state)) != '"') { + while (backslash || peekc(state) != '"') { if (c == EOS) { lisp_free(str); EOF_ERROR(state); return Qnil; } - popc(state); + c = popc(state); if (!backslash && c == '\\') { backslash = true; } else if (backslash && c == '\n') { backslash = false; } else { str = lisp_realloc(str, ++str_len + 1); - int to_add = c; if (backslash) { switch (c) { case 'n': - to_add = '\n'; + c = '\n'; break; case 't': - to_add = '\t'; + c = '\t'; break; case 'r': - to_add = '\r'; + c = '\r'; break; case '0': - to_add = '\0'; + c = '\0'; break; case '"': - to_add = '"'; + c = '"'; break; default: // TODO make this point at the correct thing - READ_ERROR(state, 1, "unknown escape sequence"); lisp_free(str); - return Qnil; + READ_ERROR(state, 1, "unknown escape sequence"); } } backslash = false; - str[str_len - 1] = to_add; + str[str_len - 1] = c; } } str[str_len] = '\n'; @@ -251,6 +254,7 @@ static LispVal *read_number_or_symbol(struct ReadState *state, int base) { bool has_decimal = false; const char *number_start = state->head; const char *exp_start = NULL; + bool had_number = false; int c; while (!is_symbol_end(c = peekc(state))) { popc(state); @@ -262,6 +266,7 @@ static LispVal *read_number_or_symbol(struct ReadState *state, int base) { if (base == INVALID_BASE) { goto change_to_symbol; } + had_number = false; number_start = state->head; } else if (c == '.') { if (base != ANY_BASE || has_decimal || exp_start) { @@ -275,13 +280,19 @@ static LispVal *read_number_or_symbol(struct ReadState *state, int base) { } // fallthrough } else if (!is_base_char(base, c)) { - if ((c == 'e' || c == 'E') && !exp_start && base == ANY_BASE) { + if ((c == 'e' || c == 'E') && !exp_start && base == ANY_BASE + && had_number) { exp_start = state->head; } else { goto change_to_symbol; } + } else { + had_number = true; } } + if (!had_number) { + goto change_to_symbol; + } size_t len = state->head - number_start; // ceil(# bytes in size_t / 3) // This works because log10(2^n) is O(n) for k=3