andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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:
Jan (janneke) Nieuwenhuizen 2019-11-14 09:14:31 +01:00 committed by Timothy Sample
parent 2296972201
commit 07c90bdebd
4 changed files with 32 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
include/mes/builtins.h
View File

@ -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);

1
src/builtins.c
View File

@ -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
View File

@ -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)
{

9
tests/hash.test
View File

@ -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)