core: Add hashq_create_handle_x.
* src/hash.c (hash_create_handle_x): New function. * include/mes/builtins.h: Declare it. * src/builtins.c (mes_builtins): Register it. * tests/hash.test: Add a test. Co-authored-by: Timothy Sample <samplet@ngyro.com>
This commit is contained in:
parent
2296972201
commit
07c90bdebd
|
@ -67,6 +67,7 @@ struct scm *hash (struct scm *x, struct scm *size);
|
|||
struct scm *hashq_get_handle (struct scm *table, struct scm *key);
|
||||
struct scm *hashq_ref_ (struct scm *table, struct scm *key, struct scm *dflt);
|
||||
struct scm *hash_ref_ (struct scm *table, struct scm *key, struct scm *dflt);
|
||||
struct scm *hashq_create_handle_x (struct scm *table, struct scm *key, struct scm *init);
|
||||
struct scm *hashq_set_x (struct scm *table, struct scm *key, struct scm *value);
|
||||
struct scm *hash_set_x (struct scm *table, struct scm *key, struct scm *value);
|
||||
struct scm *hash_table_printer (struct scm *table);
|
||||
|
|
|
@ -177,6 +177,7 @@ mes_builtins (struct scm *a) /*:((internal)) */
|
|||
a = init_builtin (builtin_type, "hashq-get-handle", 2, &hashq_get_handle, a);
|
||||
a = init_builtin (builtin_type, "core:hashq-ref", 3, &hashq_ref_, a);
|
||||
a = init_builtin (builtin_type, "core:hash-ref", 3, &hash_ref_, a);
|
||||
a = init_builtin (builtin_type, "hashq-create-handle!", 3, &hashq_create_handle_x, a);
|
||||
a = init_builtin (builtin_type, "hashq-set!", 3, &hashq_set_x, a);
|
||||
a = init_builtin (builtin_type, "hash-set!", 3, &hash_set_x, a);
|
||||
a = init_builtin (builtin_type, "hash-table-printer", 1, &hash_table_printer, a);
|
||||
|
|
21
src/hash.c
21
src/hash.c
|
@ -1,6 +1,7 @@
|
|||
/* -*-comment-start: "//";comment-end:""-*-
|
||||
* GNU Mes --- Maxwell Equations of Software
|
||||
* Copyright © 2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
* Copyright © 2022 Timothy Sample <samplet@ngyro.com>
|
||||
*
|
||||
* This file is part of GNU Mes.
|
||||
*
|
||||
|
@ -131,6 +132,26 @@ hashq_set_x (struct scm *table, struct scm *key, struct scm *value)
|
|||
return hash_set_x_ (table, hash, key, value);
|
||||
}
|
||||
|
||||
struct scm *
|
||||
hashq_create_handle_x (struct scm *table, struct scm *key, struct scm *init)
|
||||
{
|
||||
struct scm *s = struct_ref_ (table, 3);
|
||||
long size = s->value;
|
||||
unsigned hash = hashq_ (key, size);
|
||||
struct scm *buckets = struct_ref_ (table, 4);
|
||||
struct scm *bucket = vector_ref_ (buckets, hash);
|
||||
if (bucket->type != TPAIR)
|
||||
bucket = cell_nil;
|
||||
struct scm *handle = assq (key, bucket);
|
||||
if (handle == cell_f)
|
||||
{
|
||||
handle = cons (key, init);
|
||||
bucket = cons (handle, bucket);
|
||||
vector_set_x_ (buckets, hash, bucket);
|
||||
}
|
||||
return handle;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
hash_set_x (struct scm *table, struct scm *key, struct scm *value)
|
||||
{
|
||||
|
|
|
@ -98,4 +98,13 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
|
|||
(not (or (hashq-ref t 'k1)
|
||||
(hashq-ref t 'k2)))))
|
||||
|
||||
(pass-if "hashq-create-handle!"
|
||||
(let ((t (make-hash-table)))
|
||||
(hashq-set! t 'k1 'v1)
|
||||
(let ((h1 (hashq-get-handle t 'k1))
|
||||
(h2 (hashq-create-handle! t 'k2 'v2)))
|
||||
(hashq-create-handle! t 'k1 #f)
|
||||
(and (eq? h1 (hashq-get-handle t 'k1))
|
||||
(eq? h2 (hashq-get-handle t 'k2))))))
|
||||
|
||||
(result 'report)
|
||||
|
|
Loading…
Reference in New Issue