Refactor files

src/base.c

@@ -3,10 +3,11 @@
 #include "function.h"
 #include "gc.h"
 #include "hashtable.h"
-#include "io.h"
+#include "init_globals.h"
-#include "lisp.h"
+#include "lisp_math.h"
 #include "list.h"
 #include "stack.h"
+#include "symbol.h"
 
 #include <stdio.h>
 #include <string.h>
@@ -184,176 +185,6 @@ DEFUN(length, "length", (LispVal * seq), "(seq)", "") {
     signal_type_error(seq, LIST(Qlist, Qvector, Qstring, Qhash_table));
 }
 
-// ################
-// # Constructors #
-// ################
-LispVal *make_vector(LispVal **data, size_t length, bool take) {
-    LispVector *obj = lisp_alloc_object(sizeof(LispVector), TYPE_VECTOR);
-    obj->length = length;
-    if (take) {
-        obj->data = data;
-        for (size_t i = 0; i < length; ++i) {
-            MARK_OBJECT_ADDED(data[i], obj);
-        }
-    } else {
-        obj->data = lisp_malloc(sizeof(LispVal *) * length);
-        for (size_t i = 0; i < length; ++i) {
-            MARK_OBJECT_ADDED(data[i], obj);
-            obj->data[i] = data[i];
-        }
-    }
-    return obj;
-}
-
-DEFUN(vector, "vector", (LispVal * data), "(&rest data)", "") {
-    intptr_t length = list_length(data);
-    if (length == -1) {
-        lisp_signal(Qcircular_list_error, Qnil);
-    }
-    LispVal **vec_data = lisp_malloc(sizeof(LispVal *) * length);
-    size_t i = 0;
-    DOLIST(datum, data) {
-        vec_data[i++] = datum;
-    }
-    return make_vector(vec_data, length, true);
-}
-
-DEFUN(make_symbol, "make-symbol", (LispVal * name), "(name)",
-      "Return an uninterned symbol called NAME.") {
-    LispSymbol *obj = lisp_alloc_object(sizeof(LispSymbol), TYPE_SYMBOL);
-    obj->name = name;
-    obj->function = Qnil;
-    obj->plist = Qnil;
-    obj->value_type = SYMBOL_NORMAL;
-    if (KEYWORDP(obj)) {
-        obj->value.normal = obj;
-        obj->flags |= SYMBOL_CONST_VALUE;
-    } else {
-        obj->value.normal = Qunbound;
-    }
-    return obj;
-}
-
-DEFUN(vectorp, "vectorp", (LispVal * data), "(data)", "") {
-    return VECTORP(data) ? Qt : Qnil;
-}
-
-DEFUN(symbolp, "symbolp", (LispVal * data), "(data)", "") {
-    return SYMBOLP(data) ? Qt : Qnil;
-}
-
-DEFUN(intern, "intern", (LispVal * name), "(name)", "") {
-    CHECK_TYPE(name, TYPE_STRING);
-    LispVal *res = Fgethash(obarray, name, Qunbound);
-    if (res != Qunbound) {
-        return res;
-    }
-    LispVal *newsym = Fmake_symbol(name);
-    Fputhash(obarray, name, newsym);
-    return newsym;
-}
-
-DEFUN(symbol_value, "symbol-value", (LispVal * sym), "(sym)", "") {
-    CHECK_TYPE(sym, TYPE_SYMBOL);
-    return SYMBOL_VALUE(sym);
-}
-
-DEFUN(symbol_function, "symbol-function", (LispVal * sym, LispVal *resolve),
-      "(sym &optional resolve)", "") {
-    CHECK_TYPE(sym, TYPE_SYMBOL);
-    if (NILP(resolve)) {
-        return ((LispSymbol *) sym)->function;
-    }
-    while (!NILP(sym) && SYMBOLP(sym)) {
-        sym = ((LispSymbol *) sym)->function;
-    }
-    return sym;
-}
-
-DEFUN(symbol_plist, "symbol-plist", (LispVal * sym), "(sym)", "") {
-    CHECK_TYPE(sym, TYPE_SYMBOL);
-    return ((LispSymbol *) sym)->plist;
-}
-
-DEFUN(set, "set", (LispVal * sym, LispVal *value), "(sym value)", "") {
-    CHECK_TYPE(sym, TYPE_SYMBOL);
-    SET_SYMBOL_VALUE(sym, value);
-    return value;
-}
-
-DEFUN(fset, "fset", (LispVal * sym, LispVal *value), "(sym value)", "") {
-    CHECK_TYPE(sym, TYPE_SYMBOL);
-    if (CONST_FUNCTION_P(sym)) {
-        signal_value_constant(sym);
-    }
-    ((LispSymbol *) sym)->function = value;
-    MARK_OBJECT_ADDED(value, sym);
-    return value;
-}
-
-DEFUN(setplist, "setplist", (LispVal * sym, LispVal *plist), "(sym plist)",
-      "") {
-    CHECK_TYPE(sym, TYPE_SYMBOL);
-    ((LispSymbol *) sym)->plist = plist;
-    MARK_OBJECT_ADDED(plist, sym);
-    return plist;
-}
-
-DEFUN(get, "get", (LispVal * sym, LispVal *key, LispVal *def),
-      "(sym key &optional def)", "") {
-    return Fplist_get(Fsymbol_plist(sym), key, def);
-}
-
-DEFUN(put, "put", (LispVal * sym, LispVal *key, LispVal *val), "(sym key val)",
-      "") {
-    return Fsetplist(sym, Fplist_put(Fsymbol_plist(sym), key, val));
-}
-
-static size_t check_index_in_range(LispVal *val, size_t size) {
-    if (FIXNUMP(val)) {
-        fixnum_t fn = XFIXNUM(val);
-        if (fn < 0 || fn >= size) {
-            goto out_of_bounds;
-        }
-        return fn;
-    } else if (LISP_GMP_P(val)) {
-        if (mpz_sgn(((LispGmp *) val)->val) < 0) {
-            goto out_of_bounds;
-        }
-        size_t out = mpz_get_ui(((LispGmp *) val)->val);
-        if (out >= size) {
-            goto out_of_bounds;
-        }
-        return out;
-    }
-    signal_type_error(val, Qinteger);
-out_of_bounds:
-    lisp_signal(Qout_of_bounds_error, LIST(val, make_number_unsigned(size)));
-}
-
-DEFUN(aref, "aref", (LispVal * arr, LispVal *idx), "(arr idx)", "") {
-    if (VECTORP(arr)) {
-        LispVector *v = arr;
-        size_t i = check_index_in_range(idx, v->length);
-        return v->data[i];
-    } else if (STRINGP(arr)) {
-        LispString *s = arr;
-        size_t i = check_index_in_range(idx, s->length);
-        return MAKE_FIXNUM(s->data[i]);
-    }
-    signal_type_error(arr, LIST(Qstring, Qvector));
-}
-
-DEFUN(aset, "aset", (LispVal * arr, LispVal *idx, LispVal *data),
-      "(arr idx data)", "") {
-    CHECK_TYPE(arr, TYPE_VECTOR);
-    CHECK_TYPE(idx, TYPE_FIXNUM, TYPE_GMP);
-    LispVector *v = arr;
-    size_t i = check_index_in_range(idx, v->length);
-    v->data[i] = data;
-    return data;
-}
-
 noreturn void signal_value_constant(LispVal *value) {
     lisp_signal(Qvalue_constant_error, LIST(value));
 }
