From 6ddf45d68b1c3d520c91d63d9496d1220c4186d6 Mon Sep 17 00:00:00 2001 From: Alexander Rosenberg Date: Mon, 7 Sep 2026 19:27:01 -0700 Subject: [PATCH] Some more functions --- lisp/kernel.gl | 8 +++--- src/base.c | 68 +++++++++++++++++++++++++++++++++++++++++++++++++- src/base.h | 7 ++++++ src/list.c | 9 ------- src/list.h | 1 - 5 files changed, 77 insertions(+), 16 deletions(-) diff --git a/lisp/kernel.gl b/lisp/kernel.gl index 5ffe3c7..cb8b30f 100644 --- a/lisp/kernel.gl +++ b/lisp/kernel.gl @@ -23,8 +23,6 @@ (princ datum print-char-fun) (funcall (or print-char-fun 'write-byte) ?\n)) -(let ((t1 (make-hash-table)) - (t2 (make-hash-table))) - (puthash t1 'a 'b) - (puthash t2 'a 'b) - (princln (equal t1 t2))) +(let ((a [0])) + (aset a 1 'a) + (princln a)) diff --git a/src/base.c b/src/base.c index b24080b..b272d33 100644 --- a/src/base.c +++ b/src/base.c @@ -3,6 +3,7 @@ #include "function.h" #include "gc.h" #include "hashtable.h" +#include "io.h" #include "lisp.h" #include "list.h" #include "stack.h" @@ -166,6 +167,23 @@ DEFUN(equal, "equal", (LispVal * obj1, LispVal *obj2), "(obj1 obj2)", "") { } } +DEFUN(length, "length", (LispVal * seq), "(seq)", "") { + if (LISTP(seq)) { + intptr_t len = list_length(seq); + if (len == -1) { + lisp_signal(Qcircular_list_error, Qnil); + } + return MAKE_FIXNUM(len); + } else if (VECTORP(seq)) { + return MAKE_FIXNUM(((LispVector *) seq)->length); + } else if (STRINGP(seq)) { + return MAKE_FIXNUM(((LispString *) seq)->length); + } else if (HASH_TABLE_P(seq)) { + return MAKE_FIXNUM(((LispHashTable *) seq)->count); + } + signal_type_error(seq, LIST(Qlist, Qvector, Qstring, Qhash_table)); +} + // ################ // # Constructors # // ################ @@ -291,6 +309,51 @@ 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)); } @@ -298,7 +361,7 @@ noreturn void signal_value_constant(LispVal *value) { DEFINE_SYMBOL(fixnum, "fixnum"); DEFINE_SYMBOL(float, "float"); // cons defined in list.c -DEFINE_SYMBOL(string, "strin"); +DEFINE_SYMBOL(string, "string"); DEFINE_SYMBOL(symbol, "symbol"); // vector defined above DEFINE_SYMBOL(hash_table, "hash-table"); @@ -434,6 +497,9 @@ DEFINE_CONDITION_CLASS(type_error, error); DEFINE_SYMBOL(value_constant_error, "value-constant-error"); DEFINE_CONDITION_CLASS(value_constant_error, error); +DEFINE_SYMBOL(out_of_bounds_error, "out-of-bounds-error"); +DEFINE_CONDITION_CLASS(out_of_bounds_error, error); + DEFINE_SYMBOL(backquote, "`"); DEFINE_SYMBOL(comma, ","); DEFINE_SYMBOL(comma_at, ",@"); diff --git a/src/base.h b/src/base.h index 9805719..d8d5f9c 100644 --- a/src/base.h +++ b/src/base.h @@ -374,6 +374,7 @@ DECLARE_FUNCTION(quote, (LispVal * form)); DECLARE_FUNCTION(function, (LispVal * form)); 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); @@ -391,6 +392,9 @@ 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) { @@ -472,6 +476,9 @@ MAKE_CONDITION_CLASS(type_error); DECLARE_SYMBOL(value_constant_error); MAKE_CONDITION_CLASS(value_constant_error); +DECLARE_SYMBOL(out_of_bounds_error); +MAKE_CONDITION_CLASS(out_of_bounds_error); + // Defined in lisp code (eventually) but used in read.c DECLARE_SYMBOL(backquote); DECLARE_SYMBOL(comma); diff --git a/src/list.c b/src/list.c index c2008f5..3f436ea 100644 --- a/src/list.c +++ b/src/list.c @@ -53,15 +53,6 @@ DEFUN(cdr, "cdr", (LispVal * list), "(list)", "") { return NILP(list) ? Qnil : XCDR(list); } -DEFUN(length, "length", (LispVal * list), "(list)", "") { - CHECK_LISTP(list); - intptr_t len = list_length(list); - if (len == -1) { - lisp_signal(Qcircular_list_error, Qnil); - } - return MAKE_FIXNUM(len); -} - DEFUN(length_eq, "length=", (LispVal * list, LispVal *length), "(list length)", "Return non-nil if LIST's length is LENGTH.") { CHECK_LISTP(list); diff --git a/src/list.h b/src/list.h index df5ad7d..0dd66d0 100644 --- a/src/list.h +++ b/src/list.h @@ -125,7 +125,6 @@ DECLARE_FUNCTION(atom, (LispVal * val)); DECLARE_FUNCTION(cons, (LispVal * car, LispVal *cdr)); DECLARE_FUNCTION(car, (LispVal * list)); DECLARE_FUNCTION(cdr, (LispVal * list)); -DECLARE_FUNCTION(length, (LispVal * list)); DECLARE_FUNCTION(length_eq, (LispVal * list, LispVal *length)); DECLARE_FUNCTION(nreverse, (LispVal * list)); DECLARE_FUNCTION(last, (LispVal * list));