diff --git a/src/kernel.sl b/src/kernel.sl index f84fe8d..c2b6116 100644 --- a/src/kernel.sl +++ b/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)))) diff --git a/src/lisp.c b/src/lisp.c index cb7872e..251d0e9 100644 --- a/src/lisp.c +++ b/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 - return Qnil; + LispHashtable *src = (LispHashtable *) table; + 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}; - WITH_PUSH_FRAME(Qnil, Qnil, true, { - void *cl_handler = register_cleanup(&unref_free_list_double_ptr, &uld); - FOREACH(elt, elems) { - uld.vals = lisp_realloc(uld.vals, sizeof(LispVal *) * (++uld.len)); - uld.vals[uld.len - 1] = elt; + if (LISTP(elems)) { + struct UnrefListData uld = {.vals = NULL, .len = 0}; + WITH_PUSH_FRAME(Qnil, Qnil, true, { + void *cl_handler = + register_cleanup(&unref_free_list_double_ptr, &uld); + 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_vector(uld.vals, uld.len); + return make_lisp_string(new_chars, vec->length, true, false); + } 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)", ""); } diff --git a/src/lisp.h b/src/lisp.h index 6933319..3ecbbbb 100644 --- a/src/lisp.h +++ b/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(make_hashtable, (LispVal * hash_fn, LispVal *eq_fn)); +// ######################## +DECLARE_FUNCTION(hash_table_p, (LispVal * val)); +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) { \