@@ -441,8 +272,6 @@ DEFUN(condition_printer, "condition-printer", (LispVal * val), "(val)", "") {
     return Fget(val, Qcondition_printer, Qnil);
 }
 
-DEFINE_SYMBOL(kw_success, ":success");
-
 DEFUN(signal, "signal", (LispVal * name, LispVal *data), "(name data)", "") {
     lisp_signal(name, data);
     // the above is a non-local exit, if we come back here something has gone
@@ -503,3 +332,78 @@ DEFINE_CONDITION_CLASS(out_of_bounds_error, error);
 DEFINE_SYMBOL(backquote, "`");
 DEFINE_SYMBOL(comma, ",");
 DEFINE_SYMBOL(comma_at, ",@");
+
+// #####################
+// # VM Initialization #
+// #####################
+static void construct_manual_symbols(void) {
+    // IMPORTANT: the symbols listed here need to also be set as special in
+    // gen-init-globals.awk
+    Qnil = Fmake_symbol(LISP_LITSTR("nil"));
+    ((LispSymbol *) Qnil)->flags = SYMBOL_CONST_VALUE | SYMBOL_CONST_FUNCTION;
+    ((LispSymbol *) Qnil)->value.normal = Qnil;
+    ((LispSymbol *) Qnil)->function = Qnil;
+    ((LispSymbol *) Qnil)->plist = Qnil;
+    lisp_gc_register_static_object(Qnil);
+    Qt = Fmake_symbol(LISP_LITSTR("t"));
+    ((LispSymbol *) Qt)->flags = SYMBOL_CONST_VALUE | SYMBOL_CONST_FUNCTION;
+    ((LispSymbol *) Qt)->value.normal = Qt;
+    lisp_gc_register_static_object(Qt);
+    Qunbound = Fmake_symbol(LISP_LITSTR("unbound"));
+    ((LispSymbol *) Qunbound)->value.normal = Qunbound;
+    lisp_gc_register_static_object(Qunbound);
+    Qlexical_environment = Fmake_symbol(LISP_LITSTR("lexical-environment"));
+    ((LispSymbol *) Qlexical_environment)->value_type = SYMBOL_NATIVE;
+    ((LispSymbol *) Qlexical_environment)->value.native = &Vlexical_environment;
+    lisp_gc_register_static_object(Qlexical_environment);
+    Qlexical_tags = Fmake_symbol(LISP_LITSTR("lexical-tags"));
+    lisp_gc_register_static_object(Qlexical_tags);
+
+    Qhash_string = Fmake_symbol(LISP_LITSTR("hash-string"));
+    lisp_gc_register_static_object(Qhash_string);
+    Qstrings_equal = Fmake_symbol(LISP_LITSTR("strings-equal"));
+    lisp_gc_register_static_object(Qstrings_equal);
+}
+
+static void register_manual_symbols(void) {
+#define INTERN(cname) \
+    Fputhash(obarray, ((LispSymbol *) Q##cname)->name, Q##cname);
+    INTERN(nil);
+    INTERN(t);
+    // don't INTERN(unbound);
+    // don't INTERN(lexical_environment);
+    // don't INTERN(lexical_tags);
+    INTERN(hash_string);
+    INTERN(strings_equal);
+#undef INTERN
+}
+
+void lisp_init(void) {
+    mp_set_memory_functions(lisp_malloc, lisp_realloc_gmp, lisp_free_gmp);
+    construct_manual_symbols();
+    Vlexical_environment = Qnil;
+    obarray = Fmake_hash_table(Qhash_string, Qstrings_equal);
+    lisp_gc_register_static_object(obarray);
+
+    // Needed to register functions
+    REGISTER_GLOBAL_SYMBOL(and_allow_other_keys);
+    REGISTER_GLOBAL_SYMBOL(and_optional);
+    REGISTER_GLOBAL_SYMBOL(and_key);
+    REGISTER_GLOBAL_SYMBOL(and_rest);
+
+    // these call Fintern, so they need to have obarray constructed
+    ((LispSymbol *) Qhash_string)->function = BUILTIN_FUNCTION_OBJ(hash_string);
+    ((LispSymbol *) Qstrings_equal)->function =
+        BUILTIN_FUNCTION_OBJ(hash_string);
+
+    register_manual_symbols();
+    register_globals();
+
+    lisp_init_stack();
+    lisp_gc_on_alloc = true;
+}
+
+void lisp_shutdown(void) {
+    lisp_teardown_stack();
+    lisp_gc_teardown();
+}

src/base.h

@@ -196,48 +196,6 @@ noreturn void signal_type_error(LispVal *obj, LispVal *typespec);
     }                                                \
     struct __ignored
 
-DEFOBJTYPE(String, STRING, STRINGP, {
-    size_t length;
-    char *data;
-    bool owned;
-});
-
-enum SymbolValueType {
-    SYMBOL_NORMAL,
-    SYMBOL_NATIVE,
-};
-
-enum SymbolFlags {
-    SYMBOL_DYNAMIC = 1,
-    SYMBOL_CONST_VALUE = 2,
-    SYMBOL_CONST_FUNCTION = 4,
-};
-
-DEFOBJTYPE(Symbol, SYMBOL, SYMBOLP, {
-    LispVal *name; // string
-    enum SymbolValueType value_type : 1;
-    enum SymbolFlags flags : 7;
-    LispVal *function;
-    union {
-        LispVal *normal;
-        LispVal **native;
-    } value;
-    LispVal *plist;
-});
-
-static ALWAYS_INLINE bool KEYWORDP(LispVal *val) {
-    if (!SYMBOLP(val)) {
-        return false;
-    }
-    LispString *sym = (LispString *) ((LispSymbol *) val)->name;
-    return sym->length && *sym->data == ':';
-}
-
-DEFOBJTYPE(Vector, VECTOR, VECTORP, {
-    size_t length;
-    LispVal **data;
-});
-
 // Defined here instead of in function.h so that headers don't have to include
 // it just to define functions
 #define DECLARE_SYMBOL(cname)                         \
@@ -377,69 +335,9 @@ DECLARE_FUNCTION(equal, (LispVal * obj1, LispVal *obj2));
 DECLARE_FUNCTION(length, (LispVal * seq));
 
 // TODO probably move these to another file
-LispVal *make_vector(LispVal **data, size_t length, bool take);
-DECLARE_FUNCTION(vector, (LispVal * data));
-DECLARE_FUNCTION(make_symbol, (LispVal * name));
-DECLARE_FUNCTION(vectorp, (LispVal * data));
-DECLARE_FUNCTION(symbolp, (LispVal * data));
-DECLARE_FUNCTION(intern, (LispVal * name));
-DECLARE_FUNCTION(symbol_value, (LispVal * sym));
-DECLARE_FUNCTION(symbol_function, (LispVal * sym, LispVal *resolve));
-DECLARE_FUNCTION(symbol_plist, (LispVal * sym));
-DECLARE_FUNCTION(set, (LispVal * sym, LispVal *value));
-DECLARE_FUNCTION(fset, (LispVal * sym, LispVal *value));
-DECLARE_FUNCTION(setplist, (LispVal * sym, LispVal *plist));
-DECLARE_FUNCTION(get, (LispVal * sym, LispVal *key, LispVal *def));
-DECLARE_FUNCTION(put, (LispVal * sym, LispVal *key, LispVal *val));
-
-DECLARE_FUNCTION(aref, (LispVal * arr, LispVal *idx));
-DECLARE_FUNCTION(aset, (LispVal * arr, LispVal *idx, LispVal *data));
 
 noreturn void signal_value_constant(LispVal *value);
 
-static ALWAYS_INLINE LispVal *SYMBOL_VALUE(LispVal *sym) {
-    assert(SYMBOLP(sym));
-    LispSymbol *s = (LispSymbol *) sym;
-    switch (s->value_type) {
-    case SYMBOL_NORMAL:
-        return s->value.normal;
-    case SYMBOL_NATIVE:
-        return *s->value.native;
-    }
-}
-
-static ALWAYS_INLINE bool CONST_VALUE_P(LispVal *sym) {
-    assert(SYMBOLP(sym));
-    return ((LispSymbol *) sym)->flags & SYMBOL_CONST_VALUE;
-}
-
-static ALWAYS_INLINE bool CONST_FUNCTION_P(LispVal *sym) {
-    assert(SYMBOLP(sym));
-    return ((LispSymbol *) sym)->flags & SYMBOL_CONST_FUNCTION;
-}
-
-static ALWAYS_INLINE bool DYNAMIC_SYMBOL_P(LispVal *sym) {
-    assert(SYMBOLP(sym));
-    return ((LispSymbol *) sym)->flags & SYMBOL_DYNAMIC;
-}
-
-static inline void SET_SYMBOL_VALUE(LispVal *sym, LispVal *value) {
-    assert(SYMBOLP(sym));
-    LispSymbol *s = (LispSymbol *) sym;
-    if (CONST_VALUE_P(sym)) {
-        signal_value_constant(sym);
-    }
-    switch (s->value_type) {
-    case SYMBOL_NORMAL:
-        s->value.normal = value;
-        break;
-    case SYMBOL_NATIVE:
-        *s->value.native = value;
-        break;
-    }
-    MARK_OBJECT_ADDED(value, sym);
-}
-
 // needed for conditions
 DECLARE_SYMBOL(fixnum);
 DECLARE_SYMBOL(float);
@@ -463,8 +361,6 @@ DECLARE_FUNCTION(condition_class_p, (LispVal * val));
 DECLARE_FUNCTION(condition_subclass_p, (LispVal * child, LispVal *parent));
 DECLARE_FUNCTION(condition_printer, (LispVal * val));
 
-DECLARE_SYMBOL(kw_success);
-
 DECLARE_FUNCTION(signal, (LispVal * name, LispVal *data));
 DECLARE_FUNCTION(handler_bind, (LispVal * thunk, LispVal *handlers));
 DECLARE_FUNCTION(error, (LispVal * data));
@@ -484,4 +380,10 @@ DECLARE_SYMBOL(backquote);
 DECLARE_SYMBOL(comma);
 DECLARE_SYMBOL(comma_at);
 
+// #####################
+// # VM Initialization #
+// #####################
+void lisp_init(void);
+void lisp_shutdown(void);
+
 #endif

src/function.c

@@ -1,11 +1,14 @@
 #include "function.h"
 
 #include "hashtable.h"
-#include "lisp.h"
+#include "interp.h"
 #include "lisp_string.h"
 #include "list.h"
+#include "macro.h"
+#include "print.h"
 #include "read.h"
 #include "stack.h"
+#include "symbol.h"
 
 #include <stdio.h>
 #include <stdlib.h>

src/function.h

@@ -2,9 +2,7 @@
 #define INCLUDED_FUNCTION_H
 
 #include "base.h"
-#include "lisp_string.h"
 #include "list.h"
-#include "stack.h"
 
 DECLARE_SYMBOL(and_optional);
 DECLARE_SYMBOL(and_rest);

src/gc.c

@@ -2,10 +2,11 @@
 
 #include "function.h"
 #include "hashtable.h"
-#include "lisp.h"
 #include "lisp_math.h"
+#include "lisp_string.h"
 #include "list.h"
 #include "stack.h"
+#include "symbol.h"
 
 #include <gmp.h>
 #include <stdlib.h>

src/hashtable.c

@@ -1,6 +1,7 @@
 #include "hashtable.h"
 
-#include "lisp.h"
+#include "function.h"
+#include "lisp_math.h"
 #include "lisp_string.h"
 
 #define INITIAL_SIZE     32

src/interp.c

@@ -1,82 +1,11 @@
-#include "lisp.h"
+#include "interp.h"
 
-#include "hashtable.h"
+#include "function.h"
-#include "init_globals.h"
 #include "lisp_string.h"
-
+#include "list.h"
-LispVal *obarray;
+#include "macro.h"
-
+#include "stack.h"
-static void construct_manual_symbols(void) {
+#include "symbol.h"
-    // IMPORTANT: the symbols listed here need to also be set as special in
-    // gen-init-globals.awk
-    Qnil = Fmake_symbol(LISP_LITSTR("nil"));
-    ((LispSymbol *) Qnil)->flags = SYMBOL_CONST_VALUE | SYMBOL_CONST_FUNCTION;
-    ((LispSymbol *) Qnil)->value.normal = Qnil;
-    ((LispSymbol *) Qnil)->function = Qnil;
-    ((LispSymbol *) Qnil)->plist = Qnil;
-    lisp_gc_register_static_object(Qnil);
-    Qt = Fmake_symbol(LISP_LITSTR("t"));
-    ((LispSymbol *) Qt)->flags = SYMBOL_CONST_VALUE | SYMBOL_CONST_FUNCTION;
-    ((LispSymbol *) Qt)->value.normal = Qt;
-    lisp_gc_register_static_object(Qt);
-    Qunbound = Fmake_symbol(LISP_LITSTR("unbound"));
-    ((LispSymbol *) Qunbound)->value.normal = Qunbound;
-    lisp_gc_register_static_object(Qunbound);
-    Qlexical_environment = Fmake_symbol(LISP_LITSTR("lexical-environment"));
-    ((LispSymbol *) Qlexical_environment)->value_type = SYMBOL_NATIVE;
-    ((LispSymbol *) Qlexical_environment)->value.native = &Vlexical_environment;
-    lisp_gc_register_static_object(Qlexical_environment);
-    Qlexical_tags = Fmake_symbol(LISP_LITSTR("lexical-tags"));
-    lisp_gc_register_static_object(Qlexical_tags);
-
-    Qhash_string = Fmake_symbol(LISP_LITSTR("hash-string"));
-    lisp_gc_register_static_object(Qhash_string);
-    Qstrings_equal = Fmake_symbol(LISP_LITSTR("strings-equal"));
-    lisp_gc_register_static_object(Qstrings_equal);
-}
-
-static void register_manual_symbols(void) {
-#define INTERN(cname) \
-    Fputhash(obarray, ((LispSymbol *) Q##cname)->name, Q##cname);
-    INTERN(nil);
-    INTERN(t);
-    // don't INTERN(unbound);
-    // don't INTERN(lexical_environment);
-    // don't INTERN(lexical_tags);
-    INTERN(hash_string);
-    INTERN(strings_equal);
-#undef INTERN
-}
-
-void lisp_init(void) {
-    mp_set_memory_functions(lisp_malloc, lisp_realloc_gmp, lisp_free_gmp);
-    construct_manual_symbols();
-    Vlexical_environment = Qnil;
-    obarray = Fmake_hash_table(Qhash_string, Qstrings_equal);
-    lisp_gc_register_static_object(obarray);
-
-    // Needed to register functions
-    REGISTER_GLOBAL_SYMBOL(and_allow_other_keys);
-    REGISTER_GLOBAL_SYMBOL(and_optional);
-    REGISTER_GLOBAL_SYMBOL(and_key);
-    REGISTER_GLOBAL_SYMBOL(and_rest);
-
-    // these call Fintern, so they need to have obarray constructed
-    ((LispSymbol *) Qhash_string)->function = BUILTIN_FUNCTION_OBJ(hash_string);
-    ((LispSymbol *) Qstrings_equal)->function =
-        BUILTIN_FUNCTION_OBJ(hash_string);
-
-    register_manual_symbols();
-    register_globals();
-
-    lisp_init_stack();
-    lisp_gc_on_alloc = true;
-}
-
-void lisp_shutdown(void) {
-    lisp_teardown_stack();
-    lisp_gc_teardown();
-}
 
 static inline LispVal *lookup_variable(LispSymbol *name) {
     LispVal *lexval = Fplist_get(Vlexical_environment, name, Qunbound);
@@ -251,5 +180,56 @@ DEFUN(not, "not", (LispVal * datum), "(datum)", "") {
     return NILP(datum) ? Qt : Qnil;
 }
 
+DEFSPECIAL(block, "block", (LispVal * name, LispVal *body), "(name &rest body)",
+           "") {
+    CHECK_TYPE(name, TYPE_SYMBOL);
+    if (!SYMBOLP(name))
+        CHECK_TYPE(name, TYPE_SYMBOL);
+    LispVal *volatile return_value = Qnil;
+    jmp_buf target;
+    StackFrame *stack_ref = LISP_STACK_REF();
+    LispVal *tag = Fmake_symbol(((LispSymbol *) name)->name);
+    LispVal *cur_tags = Fplist_get(Vlexical_environment, name, Qnil);
+    push_copy_lexenv();
+    new_lexical_variable(Qlexical_tags, CONS(CONS(name, tag), cur_tags));
+    push_block_frame(tag, &target, &return_value, stack_ref);
+    if (setjmp(target) == 0) {
+        return UNWIND_AND_RETURN(stack_ref, Fprogn(body));
+    } else {
+        // return-from handles unwinding and putting the return value in a local
+        // references frame
+        return return_value;
+    }
+}
+
+static LispVal *lookup_block_tag(LispVal *name) {
+    LispVal *tags = Fplist_get(Vlexical_environment, Qlexical_tags, Qnil);
+    LispVal *ent = Fassoc(name, tags, Qnil);
+    return CONSP(ent) ? XCDR(ent) : Qunbound;
+}
+
+DEFSPECIAL(return_from, "return-from", (LispVal * name, LispVal *value),
+           "(name &optional value)", "") {
+    CHECK_TYPE(name, TYPE_SYMBOL);
+    value = eval(value);
+    LispVal *tag = lookup_block_tag(name);
+    if (tag != Qunbound) {
+        for (ptrdiff_t i = the_stack.depth; i >= 0; --i) {
+            StackFrame *restrict frame = &the_stack.frames[i];
+            if (frame->kind == STACK_FRAME_BLOCK && EQ(frame->block.tag, tag)) {
+                add_local_reference(frame->block.unwind_to, value);
+                *frame->block.value_ptr = value;
+                unwind_to(frame->block.unwind_to);
+                longjmp(*frame->block.target, 1);
+            }
+        }
+        // block went out of scope
+        lisp_signal(Qblock_out_of_scope_error, LIST(name));
+    } else {
+        // block never existed
+        lisp_signal(Qno_such_block_error, LIST(name));
+    }
+}
+
 DEFINE_SYMBOL(unbound_variable_error, "unbound-variable-error");
 DEFINE_CONDITION_CLASS(unbound_variable_error, error);

src/interp.h

@@ -1,21 +1,7 @@
-#ifndef INCLUDED_LISP_H
+#ifndef INCLUDED_INTERP_H
-#define INCLUDED_LISP_H
+#define INCLUDED_INTERP_H
 
 #include "base.h"
-#include "function.h" // IWYU pragma: export
-#include "hashtable.h" // IWYU pragma: export
-#include "lisp_math.h" // IWYU pragma: export
-#include "lisp_string.h" // IWYU pragma: export
-#include "list.h" // IWYU pragma: export
-#include "macro.h" // IWYU pragma: export
-#include "print.h" // IWYU pragma: export
-#include "stack.h" // IWYU pragma: export
-
-extern LispVal *obarray;
-
-void lisp_init(void);
-
-void lisp_shutdown(void);
 
 LispVal *eval(LispVal *form);
 DECLARE_FUNCTION(eval, (LispVal * form, LispVal *lexenv));
@@ -28,6 +14,9 @@ DECLARE_FUNCTION(or, (LispVal * forms));
 DECLARE_FUNCTION(null, (LispVal * datum));
 DECLARE_FUNCTION(not, (LispVal * datum));
 
+DECLARE_FUNCTION(block, (LispVal * name, LispVal *body));
+DECLARE_FUNCTION(return_from, (LispVal * name, LispVal *value));
+
 DECLARE_SYMBOL(unbound_variable_error);
 MAKE_CONDITION_CLASS(unbound_variable_error);
 

src/lisp_string.c

@@ -1,9 +1,16 @@
 #include "lisp_string.h"
 
+#include "lisp_math.h"
+#include "list.h"
+#include "stack.h"
+
 #include <stdarg.h>
 #include <stdio.h>
 #include <string.h>
 
+// ###########
+// # Strings #
+// ###########
 LispVal *make_lisp_string(const char *data, size_t length, bool take,
                           bool copy) {
     LispString *obj = lisp_alloc_object(sizeof(LispString), TYPE_STRING);
@@ -77,3 +84,89 @@ DEFUN(charp, "charp", (LispVal * obj), "(obj)", "") {
 }
 
 DEFINE_SYMBOL(char, "char");
+
+// ###########
+// # Vectors #
+// ###########
+LispVal *make_vector(LispVal **data, size_t length, bool take) {
+    LispVector *obj = lisp_alloc_object(sizeof(LispVector), TYPE_VECTOR);
+    obj->length = length;
+    if (take) {
+        obj->data = data;
+        for (size_t i = 0; i < length; ++i) {
+            MARK_OBJECT_ADDED(data[i], obj);
+        }
+    } else {
+        obj->data = lisp_malloc(sizeof(LispVal *) * length);
+        for (size_t i = 0; i < length; ++i) {
+            MARK_OBJECT_ADDED(data[i], obj);
+            obj->data[i] = data[i];
+        }
+    }
+    return obj;
+}
+
+DEFUN(vector, "vector", (LispVal * data), "(&rest data)", "") {
+    intptr_t length = list_length(data);
+    if (length == -1) {
+        lisp_signal(Qcircular_list_error, Qnil);
+    }
+    LispVal **vec_data = lisp_malloc(sizeof(LispVal *) * length);
+    size_t i = 0;
+    DOLIST(datum, data) {
+        vec_data[i++] = datum;
+    }
+    return make_vector(vec_data, length, true);
+}
+
+DEFUN(vectorp, "vectorp", (LispVal * data), "(data)", "") {
+    return VECTORP(data) ? Qt : Qnil;
+}
+
+// ########
+// # Both #
+// ########
+static size_t check_index_in_range(LispVal *val, size_t size) {
+    if (FIXNUMP(val)) {
+        fixnum_t fn = XFIXNUM(val);
+        if (fn < 0 || fn >= size) {
+            goto out_of_bounds;
+        }
+        return fn;
+    } else if (LISP_GMP_P(val)) {
+        if (mpz_sgn(((LispGmp *) val)->val) < 0) {
+            goto out_of_bounds;
+        }
+        size_t out = mpz_get_ui(((LispGmp *) val)->val);
+        if (out >= size) {
+            goto out_of_bounds;
+        }
+        return out;
+    }
+    signal_type_error(val, Qinteger);
+out_of_bounds:
+    lisp_signal(Qout_of_bounds_error, LIST(val, make_number_unsigned(size)));
+}
+
+DEFUN(aref, "aref", (LispVal * arr, LispVal *idx), "(arr idx)", "") {
+    if (VECTORP(arr)) {
+        LispVector *v = arr;
+        size_t i = check_index_in_range(idx, v->length);
+        return v->data[i];
+    } else if (STRINGP(arr)) {
+        LispString *s = arr;
+        size_t i = check_index_in_range(idx, s->length);
+        return MAKE_FIXNUM(s->data[i]);
+    }
+    signal_type_error(arr, LIST(Qstring, Qvector));
+}
+
+DEFUN(aset, "aset", (LispVal * arr, LispVal *idx, LispVal *data),
+      "(arr idx data)", "") {
+    CHECK_TYPE(arr, TYPE_VECTOR);
+    CHECK_TYPE(idx, TYPE_FIXNUM, TYPE_GMP);
+    LispVector *v = arr;
+    size_t i = check_index_in_range(idx, v->length);
+    v->data[i] = data;
+    return data;
+}

src/lisp_string.h

@@ -5,7 +5,14 @@
 
 #include <stdarg.h>
 
-// LispString (the type) is defined in base.h
+// ###########
+// # Strings #
+// ###########
+DEFOBJTYPE(String, STRING, STRINGP, {
+    size_t length;
+    char *data;
+    bool owned;
+});
 
 LispVal *make_lisp_string(const char *data, size_t length, bool take,
                           bool copy);
@@ -23,4 +30,22 @@ DECLARE_FUNCTION(hash_string, (LispVal * string));
 DECLARE_FUNCTION(charp, (LispVal * obj));
 DECLARE_SYMBOL(char);
 
+// ###########
+// # Vectors #
+// ###########
+DEFOBJTYPE(Vector, VECTOR, VECTORP, {
+    size_t length;
+    LispVal **data;
+});
+
+LispVal *make_vector(LispVal **data, size_t length, bool take);
+DECLARE_FUNCTION(vector, (LispVal * data));
+DECLARE_FUNCTION(vectorp, (LispVal * data));
+
+// ########
+// # Both #
+// ########
+DECLARE_FUNCTION(aref, (LispVal * arr, LispVal *idx));
+DECLARE_FUNCTION(aset, (LispVal * arr, LispVal *idx, LispVal *data));
+
 #endif

src/macro.c

@@ -1,8 +1,9 @@
 #include "macro.h"
 
 #include "function.h"
-#include "lisp.h"
+#include "interp.h"
 #include "list.h"
+#include "symbol.h"
 
 DEFINE_SYMBOL(macro, "macro");
 

src/main.c

@@ -1,6 +1,9 @@
+#include "interp.h"
 #include "io.h"
-#include "lisp.h"
+#include "list.h"
+#include "print.h"
 #include "read.h"
+#include "stack.h"
 
 #include <setjmp.h>
 #include <stdio.h>

src/print.c

@@ -1,9 +1,13 @@
 #include "print.h"
 
+#include "function.h"
+#include "hashtable.h"
 #include "io.h"
-#include "lisp.h"
+#include "lisp_math.h"
-// for WHITESPACEP, READ_EOS, and SYMBOL_END_P
+#include "lisp_string.h"
 #include "read.h"
+#include "stack.h"
+#include "symbol.h"
 
 #include <limits.h>
 #include <string.h>

src/read.c

@@ -7,6 +7,7 @@
 #include "lisp_string.h"
 #include "list.h"
 #include "stack.h"
+#include "symbol.h"
 
 #include <ctype.h>
 #include <inttypes.h>

src/stack.c

@@ -2,10 +2,11 @@
 
 #include "function.h"
 #include "hashtable.h"
-#include "lisp.h"
+#include "lisp_string.h"
 #include "list.h"
 #include "memory.h"
 #include "print.h"
+#include "symbol.h"
 
 #include <assert.h>
 #include <stdio.h>
@@ -278,6 +279,15 @@ void new_lexical_variable(LispVal *name, LispVal *value) {
     }
 }
 
+void push_block_frame(LispVal *tag, jmp_buf *target,
+                      LispVal *volatile *value_ptr, StackFrame *unwind_to) {
+    StackFrame *frame = PUSH_NEW_FRAME(STACK_FRAME_BLOCK);
+    frame->block.tag = tag;
+    frame->block.target = target;
+    frame->block.value_ptr = value_ptr;
+    frame->block.unwind_to = unwind_to;
+}
+
 void unwind_to(StackFrame *frame) {
     while (the_stack.depth && &the_stack.frames[the_stack.depth - 1] > frame) {
         StackFrame *restrict top = &the_stack.frames[--the_stack.depth];
@@ -366,61 +376,6 @@ noreturn void lisp_signal(LispVal *name, LispVal *data) {
     top_of_stack_exception_handler(name, data);
 }
 
-DEFSPECIAL(block, "block", (LispVal * name, LispVal *body), "(name &rest body)",
-           "") {
-    CHECK_TYPE(name, TYPE_SYMBOL);
-    if (!SYMBOLP(name))
-        CHECK_TYPE(name, TYPE_SYMBOL);
-    LispVal *volatile return_value = Qnil;
-    jmp_buf target;
-    StackFrame *stack_ref = LISP_STACK_REF();
-    LispVal *tag = Fmake_symbol(((LispSymbol *) name)->name);
-    LispVal *cur_tags = Fplist_get(Vlexical_environment, name, Qnil);
-    push_copy_lexenv();
-    new_lexical_variable(Qlexical_tags, CONS(CONS(name, tag), cur_tags));
-    StackFrame *frame = PUSH_NEW_FRAME(STACK_FRAME_BLOCK);
-    frame->block.tag = tag;
-    frame->block.target = &target;
-    frame->block.value_ptr = &return_value;
-    frame->block.unwind_to = stack_ref;
-    if (setjmp(target) == 0) {
-        return UNWIND_AND_RETURN(stack_ref, Fprogn(body));
-    } else {
-        // return-from handles unwinding and putting the return value in a local
-        // references frame
-        return return_value;
-    }
-}
-
-static LispVal *lookup_block_tag(LispVal *name) {
-    LispVal *tags = Fplist_get(Vlexical_environment, Qlexical_tags, Qnil);
-    LispVal *ent = Fassoc(name, tags, Qnil);
-    return CONSP(ent) ? XCDR(ent) : Qunbound;
-}
-
-DEFSPECIAL(return_from, "return-from", (LispVal * name, LispVal *value),
-           "(name &optional value)", "") {
-    CHECK_TYPE(name, TYPE_SYMBOL);
-    value = eval(value);
-    LispVal *tag = lookup_block_tag(name);
-    if (tag != Qunbound) {
-        for (ptrdiff_t i = the_stack.depth; i >= 0; --i) {
-            StackFrame *restrict frame = &the_stack.frames[i];
-            if (frame->kind == STACK_FRAME_BLOCK && EQ(frame->block.tag, tag)) {
-                add_local_reference(frame->block.unwind_to, value);
-                *frame->block.value_ptr = value;
-                unwind_to(frame->block.unwind_to);
-                longjmp(*frame->block.target, 1);
-            }
-        }
-        // block went out of scope
-        lisp_signal(Qblock_out_of_scope_error, LIST(name));
-    } else {
-        // block never existed
-        lisp_signal(Qno_such_block_error, LIST(name));
-    }
-}
-
 DEFUN(backtrace, "backtrace", (void), "()", "") {
     LispVal *out = Qnil;
     for (size_t i = 0; i < the_stack.depth; ++i) {

src/stack.h

@@ -137,6 +137,10 @@ void set_lexical_variable(LispVal *name, LispVal *value);
 // Just add a new lexical variable without any checking
 void new_lexical_variable(LispVal *name, LispVal *value);
 
+// blocks
+void push_block_frame(LispVal *tag, jmp_buf *target,
+                      LispVal *volatile *value_ptr, StackFrame *unwind_to);
+
 void unwind_to(StackFrame *frame);
 static ALWAYS_INLINE LispVal *UNWIND_AND_RETURN(StackFrame *frame,
                                                 LispVal *val) {
@@ -147,9 +151,6 @@ static ALWAYS_INLINE LispVal *UNWIND_AND_RETURN(StackFrame *frame,
 
 noreturn void lisp_signal(LispVal *name, LispVal *data);
 
-DECLARE_FUNCTION(block, (LispVal * name, LispVal *body));
-DECLARE_FUNCTION(return_from, (LispVal * name, LispVal *value));
-
 /**
  * Backtraces have the form (name fobj evaled? args)
  */

src/symbol.c

@@ -0,0 +1,93 @@
+#include "symbol.h"
+
+#include "hashtable.h"
+#include "list.h"
+
+LispVal *obarray;
+
+DEFUN(make_symbol, "make-symbol", (LispVal * name), "(name)",
+      "Return an uninterned symbol called NAME.") {
+    LispSymbol *obj = lisp_alloc_object(sizeof(LispSymbol), TYPE_SYMBOL);
+    obj->name = name;
+    obj->function = Qnil;
+    obj->plist = Qnil;
+    obj->value_type = SYMBOL_NORMAL;
+    if (KEYWORDP(obj)) {
+        obj->value.normal = obj;
+        obj->flags |= SYMBOL_CONST_VALUE;
+    } else {
+        obj->value.normal = Qunbound;
+    }
+    return obj;
+}
+
+DEFUN(symbolp, "symbolp", (LispVal * data), "(data)", "") {
+    return SYMBOLP(data) ? Qt : Qnil;
+}
+
+DEFUN(intern, "intern", (LispVal * name), "(name)", "") {
+    CHECK_TYPE(name, TYPE_STRING);
+    LispVal *res = Fgethash(obarray, name, Qunbound);
+    if (res != Qunbound) {
+        return res;
+    }
+    LispVal *newsym = Fmake_symbol(name);
+    Fputhash(obarray, name, newsym);
+    return newsym;
+}
+
+DEFUN(symbol_value, "symbol-value", (LispVal * sym), "(sym)", "") {
+    CHECK_TYPE(sym, TYPE_SYMBOL);
+    return SYMBOL_VALUE(sym);
+}
+
+DEFUN(symbol_function, "symbol-function", (LispVal * sym, LispVal *resolve),
+      "(sym &optional resolve)", "") {
+    CHECK_TYPE(sym, TYPE_SYMBOL);
+    if (NILP(resolve)) {
+        return ((LispSymbol *) sym)->function;
+    }
+    while (!NILP(sym) && SYMBOLP(sym)) {
+        sym = ((LispSymbol *) sym)->function;
+    }
+    return sym;
+}
+
+DEFUN(symbol_plist, "symbol-plist", (LispVal * sym), "(sym)", "") {
+    CHECK_TYPE(sym, TYPE_SYMBOL);
+    return ((LispSymbol *) sym)->plist;
+}
+
+DEFUN(set, "set", (LispVal * sym, LispVal *value), "(sym value)", "") {
+    CHECK_TYPE(sym, TYPE_SYMBOL);
+    SET_SYMBOL_VALUE(sym, value);
+    return value;
+}
+
+DEFUN(fset, "fset", (LispVal * sym, LispVal *value), "(sym value)", "") {
+    CHECK_TYPE(sym, TYPE_SYMBOL);
+    if (CONST_FUNCTION_P(sym)) {
+        signal_value_constant(sym);
+    }
+    ((LispSymbol *) sym)->function = value;
+    MARK_OBJECT_ADDED(value, sym);
+    return value;
+}
+
+DEFUN(setplist, "setplist", (LispVal * sym, LispVal *plist), "(sym plist)",
+      "") {
+    CHECK_TYPE(sym, TYPE_SYMBOL);
+    ((LispSymbol *) sym)->plist = plist;
+    MARK_OBJECT_ADDED(plist, sym);
+    return plist;
+}
+
+DEFUN(get, "get", (LispVal * sym, LispVal *key, LispVal *def),
+      "(sym key &optional def)", "") {
+    return Fplist_get(Fsymbol_plist(sym), key, def);
+}
+
+DEFUN(put, "put", (LispVal * sym, LispVal *key, LispVal *val), "(sym key val)",
+      "") {
+    return Fsetplist(sym, Fplist_put(Fsymbol_plist(sym), key, val));
+}

src/symbol.h

@@ -0,0 +1,95 @@
+#ifndef INCLUDED_SYMBOL_H
+#define INCLUDED_SYMBOL_H
+
+#include "base.h"
+#include "lisp_string.h"
+
+extern LispVal *obarray;
+
+enum SymbolValueType {
+    SYMBOL_NORMAL,
+    SYMBOL_NATIVE,
+};
+
+enum SymbolFlags {
+    SYMBOL_DYNAMIC = 1,
+    SYMBOL_CONST_VALUE = 2,
+    SYMBOL_CONST_FUNCTION = 4,
+};
+
+DEFOBJTYPE(Symbol, SYMBOL, SYMBOLP, {
+    LispVal *name; // string
+    enum SymbolValueType value_type : 1;
+    enum SymbolFlags flags : 7;
+    LispVal *function;
+    union {
+        LispVal *normal;
+        LispVal **native;
+    } value;
+    LispVal *plist;
+});
+
+static ALWAYS_INLINE bool KEYWORDP(LispVal *val) {
+    if (!SYMBOLP(val)) {
+        return false;
+    }
+    LispString *sym = (LispString *) ((LispSymbol *) val)->name;
+    return sym->length && *sym->data == ':';
+}
+
+static ALWAYS_INLINE LispVal *SYMBOL_VALUE(LispVal *sym) {
+    assert(SYMBOLP(sym));
+    LispSymbol *s = (LispSymbol *) sym;
+    switch (s->value_type) {
+    case SYMBOL_NORMAL:
+        return s->value.normal;
+    case SYMBOL_NATIVE:
+        return *s->value.native;
+    }
+}
+
+static ALWAYS_INLINE bool CONST_VALUE_P(LispVal *sym) {
+    assert(SYMBOLP(sym));
+    return ((LispSymbol *) sym)->flags & SYMBOL_CONST_VALUE;
+}
+
+static ALWAYS_INLINE bool CONST_FUNCTION_P(LispVal *sym) {
+    assert(SYMBOLP(sym));
+    return ((LispSymbol *) sym)->flags & SYMBOL_CONST_FUNCTION;
+}
+
+static ALWAYS_INLINE bool DYNAMIC_SYMBOL_P(LispVal *sym) {
+    assert(SYMBOLP(sym));
+    return ((LispSymbol *) sym)->flags & SYMBOL_DYNAMIC;
+}
+
+static inline void SET_SYMBOL_VALUE(LispVal *sym, LispVal *value) {
+    assert(SYMBOLP(sym));
+    LispSymbol *s = (LispSymbol *) sym;
+    if (CONST_VALUE_P(sym)) {
+        signal_value_constant(sym);
+    }
+    switch (s->value_type) {
+    case SYMBOL_NORMAL:
+        s->value.normal = value;
+        break;
+    case SYMBOL_NATIVE:
+        *s->value.native = value;
+        break;
+    }
+    MARK_OBJECT_ADDED(value, sym);
+}
+
+DECLARE_FUNCTION(make_symbol, (LispVal * name));
+DECLARE_FUNCTION(symbolp, (LispVal * data));
+DECLARE_FUNCTION(intern, (LispVal * name));
+DECLARE_FUNCTION(symbol_value, (LispVal * sym));
+DECLARE_FUNCTION(symbol_function, (LispVal * sym, LispVal *resolve));
+DECLARE_FUNCTION(symbol_plist, (LispVal * sym));
+DECLARE_FUNCTION(set, (LispVal * sym, LispVal *value));
+DECLARE_FUNCTION(fset, (LispVal * sym, LispVal *value));
+DECLARE_FUNCTION(setplist, (LispVal * sym, LispVal *plist));
+DECLARE_FUNCTION(get, (LispVal * sym, LispVal *key, LispVal *def));
+DECLARE_FUNCTION(put, (LispVal * sym, LispVal *key, LispVal *val));
+
+#endif