diff --git a/lisp/kernel.gl b/lisp/kernel.gl index 5388fe7..5ffe3c7 100644 --- a/lisp/kernel.gl +++ b/lisp/kernel.gl @@ -23,4 +23,8 @@ (princ datum print-char-fun) (funcall (or print-char-fun 'write-byte) ?\n)) -(princln (= 1.0 1)) +(let ((t1 (make-hash-table)) + (t2 (make-hash-table))) + (puthash t1 'a 'b) + (puthash t2 'a 'b) + (princln (equal t1 t2))) diff --git a/src/base.c b/src/base.c index 4626e93..b24080b 100644 --- a/src/base.c +++ b/src/base.c @@ -75,8 +75,7 @@ DEFCONST(most_negative_fixnum, "most-negative-fixnum", "", MAKE_FIXNUM(MOST_NEGATIVE_FIXNUM)); DEFUN(id, "id", (LispVal * obj), "(id)", "") { - // TODO not all values are handled here - return MAKE_FIXNUM((uintptr_t) obj); + return make_number_unsigned((uintptr_t) obj); } DEFUN(eq, "eq", (LispVal * obj1, LispVal *obj2), "(obj1 obj2)", "") { @@ -97,6 +96,76 @@ DEFSPECIAL(function, "function", (LispVal * form), "(form)", "") { return form; } +static LispVal *lists_equal(LispVal *l1, LispVal *l2) { + while (CONSP(l1) && CONSP(l2)) { + if (NILP(Fequal(XCAR(l1), XCAR(l2)))) { + return Qnil; + } + l1 = XCDR(l1); + l2 = XCDR(l2); + } + return Fequal(l1, l2); +} + +static LispVal *hash_tables_equal(LispVal *obj1, LispVal *obj2) { + LispHashTable *t1 = obj1; + LispHashTable *t2 = obj2; + if (t1->count != t2->count) { + return Qnil; + } + HT_FOREACH_INDEX(t1, i) { + LispVal *v1 = HASH_VALUE(t1, i); + LispVal *v2 = Fgethash(t2, HASH_KEY(t1, i), Qunbound); + if (NILP(Fequal(v1, v2))) { + return Qnil; + } + } + return Qt; +} + +DEFUN(equal, "equal", (LispVal * obj1, LispVal *obj2), "(obj1 obj2)", "") { + if (EQ(obj1, obj2)) { + return Qt; + } else if (TYPE_OF(obj1) != TYPE_OF(obj2)) { + return Qnil; + } + switch (TYPE_OF(obj1)) { + case TYPE_SYMBOL: + case TYPE_FUNCTION: + // handled above + return Qnil; + case TYPE_HASH_TABLE: + return hash_tables_equal(obj1, obj2); + case TYPE_FIXNUM: + return XFIXNUM(obj1) == XFIXNUM(obj2) ? Qt : Qnil; + case TYPE_FLOAT: + return XLISP_FLOAT(obj1) == XLISP_FLOAT(obj2) ? Qt : Qnil; + case TYPE_STRING: + return Fstrings_equal(obj1, obj2); + case TYPE_CONS: + return lists_equal(obj1, obj2); + case TYPE_VECTOR: { + LispVector *v1 = obj1; + LispVector *v2 = obj2; + if (v1->length != v2->length) { + return Qnil; + } + for (size_t i = 0; i < v1->length; ++i) { + if (NILP(Fequal(v1->data[i], v2->data[i]))) { + return Qnil; + } + } + return Qt; + } + case TYPE_GMP: + return mpz_cmp(((LispGmp *) obj1)->val, ((LispGmp *) obj2)->val) == 0 + ? Qt + : Qnil; + default: + abort(); + } +} + // ################ // # Constructors # // ################ diff --git a/src/base.h b/src/base.h index be4296b..9805719 100644 --- a/src/base.h +++ b/src/base.h @@ -373,6 +373,8 @@ DECLARE_FUNCTION(eq, (LispVal * obj1, LispVal *obj2)); DECLARE_FUNCTION(quote, (LispVal * form)); DECLARE_FUNCTION(function, (LispVal * form)); +DECLARE_FUNCTION(equal, (LispVal * obj1, LispVal *obj2)); + // TODO probably move these to another file LispVal *make_vector(LispVal **data, size_t length, bool take); DECLARE_FUNCTION(vector, (LispVal * data)); diff --git a/src/hashtable.c b/src/hashtable.c index 520f1ab..ff71c77 100644 --- a/src/hashtable.c +++ b/src/hashtable.c @@ -36,7 +36,7 @@ DEFUN(hash_table_p, "hash-table-p", (LispVal * val), "(val)", "") { } DEFUN(make_hash_table, "make-hash-table", (LispVal * hash_fn, LispVal *eq_fn), - "(hash-fn eq-fn)", "") { + "(&optional hash-fn eq-fn)", "") { LispHashTable *obj = lisp_alloc_object(sizeof(LispHashTable), TYPE_HASH_TABLE); obj->eq_fn = eq_fn; @@ -56,8 +56,12 @@ static uintptr_t hash_key_for_table(LispHashTable *ht, LispVal *key) { return XFIXNUM(Fhash_string(key)); } else { LispVal *hash = CALL(ht->hash_fn, key); - CHECK_TYPE(hash, TYPE_FIXNUM); - return XFIXNUM(hash); + if (LISP_GMP_P(hash)) { + return mpz_get_ui(((LispGmp *) hash)->val); + } else if (FIXNUMP(hash)) { + return XFIXNUM(hash); + } + signal_type_error(hash, Qinteger); } }