Many different sequence functions

src/kernel.sl

@@ -203,6 +203,7 @@
 (define-type-predicate string stringp)
 (define-type-predicate symbol symbolp)
 (define-type-predicate pair pairp)
+(define-type-predicate list listp)
 (define-type-predicate integer (obj &opt min max)
   (and (integerp obj)
        (or (not min) (>= obj min))
@@ -217,7 +218,7 @@
 (define-type-predicate vector vectorp)
 (define-type-predicate function functionp)
 (define-type-predicate callable callablep)
-(define-type-predicate hashtable hashtablep)
+(define-type-predicate hash-table hash-table-p)
 (define-type-predicate user-pointer user-pointer-p)
 (define-type-predicate number (obj &opt min max)
   (typep obj (list 'or (list 'float min max)
@@ -302,7 +303,7 @@
     start))
 
 (defmacro macrolet (macros &rest body)
-  (let* ((found-macros (make-hashtable))
+  (let* ((found-macros (make-hash-table))
          (macro-fns (mapconcat (lambda (entry)
                                  (let ((name (first entry))
                                        (args (second entry))
@@ -334,7 +335,7 @@
     (apply 'list 'macrolet macros body)))
 
 (defmacro labels (functions &rest body)
-  (let ((syms (make-hashtable)))
+  (let ((syms (make-hash-table)))
     (dolist (entry functions)
       (when (gethash syms (first entry))
         (throw 'argument-error))
@@ -366,3 +367,35 @@
   (let* ((def '::unbound)
          (found (intern-soft (symbol-name symbol) def package t)))
     (eq symbol found)))
+
+(defun length (seq)
+  (tcase seq
+    (list (list-length seq))
+    ((or vector string) (vector-length seq))
+    (hash-table (hash-table-count seq))
+    (t (throw 'type-error))))
+
+(fset 'copy-vector 'subvector)
+
+(defun zerop (n)
+  (= n 0))
+
+(defun nth (n list)
+  (unless (integerp n)
+    (throw 'type-error '(integerp) n))
+  (when (< n 0)
+    (throw 'out-of-bounds-error n))
+  (dolist (elt list)
+    (when (zerop n)
+      (return-from nth elt))
+    (setq n (- n 1))))
+
+(defun nthtail (n list)
+  (unless (integerp n)
+    (throw 'type-error '(integerp) n))
+  (when (< n 0)
+    (throw 'out-of-bounds-error n))
+  (dotails (tail list)
+    (when (zerop n)
+      (return-from nthtail tail))
+    (setq n (- n 1))))

src/lisp.c

@@ -408,7 +408,7 @@ LispVal *predicate_for_type(LispType type) {
     case TYPE_FUNCTION:
         return Qfunctionp;
     case TYPE_HASHTABLE:
-        return Qhashtablep;
+        return Qhash_table_p;
     case TYPE_USER_POINTER:
         return Quser_pointer_p;
     case TYPE_PACKAGE:
@@ -479,6 +479,60 @@ DEFUN(eq, "eq", (LispVal * obj1, LispVal *obj2)) {
     return LISP_BOOL(obj1 == obj2);
 }
 
+static bool pairs_equal_internal(LispVal *obj1, LispVal *obj2) {
+    while (PAIRP(obj1) && PAIRP(obj2)
+           && !NILP(Fequal(HEAD(obj1), HEAD(obj2)))) {
+        obj1 = TAIL(obj1);
+        obj2 = TAIL(obj2);
+    }
+    return !PAIRP(obj1) && !NILP(Fequal(obj1, obj2));
+}
+
+DEFUN(equal, "equal", (LispVal * obj1, LispVal *obj2)) {
+    if (obj1 == obj2) {
+        return Qt;
+    } else if (TYPEOF(obj1) != TYPEOF(obj2)) {
+        return Qnil;
+    }
+    switch (TYPEOF(obj1)) {
+    case TYPE_SYMBOL:
+    case TYPE_FUNCTION:
+    case TYPE_PACKAGE:
+        // only if they are the same object (checked above)
+        return Qnil;
+    case TYPE_PAIR:
+        return LISP_BOOL(pairs_equal_internal(obj1, obj2));
+    case TYPE_USER_POINTER:
+        return LISP_BOOL(USERPTR(void *, obj1) == USERPTR(void *, obj2));
+    case TYPE_STRING:
+        return Fstrings_equal(obj1, obj2);
+    case TYPE_INTEGER:
+        return LISP_BOOL(((LispInteger *) obj1)->value
+                         == ((LispInteger *) obj2)->value);
+    case TYPE_FLOAT:
+        return LISP_BOOL(((LispFloat *) obj1)->value
+                         == ((LispFloat *) obj2)->value);
+    case TYPE_VECTOR:
+    case TYPE_HASHTABLE: {
+        LispHashtable *t1 = (LispHashtable *) obj1;
+        LispHashtable *t2 = (LispHashtable *) obj2;
+        if (t1->count != t2->count || NILP(Fequal(t1->eq_fn, t2->eq_fn))
+            || NILP(Fequal(t1->hash_fn, t2->hash_fn))) {
+            return Qnil;
+        }
+        HT_FOREACH_VALID_INDEX(t1, i) {
+            if (NILP(Fequal(HASH_VALUE(t1, i),
+                            gethash(obj2, HASH_KEY(t1, i), Qunbound)))) {
+                return Qnil;
+            }
+        }
+        return Qt;
+    }
+    default:
+        abort();
+    }
+}
+
 static void breakpoint(int64_t id) {}
 DEFUN(breakpoint, "breakpoint", (LispVal * id)) {
     if (NILP(id)) {
@@ -1381,7 +1435,9 @@ DEFMACRO(condition_case, "condition-case", (LispVal * form, LispVal *rest)) {
     if (success && success_form != Qunbound) {
         void *cl_handler =
             register_cleanup(&refcount_unref_as_callback, retval);
-        WITH_CLEANUP(success_form, { refcount_unref(Feval(success_form)); });
+        WITH_CLEANUP(success_form, {
+            refcount_unref(Feval(success_form)); //
+        });
         cancel_cleanup(cl_handler);
     }
     return retval;
@@ -1992,60 +2048,6 @@ DEFUN(plist_assoc, "plist-assoc",
     return Qnil;
 }
 
-// ####################
-// # String Functions #
-// ####################
-DEFUN(stringp, "stringp", (LispVal * val)) {
-    return LISP_BOOL(STRINGP(val));
-}
-
-DEFUN(hash_string, "hash-string", (LispVal * obj)) {
-    CHECK_TYPE(TYPE_STRING, obj);
-    const char *str = ((LispString *) obj)->data;
-    uint64_t hash = 5381;
-    int c;
-    while ((c = *(str++))) {
-        hash = ((hash << 5) + hash) + c;
-    }
-    return make_lisp_integer(hash);
-}
-
-DEFUN(strings_equal, "strings-equal", (LispVal * obj1, LispVal *obj2)) {
-    CHECK_TYPE(TYPE_STRING, obj1);
-    CHECK_TYPE(TYPE_STRING, obj2);
-    LispString *str1 = (LispString *) obj1;
-    LispString *str2 = (LispString *) obj2;
-    if (str1->length != str2->length) {
-        return Qnil;
-    }
-    return LISP_BOOL(memcmp(str1->data, str2->data, str1->length) == 0);
-}
-
-LispVal *sprintf_lisp(const char *format, ...) {
-    va_list args;
-    va_start(args, format);
-    va_list args_measure;
-    va_copy(args_measure, args);
-    int size = vsnprintf(NULL, 0, format, args_measure) + 1;
-    va_end(args_measure);
-    char *buffer = lisp_malloc(size);
-    vsnprintf(buffer, size, format, args);
-    LispVal *obj = make_lisp_string(buffer, size, true, false);
-    va_end(args);
-    return obj;
-}
-
-bool strings_equal_nocase(const char *s1, const char *s2, size_t n) {
-    for (size_t i = 0; i < n; ++i) {
-        if (!s1[i] || !s2[i]) {
-            return !s1[i] && !s2[i];
-        } else if (tolower(s1[i]) != tolower(s2[i])) {
-            return false;
-        }
-    }
-    return true;
-}
-
 // #####################
 // # Package Functions #
 // #####################
@@ -2407,21 +2409,33 @@ LispVal *intern(const char *name, size_t length, bool take, LispVal *package,
     return sym;
 }
 
-// #######################
+// ########################
 // # Hash Table Functions #
-// #######################
+// ########################
-DEFUN(hashtablep, "hashtablep", (LispVal * val)) {
+DEFUN(hash_table_p, "hash-table-p", (LispVal * val)) {
     return LISP_BOOL(HASHTABLEP(val));
 }
 
-DEFUN(make_hashtable, "make-hashtable", (LispVal * hash_fn, LispVal *eq_fn)) {
+DEFUN(make_hash_table, "make-hash-table", (LispVal * hash_fn, LispVal *eq_fn)) {
     return make_lisp_hashtable(eq_fn, hash_fn);
 }
 
 DEFUN(copy_hash_table, "copy-hash-table", (LispVal * table)) {
     CHECK_TYPE(TYPE_HASHTABLE, table);
-    // TODO implement
+    LispHashtable *src = (LispHashtable *) table;
-    return Qnil;
+    CONSTRUCT_OBJECT(copy, LispHashtable, TYPE_HASHTABLE);
+    copy->table_size = src->table_size;
+    copy->count = src->count;
+    copy->eq_fn = refcount_ref(src->eq_fn);
+    copy->hash_fn = refcount_ref(src->hash_fn);
+    copy->key_vals =
+        lisp_malloc0(sizeof(struct HashtableEntry) * copy->table_size);
+    HT_FOREACH_VALID_INDEX(src, i) {
+        copy->key_vals[i].key = refcount_ref(src->key_vals[i].key);
+        copy->key_vals[i].hash = src->key_vals[i].hash;
+        copy->key_vals[i].value = refcount_ref(src->key_vals[i].value);
+    }
+    return LISPVAL(copy);
 }
 
 DEFUN(hash_table_count, "hash-table-count", (LispVal * table)) {
@@ -2725,17 +2739,269 @@ DEFUN(vectorp, "vectorp", (LispVal * val)) {
     return LISP_BOOL(VECTORP(val));
 }
 
+DEFUN(make_vector, "make-vector",
+      (LispVal * initial_size, LispVal *initial_elem)) {
+    CHECK_TYPE(TYPE_INTEGER, initial_size);
+    int64_t size = ((LispInteger *) initial_size)->value;
+    if (size < 0) {
+        Fthrow(Qout_of_bounds_error, const_list(true, 1, initial_size));
+    }
+    LispVal **data = lisp_malloc(sizeof(LispVal *) * size);
+    for (size_t i = 0; i < size; ++i) {
+        data[i] = refcount_ref(initial_elem);
+    }
+    return make_lisp_vector(data, size);
+}
+
 DEFUN(vector, "vector", (LispVal * elems)) {
-    struct UnrefListData uld = {.vals = NULL, .len = 0};
+    if (LISTP(elems)) {
-    WITH_PUSH_FRAME(Qnil, Qnil, true, {
+        struct UnrefListData uld = {.vals = NULL, .len = 0};
-        void *cl_handler = register_cleanup(&unref_free_list_double_ptr, &uld);
+        WITH_PUSH_FRAME(Qnil, Qnil, true, {
-        FOREACH(elt, elems) {
+            void *cl_handler =
-            uld.vals = lisp_realloc(uld.vals, sizeof(LispVal *) * (++uld.len));
+                register_cleanup(&unref_free_list_double_ptr, &uld);
-            uld.vals[uld.len - 1] = elt;
+            FOREACH(elt, elems) {
+                uld.vals =
+                    lisp_realloc(uld.vals, sizeof(LispVal *) * (++uld.len));
+                uld.vals[uld.len - 1] = elt;
+            }
+            cancel_cleanup(cl_handler);
+        });
+        return make_lisp_vector(uld.vals, uld.len);
+    } else if (STRINGP(elems)) {
+        LispString *str = (LispString *) elems;
+        LispVal **data = lisp_malloc(sizeof(LispVal *) * str->length);
+        for (size_t i = 0; i < str->length; ++i) {
+            data[i] = make_lisp_integer(str->data[i]);
+        }
+        return make_lisp_vector(data, str->length);
+    } else if (VECTORP(elems)) {
+        LispVector *vec = (LispVector *) elems;
+        LispVal **data = lisp_malloc(sizeof(LispVal *) * vec->length);
+        for (size_t i = 0; i < vec->length; ++i) {
+            data[i] = refcount_ref(vec->data[i]);
+        }
+        return make_lisp_vector(data, vec->length);
+    } else {
+        Fthrow(Qtype_error,
+               const_list(false, 3,
+                          const_list(false, 2, Qvectorp, Qstringp, Qlistp),
+                          refcount_ref(elems)));
+    }
+}
+
+DEFUN(vector_length, "vector-length", (LispVal * vec)) {
+    if (VECTORP(vec)) {
+        return make_lisp_integer(((LispVector *) vec)->length);
+    } else if (STRINGP(vec)) {
+        return make_lisp_integer(((LispString *) vec)->length);
+    } else {
+        Fthrow(Qtype_error,
+               const_list(false, 2, const_list(false, 2, Qvectorp, Qstringp),
+                          refcount_ref(vec)));
+    }
+}
+
+DEFUN(aref, "aref", (LispVal * vec, LispVal *index)) {
+    CHECK_TYPE(TYPE_INTEGER, index);
+    int64_t idx = ((LispInteger *) index)->value;
+    if (idx < 0) {
+        Fthrow(Qout_of_bounds_error, const_list(true, 1, index));
+    }
+    if (VECTORP(vec)) {
+        LispVector *v = (LispVector *) vec;
+        if (idx >= v->length) {
+            Fthrow(Qout_of_bounds_error, const_list(true, 1, index));
+        }
+        return refcount_ref(v->data[idx]);
+    } else if (STRINGP(vec)) {
+        LispString *s = (LispString *) vec;
+        if (idx >= s->length) {
+            Fthrow(Qout_of_bounds_error, const_list(true, 1, index));
+        }
+        return make_lisp_integer(s->data[idx]);
+    } else {
+        Fthrow(Qtype_error,
+               const_list(false, 2, const_list(false, 2, Qvectorp, Qstringp),
+                          refcount_ref(vec)));
+    }
+}
+
+DEFUN(aset, "aset", (LispVal * vec, LispVal *index, LispVal *elem)) {
+    CHECK_TYPE(TYPE_INTEGER, index);
+    CHECK_TYPE(TYPE_VECTOR, vec);
+    int64_t idx = ((LispInteger *) index)->value;
+    if (idx < 0) {
+        Fthrow(Qout_of_bounds_error, const_list(true, 1, index));
+    }
+    LispVector *v = (LispVector *) vec;
+    if (idx >= v->length) {
+        Fthrow(Qout_of_bounds_error, const_list(true, 1, index));
+    }
+    refcount_unref(v->data[idx]);
+    v->data[idx] = refcount_ref(elem);
+    return refcount_ref(elem);
+}
+
+DEFUN(subvector, "subvector", (LispVal * seq, LispVal *start, LispVal *end)) {
+    if (!NILP(start)) {
+        CHECK_TYPE(TYPE_INTEGER, start);
+    }
+    if (!NILP(end)) {
+        CHECK_TYPE(TYPE_INTEGER, end);
+    }
+    size_t length;
+    if (VECTORP(seq)) {
+        length = ((LispVector *) seq)->length;
+    } else if (STRINGP(seq)) {
+        length = ((LispString *) seq)->length;
+    } else {
+        Fthrow(Qtype_error,
+               const_list(false, 2, const_list(false, 2, Qstringp, Qvectorp),
+                          seq));
+    }
+    int64_t si = 0;
+    if (!NILP(start)) {
+        si = ((LispInteger *) start)->value;
+        if (si < 0 || si > length) {
+            Fthrow(Qout_of_bounds_error, const_list(true, 1, start));
+        }
+    }
+    int64_t se = 0;
+    if (NILP(end)) {
+        se = length;
+    } else {
+        se = ((LispInteger *) end)->value;
+        if (se < 0 || se > length) {
+            Fthrow(Qout_of_bounds_error, const_list(true, 1, end));
+        } else if (si > se) {
+            Fthrow(Qout_of_bounds_error, const_list(true, 1, start));
+        }
+    }
+    if (VECTORP(seq)) {
+        LispVector *vec = (LispVector *) seq;
+        size_t subsize = se - si;
+        LispVal **subarr = lisp_malloc(sizeof(LispVal *) * subsize);
+        for (size_t i = si, sub_i = 0; i < se; ++i, ++sub_i) {
+            subarr[sub_i] = refcount_ref(vec->data[i]);
+        }
+        return make_lisp_vector(subarr, subsize);
+    } else {
+        LispString *str = (LispString *) seq;
+        size_t subsize = se - si;
+        char *subarr = lisp_malloc(subsize);
+        for (size_t i = si, sub_i = 0; i < se; ++i, ++sub_i) {
+            subarr[sub_i] = str->data[i];
+        }
+        return make_lisp_string(subarr, subsize, true, false);
+    }
+}
+
+// ####################
+// # String Functions #
+// ####################
+DEFUN(stringp, "stringp", (LispVal * val)) {
+    return LISP_BOOL(STRINGP(val));
+}
+
+DEFUN(string, "string", (LispVal * val)) {
+    if (STRINGP(val)) {
+        return refcount_ref(val);
+    } else if (VECTORP(val)) {
+        LispVector *vec = (LispVector *) val;
+        char *new_chars = lisp_malloc(vec->length);
+        void *cl_handler = register_cleanup(&lisp_free, new_chars);
+        for (size_t i = 0; i < vec->length; ++i) {
+            CHECK_TYPE(TYPE_INTEGER, vec->data[i]);
+            LispInteger *elt = (LispInteger *) vec->data[i];
+            if (elt->value < -128 || elt->value > 127) {
+                Fthrow(Qtype_error, Qnil);
+            }
+            new_chars[i] = elt->value;
         }
         cancel_cleanup(cl_handler);
-    });
+        return make_lisp_string(new_chars, vec->length, true, false);
-    return make_lisp_vector(uld.vals, uld.len);
+    } else if (PAIRP(val)) {
+        char *retval;
+        size_t size = 0;
+        WITH_PUSH_FRAME(Qnil, Qnil, true, {
+            char *new_data = NULL;
+            void *cl_handler = register_cleanup(&free_double_ptr, &new_data);
+            FOREACH(elt, val) {
+                CHECK_TYPE(TYPE_INTEGER, elt);
+                LispInteger *i = (LispInteger *) elt;
+                if (i->value < -128 || i->value > 127) {
+                    Fthrow(Qtype_error, Qnil);
+                }
+                new_data = lisp_realloc(new_data, sizeof(char) * ++size);
+                new_data[size - 1] = i->value;
+            }
+            cancel_cleanup(cl_handler);
+            retval = new_data;
+        });
+        return make_lisp_string(retval, size, true, false);
+    } else {
+        Fthrow(Qtype_error,
+               const_list(false, 2,
+                          const_list(false, 3, Qvectorp, Qstringp, Qlistp),
+                          refcount_ref(val)));
+    }
+}
+
+DEFUN(hash_string, "hash-string", (LispVal * obj)) {
+    CHECK_TYPE(TYPE_STRING, obj);
+    const char *str = ((LispString *) obj)->data;
+    uint64_t hash = 5381;
+    int c;
+    while ((c = *(str++))) {
+        hash = ((hash << 5) + hash) + c;
+    }
+    return make_lisp_integer(hash);
+}
+
+DEFUN(strings_equal, "strings-equal", (LispVal * obj1, LispVal *obj2)) {
+    CHECK_TYPE(TYPE_STRING, obj1);
+    CHECK_TYPE(TYPE_STRING, obj2);
+    LispString *str1 = (LispString *) obj1;
+    LispString *str2 = (LispString *) obj2;
+    if (str1->length != str2->length) {
+        return Qnil;
+    }
+    return LISP_BOOL(memcmp(str1->data, str2->data, str1->length) == 0);
+}
+
+DEFUN(string_to_vector, "string-to-vector", (LispVal * str)) {
+    CHECK_TYPE(TYPE_STRING, str);
+    LispString *s = (LispString *) str;
+    LispVal **vdata = lisp_malloc(sizeof(LispVal *) * s->length);
+    for (size_t i = 0; i < s->length; ++i) {
+        vdata[i] = make_lisp_integer(s->data[i]);
+    }
+    return make_lisp_vector(vdata, s->length);
+}
+
+LispVal *sprintf_lisp(const char *format, ...) {
+    va_list args;
+    va_start(args, format);
+    va_list args_measure;
+    va_copy(args_measure, args);
+    int size = vsnprintf(NULL, 0, format, args_measure) + 1;
+    va_end(args_measure);
+    char *buffer = lisp_malloc(size);
+    vsnprintf(buffer, size, format, args);
+    LispVal *obj = make_lisp_string(buffer, size, true, false);
+    va_end(args);
+    return obj;
+}
+
+bool strings_equal_nocase(const char *s1, const char *s2, size_t n) {
+    for (size_t i = 0; i < n; ++i) {
+        if (!s1[i] || !s2[i]) {
+            return !s1[i] && !s2[i];
+        } else if (tolower(s1[i]) != tolower(s2[i])) {
+            return false;
+        }
+    }
+    return true;
 }
 
 // ########################
@@ -2942,6 +3208,7 @@ DEF_STATIC_SYMBOL(return_frame_error, "return-frame-error");
 DEF_STATIC_SYMBOL(package_exists_error, "package-exists-error");
 DEF_STATIC_SYMBOL(import_error, "import-error");
 DEF_STATIC_SYMBOL(unknown_package_error, "unknown-package-error");
+DEF_STATIC_SYMBOL(out_of_bounds_error, "out-of-bounds-error");
 
 // ###################
 // # Debug Functions #
@@ -3119,13 +3386,14 @@ static void register_symbols_and_functions(void) {
     REGISTER_SYMBOL(package_exists_error);
     REGISTER_SYMBOL(import_error);
     REGISTER_SYMBOL(unknown_package_error);
+    REGISTER_SYMBOL(out_of_bounds_error);
 
     // some stuff that musn't be user accesable
     REGISTER_SYMBOL_NOINTERN(toplevel);
     REGISTER_STATIC_FUNCTION(set_for_return, "(entry dest)", "");
     REGISTER_STATIC_FUNCTION(internal_real_return, "(name tag value)", "");
 
-    REGISTER_FUNCTION(make_hashtable, "(&opt hash-fn eq-fn)", "");
+    REGISTER_FUNCTION(make_hash_table, "(&opt hash-fn eq-fn)", "");
     REGISTER_FUNCTION(puthash, "(table key value)", "");
     REGISTER_FUNCTION(gethash, "(table key &opt def)", "");
     REGISTER_FUNCTION(remhash, "(table key)", "");
@@ -3177,7 +3445,10 @@ static void register_symbols_and_functions(void) {
     REGISTER_FUNCTION(read, "(source)",
                       "Read and return the next s-expr from SOURCE.");
     REGISTER_FUNCTION(eq, "(obj1 obj2)",
-                      "Return non-nil if OBJ1 and OBJ2 are equal");
+                      "Return non-nil if OBJ1 and OBJ2 are the same object.");
+    REGISTER_FUNCTION(
+        equal, "(obj1 obj2)",
+        "Return non-nil if OBJE1 and OBJ2 are structurally equal.");
     REGISTER_FUNCTION(make_symbol, "(name)",
                       "Return a new un-interned symbol named NAME.");
     REGISTER_FUNCTION(macroexpand_1, "(form &opt lexical-macros)",
@@ -3187,6 +3458,8 @@ static void register_symbols_and_functions(void) {
     REGISTER_FUNCTION(stringp, "(val)", "Return non-nil if VAL is a string.");
     REGISTER_FUNCTION(symbolp, "(val)", "Return non-nil if VAL is a symbol.");
     REGISTER_FUNCTION(pairp, "(val)", "Return non-nil if VAL is a pair.");
+    REGISTER_FUNCTION(hash_table_p, "(val)",
+                      "Return non-nil if VAL is a hash table.");
     REGISTER_FUNCTION(integerp, "(val)", "Return non-nil if VAL is a integer.");
     REGISTER_FUNCTION(floatp, "(val)", "Return non-nil if VAL is a float.");
     REGISTER_FUNCTION(vectorp, "(val)", "Return non-nil if VAL is a vector.");
@@ -3200,8 +3473,6 @@ static void register_symbols_and_functions(void) {
                       "Return non-nil if VAL is a non-macro builtin.");
     REGISTER_FUNCTION(special_form_p, "(val)",
                       "Return non-nil if VAL is a macro-builtin.");
-    REGISTER_FUNCTION(hashtablep, "(val)",
-                      "Return non-nil if VAL is a hashtable.");
     REGISTER_FUNCTION(user_pointer_p, "(val)",
                       "Return non-nil if VAL is a user pointer.");
     REGISTER_FUNCTION(atom, "(val)", "Return non-nil if VAL is a atom.");
@@ -3244,4 +3515,11 @@ static void register_symbols_and_functions(void) {
     REGISTER_FUNCTION(copy_hash_table, "(table)", "");
     REGISTER_FUNCTION(package_name, "(package)", "");
     REGISTER_FUNCTION(mapsymbols, "(func &opt package)", "");
+    REGISTER_FUNCTION(vector_length, "(vec-or-str)", "");
+    REGISTER_FUNCTION(aref, "(vec-or-str index)", "");
+    REGISTER_FUNCTION(aset, "(vec index elem)", "");
+    REGISTER_FUNCTION(make_vector, "(size &opt initial-element)", "");
+    REGISTER_FUNCTION(string, "(val)", "");
+    REGISTER_FUNCTION(subvector, "(seq &opt start end)", "");
+    REGISTER_FUNCTION(string_to_vector, "(str)", "");
 }

src/lisp.h

@@ -391,6 +391,7 @@ void lisp_shutdown(void);
 noreturn DECLARE_FUNCTION(exit, (LispVal * code));
 DECLARE_FUNCTION(id, (LispVal * obj));
 DECLARE_FUNCTION(eq, (LispVal * obj1, LispVal *obj2));
+DECLARE_FUNCTION(equal, (LispVal * obj1, LispVal *obj2));
 DECLARE_FUNCTION(breakpoint, (LispVal * id));
 DECLARE_FUNCTION(not, (LispVal * obj));
 DECLARE_FUNCTION(type_of, (LispVal * val));
@@ -470,15 +471,6 @@ DECLARE_FUNCTION(plist_set, (LispVal * plist, LispVal *key, LispVal *value,
 DECLARE_FUNCTION(plist_rem, (LispVal * plist, LispVal *key, LispVal *pred));
 DECLARE_FUNCTION(plist_assoc, (LispVal * plist, LispVal *key, LispVal *pred));
 
-// ####################
-// # String Functions #
-// ####################
-DECLARE_FUNCTION(stringp, (LispVal * val));
-DECLARE_FUNCTION(hash_string, (LispVal * obj));
-DECLARE_FUNCTION(strings_equal, (LispVal * obj1, LispVal *obj2));
-LispVal *sprintf_lisp(const char *format, ...) PRINTF_FORMAT(1, 2);
-bool strings_equal_nocase(const char *s1, const char *s2, size_t n);
-
 // #####################
 // # Package Functions #
 // #####################
@@ -517,11 +509,11 @@ DECLARE_FUNCTION(intern,
 LispVal *intern(const char *name, size_t length, bool take, LispVal *package,
                 bool included_too);
 
-// #######################
+// ########################
 // # Hash Table Functions #
-// #######################
+// ########################
-DECLARE_FUNCTION(hashtablep, (LispVal * val));
+DECLARE_FUNCTION(hash_table_p, (LispVal * val));
-DECLARE_FUNCTION(make_hashtable, (LispVal * hash_fn, LispVal *eq_fn));
+DECLARE_FUNCTION(make_hash_table, (LispVal * hash_fn, LispVal *eq_fn));
 DECLARE_FUNCTION(copy_hash_table, (LispVal * table));
 DECLARE_FUNCTION(hash_table_count, (LispVal * table));
 DECLARE_FUNCTION(puthash, (LispVal * table, LispVal *key, LispVal *value));
@@ -552,7 +544,24 @@ DECLARE_FUNCTION(sub, (LispVal * args));
 // # Vector Functions #
 // ####################
 DECLARE_FUNCTION(vectorp, (LispVal * val));
+DECLARE_FUNCTION(make_vector, (LispVal * size, LispVal *initial_elem));
 DECLARE_FUNCTION(vector, (LispVal * elems));
+DECLARE_FUNCTION(vector_length, (LispVal * vec));
+DECLARE_FUNCTION(aref, (LispVal * vec, LispVal *index));
+DECLARE_FUNCTION(aset, (LispVal * vec, LispVal *index, LispVal *elem));
+DECLARE_FUNCTION(subvector, (LispVal * vec, LispVal *start, LispVal *end));
+
+// many vector functions also work on strings
+// ####################
+// # String Functions #
+// ####################
+DECLARE_FUNCTION(stringp, (LispVal * val));
+DECLARE_FUNCTION(string, (LispVal * chars));
+DECLARE_FUNCTION(hash_string, (LispVal * obj));
+DECLARE_FUNCTION(strings_equal, (LispVal * obj1, LispVal *obj2));
+DECLARE_FUNCTION(string_to_vector, (LispVal * str));
+LispVal *sprintf_lisp(const char *format, ...) PRINTF_FORMAT(1, 2);
+bool strings_equal_nocase(const char *s1, const char *s2, size_t n);
 
 // ########################
 // # Lexenv and the Stack #
@@ -670,6 +679,7 @@ extern LispVal *Qreturn_frame_error;
 extern LispVal *Qpackage_exists_error;
 extern LispVal *Qimport_error;
 extern LispVal *Qunknown_package_error;
+extern LispVal *Qout_of_bounds_error;
 
 #define CHECK_TYPE(type, val)                                                 \
     if (TYPEOF(val) != type) {                                                \