diff --git a/Makefile b/Makefile index a10c3e0e..6b2ce258 100644 --- a/Makefile +++ b/Makefile @@ -141,6 +141,9 @@ test-basic: chibi-scheme$(EXE) test-numbers: all LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ./chibi-scheme$(EXE) tests/numeric-tests.scm +test-hash: all + LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ./chibi-scheme$(EXE) tests/hash-tests.scm + test-match: all LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ./chibi-scheme$(EXE) tests/match-tests.scm diff --git a/lib/srfi/69/hash.c b/lib/srfi/69/hash.c index e5d4c293..9ab056e4 100644 --- a/lib/srfi/69/hash.c +++ b/lib/srfi/69/hash.c @@ -21,6 +21,10 @@ static sexp_uint_t string_hash (char *str, sexp_uint_t bound) { } static sexp sexp_string_hash (sexp ctx, sexp str, sexp bound) { + if (! sexp_stringp(str)) + return sexp_type_exception(ctx, "string-hash: not a string", str); + else if (! sexp_integerp(bound)) + return sexp_type_exception(ctx, "string-hash: not an integer", bound); return sexp_make_fixnum(string_hash(sexp_string_data(str), sexp_unbox_fixnum(bound))); } @@ -32,6 +36,10 @@ static sexp_uint_t string_ci_hash (char *str, sexp_uint_t bound) { } static sexp sexp_string_ci_hash (sexp ctx, sexp str, sexp bound) { + if (! sexp_stringp(str)) + return sexp_type_exception(ctx, "string-ci-hash: not a string", str); + else if (! sexp_integerp(bound)) + return sexp_type_exception(ctx, "string-ci-hash: not an integer", bound); return sexp_make_fixnum(string_ci_hash(sexp_string_data(str), sexp_unbox_fixnum(bound))); } @@ -83,18 +91,21 @@ static sexp_uint_t hash (sexp obj, sexp_uint_t bound) { } static sexp sexp_hash (sexp ctx, sexp obj, sexp bound) { + if (! sexp_exact_integerp(bound)) + return sexp_type_exception(ctx, "hash: not an integer", bound); return sexp_make_fixnum(hash(obj, sexp_unbox_fixnum(bound))); } static sexp sexp_hash_by_identity (sexp ctx, sexp obj, sexp bound) { + if (! sexp_exact_integerp(bound)) + return sexp_type_exception(ctx, "hash-by-identity: not an integer", bound); return sexp_make_fixnum((sexp_uint_t)obj % sexp_unbox_fixnum(bound)); } -static sexp sexp_get_bucket (sexp ctx, sexp ht, sexp obj) { +static sexp sexp_get_bucket (sexp ctx, sexp buckets, sexp hash_fn, sexp obj) { sexp_gc_var1(args); - sexp buckets = sexp_hash_table_buckets(ht), hash_fn, res; + sexp res; sexp_uint_t len = sexp_vector_length(buckets); - hash_fn = sexp_hash_table_hash_fn(ht); if (hash_fn == sexp_make_fixnum(1)) res = sexp_hash_by_identity(ctx, obj, sexp_make_fixnum(len)); else if (hash_fn == sexp_make_fixnum(2)) @@ -150,25 +161,47 @@ static sexp sexp_scan_bucket (sexp ctx, sexp ls, sexp obj, sexp eq_fn) { return res; } -/* static sexp sexp_regrow_hash_table (sexp ctx, sexp ht) { */ -/* } */ +static void sexp_regrow_hash_table (sexp ctx, sexp ht, sexp oldbuckets, sexp hash_fn) { + sexp ls, *oldvec, *newvec; + int i, j, oldsize=sexp_vector_length(oldbuckets), newsize=oldsize*2; + sexp_gc_var1(newbuckets); + sexp_gc_preserve1(ctx, newbuckets); + newbuckets = sexp_make_vector(ctx, sexp_make_fixnum(newsize), SEXP_NULL); + if (newbuckets) { + oldvec = sexp_vector_data(oldbuckets); + newvec = sexp_vector_data(newbuckets); + for (i=0; i