mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-02 02:10:19 +02:00
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.
This commit is contained in:
Andy Wingo
parent
67dca3a1f5
commit
134c3be452
9 changed files with 405 additions and 27 deletions
|
|
@ -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 ("#<ephemeron-table ", port);
|
||||
scm_uintprint (SCM_UNPACK (exp), 16, port);
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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 */
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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 ("<input-port>"));
|
||||
class_output_port = scm_variable_ref (scm_c_lookup ("<output-port>"));
|
||||
class_input_output_port = scm_variable_ref (scm_c_lookup ("<input-output-port>"));
|
||||
class_ephemeron = scm_variable_ref (scm_c_lookup ("<ephemeron>"));
|
||||
class_ephemeron_table = scm_variable_ref (scm_c_lookup ("<ephemeron-table>"));
|
||||
|
||||
create_smob_classes ();
|
||||
create_struct_classes ();
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -70,7 +70,7 @@
|
|||
<vector> <bytevector> <uvec> <foreign> <hashtable>
|
||||
<fluid> <dynamic-state> <frame> <vm> <vm-continuation>
|
||||
<keyword> <syntax> <atomic-box> <thread> <bitvector>
|
||||
<finalizer> <ephemeron>
|
||||
<finalizer> <ephemeron> <ephemeron-table>
|
||||
|
||||
;; Numbers.
|
||||
<number> <complex> <real> <integer> <fraction>
|
||||
|
|
@ -1081,6 +1081,7 @@ slots as we go."
|
|||
(define-standard-class <bitvector> (<top>))
|
||||
(define-standard-class <finalizer> (<top>))
|
||||
(define-standard-class <ephemeron> (<top>))
|
||||
(define-standard-class <ephemeron-table> (<top>))
|
||||
(define-standard-class <thread> (<top>))
|
||||
(define-standard-class <number> (<top>))
|
||||
(define-standard-class <complex> (<number>))
|
||||
|
|
|
|||
|
|
@ -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))))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue