Fix some parsing bugs and allow running files

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,
+                    Fputhash(the_stack->lexenv, var, error_arg);
-                             make_list(2, Fpair(signal, rest), backtrace));
                 }
-                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: {

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);

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)";
+    size_t pos = 0;
-    LispVal *tv;
-    read_from_buffer(buffer, sizeof(buffer) - 1, &tv);
-    lisp_ref(tv);
     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);
+        Fputhash(the_stack->handlers, Qeof_error,
-        lisp_ref(out);
+                 // ignore
-        debug_dump(stdout, out, 1);
+                 Fpair(Qnil, Qnil));
-        lisp_unref(out);
+        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)); //
             })
-    UNREF_INPLACE(tv);
+        }
+    });
     lisp_shutdown();
     return exit_status;
 }

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) {
+                                        LispVal *desc, LispVal *cause) {
-    // TODO format better
+    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);
+    WITH_CLEANUP(args, {
-    Fthrow(Qread_error, args);
+        Fthrow(cause, args); //
-    UNREF_INPLACE(args);
+    });
 }
 #define READ_ERROR(state, len, ...) \
-    _internal_read_error(state, len, sprintf_lisp(__VA_ARGS__))
+    _internal_read_error(state, len, sprintf_lisp(__VA_ARGS__), Qread_error)
-#define EOF_ERROR(state) READ_ERROR(state, 1, "unexpected end of file")
+#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