From 134c3be4528de0ed178980d33c9bcbca18d72cf0 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 9 May 2025 11:52:42 +0200 Subject: [PATCH] Add ephemeron tables * libguile/ephemerons.h: * libguile/ephemerons.c (scm_c_make_ephemeron): (scm_c_ephemeron_key): (scm_c_ephemeron_value): (scm_c_ephemeron_mark_dead_x): (scm_c_ephemeron_swap_x): (scm_c_ephemeron_next): Add C ephemeron API. (scm_make_ephemeron, scm_ephemeron_key, scm_ephemeron_value) (scm_ephemeron_mark_dead_x): Dispatch to helpers above. (scm_ephemeron_swap_x, scm_ephemeron_mark_dead_x): New Scheme-exposed functions. (scm_c_make_ephemeron_table): (scm_c_ephemeron_table_length): (scm_c_ephemeron_table_ref): (scm_c_ephemeron_table_push_x): (scm_c_ephemeron_table_try_push_x): New C API for tables of ephemerons. (scm_ephemeron_table_length): (scm_ephemeron_table_ref): (scm_ephemeron_table_push_x): (scm_ephemeron_table_try_push_x): New Scheme-exposed API. (scm_c_ephemeron_hash_table_refq): (scm_c_ephemeron_hash_table_setq_x): (scm_c_ephemeron_hash_table_copy): New C API for use by internal weak table users (dynamic states, etc). * module/ice-9/ephemerons.scm: Add new Scheme API. * libguile/evalext.c (scm_self_evaluating_p): * libguile/goops.c (scm_class_of, %goops-early-init): * libguile/print.c (iprin1): * module/oop/goops.scm: * libguile/scm.h (scm_tc7_ephemeron_table): Add new tc7 for ephemeron tables. * test-suite/tests/ephemerons.test ("ephemeron tables"): Add tests. --- libguile/ephemerons.c | 338 ++++++++++++++++++++++++++++--- libguile/ephemerons.h | 34 ++++ libguile/evalext.c | 1 + libguile/goops.c | 5 + libguile/print.c | 3 + libguile/scm.h | 2 +- module/ice-9/ephemerons.scm | 12 +- module/oop/goops.scm | 3 +- test-suite/tests/ephemerons.test | 34 ++++ 9 files changed, 405 insertions(+), 27 deletions(-) diff --git a/libguile/ephemerons.c b/libguile/ephemerons.c index 1eb179bc7..25fc760b2 100644 --- a/libguile/ephemerons.c +++ b/libguile/ephemerons.c @@ -33,6 +33,8 @@ #include "extensions.h" #include "gc-internal.h" #include "gsubr.h" +#include "hash.h" +#include "numbers.h" #include "ports.h" #include "threads.h" #include "version.h" @@ -44,11 +46,6 @@ -#define SCM_EPHEMERON_P(X) (SCM_HAS_TYP7 (X, scm_tc7_ephemeron)) - -#define SCM_VALIDATE_EPHEMERON(pos, x) \ - SCM_MAKE_VALIDATE_MSG (pos, x, EPHEMERON_P, "ephemeron") - static inline SCM ref_to_scm (struct gc_ref ref) { return SCM_PACK (gc_ref_value (ref)); @@ -58,6 +55,67 @@ static inline struct gc_ref scm_to_ref (SCM scm) return gc_ref (SCM_UNPACK (scm)); } + + +struct gc_ephemeron* +scm_c_make_ephemeron (SCM key, SCM val) +{ + struct scm_thread *thread = SCM_I_CURRENT_THREAD; + struct gc_ephemeron *ephemeron = gc_allocate_ephemeron (thread->mutator); + SCM_SET_CELL_WORD_0 (PTR2SCM (ephemeron), scm_tc7_ephemeron); + gc_ephemeron_init (thread->mutator, ephemeron, scm_to_ref (key), + scm_to_ref (val)); + return ephemeron; +} + +static struct gc_ephemeron* +scm_as_ephemeron (SCM x) +{ + return (struct gc_ephemeron*) SCM_UNPACK_POINTER (x); +} + +SCM +scm_c_ephemeron_key (struct gc_ephemeron *e) +{ + struct gc_ref ret = gc_ephemeron_key (e); + return gc_ref_is_null (ret) ? SCM_BOOL_F : ref_to_scm (ret); +} + +SCM +scm_c_ephemeron_value (struct gc_ephemeron *e) +{ + struct gc_ref ret = gc_ephemeron_value (e); + return gc_ref_is_null (ret) ? SCM_BOOL_F : ref_to_scm (ret); +} + +void +scm_c_ephemeron_mark_dead_x (struct gc_ephemeron *e) +{ + gc_ephemeron_mark_dead (e); +} + +SCM +scm_c_ephemeron_swap_x (struct gc_ephemeron *e, SCM new_val) +{ + struct gc_ref ret = + gc_ephemeron_swap_value (SCM_I_CURRENT_THREAD->mutator, e, + scm_to_ref (new_val)); + return gc_ref_is_null (ret) ? SCM_BOOL_F : ref_to_scm (ret); +} + +struct gc_ephemeron* +scm_c_ephemeron_next (struct gc_ephemeron *e) +{ + return gc_ephemeron_chain_next (e); +} + + + +#define SCM_EPHEMERON_P(X) (SCM_HAS_TYP7 (X, scm_tc7_ephemeron)) + +#define SCM_VALIDATE_EPHEMERON(pos, x) \ + SCM_MAKE_VALIDATE_MSG (pos, x, EPHEMERON_P, "ephemeron") + SCM_DEFINE_STATIC (scm_ephemeron_p, "ephemeron?", 1, 0, 0, (SCM x), "Return @code{#t} if @var{x} is an ephemeron, or " @@ -75,14 +133,7 @@ SCM_DEFINE_STATIC (scm_make_ephemeron, "make-ephemeron", 2, 0, 0, #define FUNC_NAME s_scm_make_ephemeron { SCM_MAKE_VALIDATE (1, key, HEAP_OBJECT_P); - - struct scm_thread *thread = SCM_I_CURRENT_THREAD; - struct gc_ephemeron *ephemeron = gc_allocate_ephemeron (thread->mutator); - SCM ret = SCM_PACK_POINTER (ephemeron); - SCM_SET_CELL_WORD_0 (ret, scm_tc7_ephemeron); - gc_ephemeron_init (thread->mutator, ephemeron, scm_to_ref (key), - scm_to_ref (val)); - return ret; + return PTR2SCM (scm_c_make_ephemeron (key, val)); } #undef FUNC_NAME @@ -93,10 +144,7 @@ SCM_DEFINE_STATIC (scm_ephemeron_key, "ephemeron-key", 1, 0, 0, #define FUNC_NAME s_scm_ephemeron_key { SCM_VALIDATE_EPHEMERON (1, ephemeron); - - struct gc_ephemeron *e = (struct gc_ephemeron*) SCM_UNPACK_POINTER (ephemeron); - struct gc_ref ret = gc_ephemeron_key (e); - return gc_ref_is_null (ret) ? SCM_BOOL_F : ref_to_scm (ret); + return scm_c_ephemeron_key (scm_as_ephemeron (ephemeron)); } #undef FUNC_NAME @@ -107,10 +155,18 @@ SCM_DEFINE_STATIC (scm_ephemeron_value, "ephemeron-value", 1, 0, 0, #define FUNC_NAME s_scm_ephemeron_value { SCM_VALIDATE_EPHEMERON (1, ephemeron); + return scm_c_ephemeron_value (scm_as_ephemeron (ephemeron)); +} +#undef FUNC_NAME - struct gc_ephemeron *e = (struct gc_ephemeron*) SCM_UNPACK_POINTER (ephemeron); - struct gc_ref ret = gc_ephemeron_value (e); - return gc_ref_is_null (ret) ? SCM_BOOL_F : ref_to_scm (ret); +SCM_DEFINE_STATIC (scm_ephemeron_swap_x, "ephemeron-swap!", 2, 0, 0, + (SCM ephemeron, SCM new_val), + "Update the value for this ephemeron, and return the " + "previous value.") +#define FUNC_NAME s_scm_ephemeron_swap_x +{ + SCM_VALIDATE_EPHEMERON (1, ephemeron); + return scm_c_ephemeron_swap_x (scm_as_ephemeron (ephemeron), new_val); } #undef FUNC_NAME @@ -120,14 +176,22 @@ SCM_DEFINE_STATIC (scm_ephemeron_mark_dead_x, "ephemeron-mark-dead!", 1, 0, 0, #define FUNC_NAME s_scm_ephemeron_mark_dead_x { SCM_VALIDATE_EPHEMERON (1, ephemeron); - - struct gc_ephemeron *e = (struct gc_ephemeron*) SCM_UNPACK_POINTER (ephemeron); - gc_ephemeron_mark_dead (e); - + scm_c_ephemeron_mark_dead_x (scm_as_ephemeron (ephemeron)); return SCM_UNSPECIFIED; } #undef FUNC_NAME +SCM_DEFINE_STATIC (scm_ephemeron_next, "ephemeron-next", 1, 0, 0, + (SCM ephemeron), + "Return the next ephemeron in a chain, or @code{#f} if none.") +#define FUNC_NAME s_scm_ephemeron_next +{ + SCM_VALIDATE_EPHEMERON (1, ephemeron); + struct gc_ephemeron *e = scm_c_ephemeron_next (scm_as_ephemeron (ephemeron)); + return e ? PTR2SCM (e) : SCM_BOOL_F; +} +#undef FUNC_NAME + int scm_i_print_ephemeron (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) { @@ -138,6 +202,232 @@ scm_i_print_ephemeron (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) } + + +#define SCM_EPHEMERON_TABLE_P(X) (SCM_HAS_TYP7 (X, scm_tc7_ephemeron_table)) +#define SCM_VALIDATE_EPHEMERON_TABLE(pos, x) \ + SCM_MAKE_VALIDATE_MSG (pos, x, EPHEMERON_TABLE_P, "ephemeron table") + +static struct scm_ephemeron_table* +scm_as_ephemeron_table (SCM x) +{ + return (struct scm_ephemeron_table*) SCM_UNPACK_POINTER (x); +} + +struct scm_ephemeron_table +{ + scm_t_bits tag; + size_t size; + struct gc_ephemeron *contents[]; +}; + +struct scm_ephemeron_table* +scm_c_make_ephemeron_table (size_t size) +{ + size_t byte_size = sizeof (struct scm_ephemeron_table); + byte_size += sizeof (struct gc_ephemeron*) * size; + struct scm_ephemeron_table *table = scm_gc_malloc (byte_size, NULL); + table->tag = scm_tc7_ephemeron_table; + table->size = size; + return table; +} + +size_t +scm_c_ephemeron_table_length (struct scm_ephemeron_table *et) +{ + return et->size; +} + +struct gc_ephemeron* +scm_c_ephemeron_table_ref (struct scm_ephemeron_table *et, size_t idx) +{ + if (idx >= et->size) + abort(); + + return gc_ephemeron_chain_head (&et->contents[idx]); +} + +void +scm_c_ephemeron_table_push_x (struct scm_ephemeron_table *et, size_t idx, + struct gc_ephemeron *e) +{ + if (idx >= et->size) + abort(); + + gc_ephemeron_chain_push (&et->contents[idx], e); +} + +struct gc_ephemeron* +scm_c_ephemeron_table_try_push_x (struct scm_ephemeron_table *et, size_t idx, + struct gc_ephemeron *e, + struct gc_ephemeron *prev) +{ + if (idx >= et->size) + abort(); + + gc_ephemeron_chain_try_push (&et->contents[idx], e, &prev); + + return prev; +} + +SCM_DEFINE_STATIC (scm_ephemeron_table_p, "ephemeron-table?", 1, 0, 0, + (SCM x), + "Return @code{#t} if @var{x} is an ephemeron table, or " + "@code{#f} otherwise.") +#define FUNC_NAME s_scm_ephemeron_table_p +{ + return scm_from_bool (SCM_EPHEMERON_TABLE_P (x)); +} +#undef FUNC_NAME + +SCM_DEFINE_STATIC (scm_make_ephemeron_table, "make-ephemeron-table", 1, 0, 0, + (SCM size), + "Make an ephemeron table of size @var{size}.") +#define FUNC_NAME s_scm_make_ephemeron_table +{ + return PTR2SCM (scm_c_make_ephemeron_table (scm_to_size_t (size))); +} +#undef FUNC_NAME + +SCM_DEFINE_STATIC (scm_ephemeron_table_length, "ephemeron-table-length", 1, 0, 0, + (SCM et), + "Return the length of the ephemeron table @var{et}.") +#define FUNC_NAME s_scm_ephemeron_table_length +{ + SCM_VALIDATE_EPHEMERON_TABLE (1, et); + + return scm_from_size_t + (scm_c_ephemeron_table_length (scm_as_ephemeron_table (et))); +} +#undef FUNC_NAME + +SCM_DEFINE_STATIC (scm_ephemeron_table_ref, "ephemeron-table-ref", 2, 0, 0, + (SCM et, SCM idx), + "Return the ephemeron in slot @var{idx} of the ephemeron " + "table @var{et}, or @code{#f} if the slot is empty.") +#define FUNC_NAME s_scm_ephemeron_table_ref +{ + SCM_VALIDATE_EPHEMERON_TABLE (1, et); + SCM_ASSERT_RANGE (2, idx, + scm_to_size_t (idx) < scm_as_ephemeron_table (et)->size); + struct gc_ephemeron *ret = + scm_c_ephemeron_table_ref (scm_as_ephemeron_table (et), + scm_to_size_t (idx)); + return ret ? PTR2SCM (ret) : SCM_BOOL_F; +} +#undef FUNC_NAME + +SCM_DEFINE_STATIC (scm_ephemeron_table_push_x, "ephemeron-table-push!", 3, 0, 0, + (SCM et, SCM idx, SCM e), + "Push the ephemeron @var{e} onto slot @var{idx} of the " + "ephemeron table @var{et}.") +#define FUNC_NAME s_scm_ephemeron_table_push_x +{ + SCM_VALIDATE_EPHEMERON_TABLE (1, et); + SCM_ASSERT_RANGE (2, idx, + scm_to_size_t (idx) < scm_as_ephemeron_table (et)->size); + SCM_VALIDATE_EPHEMERON (3, e); + scm_c_ephemeron_table_push_x (scm_as_ephemeron_table (et), + scm_to_size_t (idx), scm_as_ephemeron (e)); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + +SCM_DEFINE_STATIC (scm_ephemeron_table_try_push_x, "ephemeron-table-try-push!", + 4, 0, 0, (SCM et, SCM idx, SCM e, SCM tail), + "Push the ephemeron @var{e} onto slot @var{idx} of the " + "ephemeron table @var{et}, whose current value is " + "@var{tail}. On success, return @var{tail}. On failure, " + "return the value of slot @var{idx}.") +#define FUNC_NAME s_scm_ephemeron_table_try_push_x +{ + SCM_VALIDATE_EPHEMERON_TABLE (1, et); + SCM_ASSERT_RANGE (2, idx, + scm_to_size_t (idx) < scm_as_ephemeron_table (et)->size); + SCM_VALIDATE_EPHEMERON (3, e); + struct gc_ephemeron *expected = NULL; + if (!scm_is_eq (tail, SCM_BOOL_F)) + { + SCM_VALIDATE_EPHEMERON (4, tail); + expected = scm_as_ephemeron (tail); + } + struct gc_ephemeron *res = + scm_c_ephemeron_table_try_push_x (scm_as_ephemeron_table (et), + scm_to_size_t (idx), + scm_as_ephemeron (e), + expected); + return res ? PTR2SCM (res) : SCM_BOOL_F; +} +#undef FUNC_NAME + +int +scm_i_print_ephemeron_table (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) +{ + scm_puts ("#", port); + return 1; +} + + + + +SCM +scm_c_ephemeron_hash_table_refq (struct scm_ephemeron_table *et, SCM key, + SCM default_value) +{ + size_t idx = scm_ihashq (key, et->size); + + for (struct gc_ephemeron *e = scm_c_ephemeron_table_ref (et, idx); + e; + e = scm_c_ephemeron_next (e)) + if (scm_is_eq (key, scm_c_ephemeron_key (e))) + return scm_c_ephemeron_value (e); + + return default_value; +} + +void +scm_c_ephemeron_hash_table_setq_x (struct scm_ephemeron_table *et, SCM key, + SCM value) +{ + size_t idx = scm_ihashq (key, et->size); + + struct gc_ephemeron *prev = scm_c_ephemeron_table_ref (et, idx); + struct gc_ephemeron *chain; + do + { + chain = prev; + for (struct gc_ephemeron *e = chain; e; e = scm_c_ephemeron_next (e)) + if (scm_is_eq (key, scm_c_ephemeron_key (e))) + { + scm_c_ephemeron_swap_x (e, value); + return; + } + struct gc_ephemeron *new_head = scm_c_make_ephemeron (key, value); + prev = scm_c_ephemeron_table_try_push_x (et, idx, new_head, chain); + } while (prev != chain); +} + +struct scm_ephemeron_table* +scm_c_ephemeron_hash_table_copy (struct scm_ephemeron_table *et) +{ + struct scm_ephemeron_table *ret = scm_c_make_ephemeron_table (et->size); + + for (size_t idx = 0; idx < ret->size; idx++) + for (struct gc_ephemeron *e = scm_c_ephemeron_table_ref (et, idx); + e; + e = scm_c_ephemeron_next (e)) + { + SCM key = scm_c_ephemeron_key (e); + SCM value = scm_c_ephemeron_value (e); + struct gc_ephemeron *copy = scm_c_make_ephemeron (key, value); + scm_c_ephemeron_table_push_x (ret, idx, copy); + } + + return ret; +} + static void diff --git a/libguile/ephemerons.h b/libguile/ephemerons.h index 4829ffd2e..d3f403a70 100644 --- a/libguile/ephemerons.h +++ b/libguile/ephemerons.h @@ -25,8 +25,42 @@ +struct gc_ephemeron; +struct scm_ephemeron_table; + +SCM_INTERNAL struct gc_ephemeron* scm_c_make_ephemeron (SCM k, SCM v); +SCM_INTERNAL SCM scm_c_ephemeron_key (struct gc_ephemeron *e); +SCM_INTERNAL SCM scm_c_ephemeron_value (struct gc_ephemeron *e); +SCM_INTERNAL struct gc_ephemeron* scm_c_ephemeron_next (struct gc_ephemeron *e); +SCM_INTERNAL SCM scm_c_ephemeron_swap_x (struct gc_ephemeron *e, SCM new_val); +SCM_INTERNAL void scm_c_ephemeron_mark_dead_x (struct gc_ephemeron *e); SCM_INTERNAL int scm_i_print_ephemeron (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED); + +SCM_INTERNAL struct scm_ephemeron_table* scm_c_make_ephemeron_table (size_t count); +SCM_INTERNAL size_t scm_c_ephemeron_table_length (struct scm_ephemeron_table *et); +SCM_INTERNAL struct gc_ephemeron* +scm_c_ephemeron_table_ref (struct scm_ephemeron_table *et, size_t idx); +SCM_INTERNAL void scm_c_ephemeron_table_push_x (struct scm_ephemeron_table *et, + size_t idx, + struct gc_ephemeron * e); +SCM_INTERNAL struct gc_ephemeron* +scm_c_ephemeron_table_try_push_x (struct scm_ephemeron_table *et, + size_t idx, + struct gc_ephemeron * e, + struct gc_ephemeron *prev); +SCM_INTERNAL int scm_i_print_ephemeron_table (SCM exp, SCM port, + scm_print_state *pstate SCM_UNUSED); + +SCM_INTERNAL SCM +scm_c_ephemeron_hash_table_refq (struct scm_ephemeron_table *et, SCM k, + SCM default_value); +SCM_INTERNAL void +scm_c_ephemeron_hash_table_setq_x (struct scm_ephemeron_table *et, SCM k, SCM v); +SCM_INTERNAL struct scm_ephemeron_table* +scm_c_ephemeron_hash_table_copy (struct scm_ephemeron_table *et); + + SCM_INTERNAL void scm_register_ephemerons (void); #endif /* SCM_EPHEMERONS_H */ diff --git a/libguile/evalext.c b/libguile/evalext.c index 779d93c1d..418b32261 100644 --- a/libguile/evalext.c +++ b/libguile/evalext.c @@ -96,6 +96,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0, case scm_tc7_bitvector: case scm_tc7_finalizer: case scm_tc7_ephemeron: + case scm_tc7_ephemeron_table: case scm_tc7_thread: case scm_tcs_struct: return SCM_BOOL_T; diff --git a/libguile/goops.c b/libguile/goops.c index 2f1dc7e5c..c27a54357 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -136,6 +136,7 @@ static SCM class_thread; static SCM class_bitvector; static SCM class_finalizer; static SCM class_ephemeron; +static SCM class_ephemeron_table; static SCM vtable_class_map = SCM_BOOL_F; @@ -262,6 +263,8 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0, return class_finalizer; case scm_tc7_ephemeron: return class_ephemeron; + case scm_tc7_ephemeron_table: + return class_ephemeron_table; case scm_tc7_thread: return class_thread; case scm_tc7_string: @@ -958,6 +961,8 @@ SCM_DEFINE (scm_sys_goops_early_init, "%goops-early-init", 0, 0, 0, class_input_port = scm_variable_ref (scm_c_lookup ("")); class_output_port = scm_variable_ref (scm_c_lookup ("")); class_input_output_port = scm_variable_ref (scm_c_lookup ("")); + class_ephemeron = scm_variable_ref (scm_c_lookup ("")); + class_ephemeron_table = scm_variable_ref (scm_c_lookup ("")); create_smob_classes (); create_struct_classes (); diff --git a/libguile/print.c b/libguile/print.c index 17153ba8f..cd6e811e5 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -767,6 +767,9 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate) case scm_tc7_ephemeron: scm_i_print_ephemeron (exp, port, pstate); break; + case scm_tc7_ephemeron_table: + scm_i_print_ephemeron_table (exp, port, pstate); + break; case scm_tc7_thread: scm_i_print_thread (exp, port, pstate); break; diff --git a/libguile/scm.h b/libguile/scm.h index 97b38d61c..6408bfeb7 100644 --- a/libguile/scm.h +++ b/libguile/scm.h @@ -477,7 +477,7 @@ typedef uintptr_t scm_t_bits; #define scm_tc7_symbol 0x05 #define scm_tc7_variable 0x07 #define scm_tc7_vector 0x0d -#define scm_tc7_unused_0f 0x0f +#define scm_tc7_ephemeron_table 0x0f #define scm_tc7_string 0x15 #define scm_tc7_number 0x17 #define scm_tc7_hashtable 0x1d diff --git a/module/ice-9/ephemerons.scm b/module/ice-9/ephemerons.scm index a48b4127f..a15062f9a 100644 --- a/module/ice-9/ephemerons.scm +++ b/module/ice-9/ephemerons.scm @@ -25,7 +25,17 @@ make-ephemeron ephemeron-key ephemeron-value - ephemeron-mark-dead!)) + ephemeron-swap! + ephemeron-mark-dead! + ephemeron-next + + make-ephemeron-table + ephemeron-table? + ephemeron-table-length + + ephemeron-table-ref + ephemeron-table-push! + ephemeron-table-try-push!)) (eval-when (expand load eval) (load-extension (string-append "libguile-" (effective-version)) diff --git a/module/oop/goops.scm b/module/oop/goops.scm index 34888f7b5..19eb7362b 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -70,7 +70,7 @@ - + ;; Numbers. @@ -1081,6 +1081,7 @@ slots as we go." (define-standard-class ()) (define-standard-class ()) (define-standard-class ()) +(define-standard-class ()) (define-standard-class ()) (define-standard-class ()) (define-standard-class ()) diff --git a/test-suite/tests/ephemerons.test b/test-suite/tests/ephemerons.test index af8108a59..fa08c2448 100644 --- a/test-suite/tests/ephemerons.test +++ b/test-suite/tests/ephemerons.test @@ -44,8 +44,42 @@ (pass-if (ephemeron? e)) (pass-if (eq? x (ephemeron-key e))) (pass-if-equal 100 (ephemeron-value e)) + (pass-if-equal 100 (ephemeron-swap! e 'qux)) + (pass-if-equal 'qux (ephemeron-value e)) (ephemeron-mark-dead! e) (pass-if (ephemeron? e)) (pass-if-equal #f (ephemeron-key e)) (pass-if-equal #f (ephemeron-value e)))) + +(with-test-prefix "ephemeron tables" + + (define et (make-ephemeron-table 47)) + (pass-if (ephemeron-table? et)) + + (define keys (map list (iota 47))) + + (for-each (lambda (idx) + (pass-if (not (ephemeron-table-ref et idx)))) + (iota 47)) + (for-each (lambda (idx key) + (ephemeron-table-push! et idx (make-ephemeron key #t))) + (iota 47) keys) + (for-each (lambda (idx) + (define head (ephemeron-table-ref et idx)) + (pass-if (ephemeron? head)) + (pass-if-equal (list idx) (ephemeron-key head)) + (pass-if (ephemeron-value head)) + (pass-if (not (ephemeron-next head)))) + (iota 47)) + + (define prev (ephemeron-table-ref et 42)) + (pass-if-equal prev + (ephemeron-table-try-push! et 42 (make-ephemeron 'hey 'qux) #f)) + (pass-if-equal prev + (ephemeron-table-try-push! et 42 (make-ephemeron 'hey 'qux) prev)) + (pass-if-equal 'hey (ephemeron-key (ephemeron-table-ref et 42))) + (pass-if-equal prev (ephemeron-next (ephemeron-table-ref et 42))) + (pass-if-equal (list 42) + (ephemeron-key (ephemeron-next (ephemeron-table-ref et 42)))) + (pass-if (not (ephemeron-next (ephemeron-next (ephemeron-table-ref et 42))))))