mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-02 18:26:20 +02:00
Reimplement weak vectors in Scheme using ephemerons
* module/ice-9/weak-vector.scm: New implementation, same interface. * doc/ref/api-memory.texi (Weak vectors): Default weak vector value was documented as empty list when it was actually unspecified, but #f is most useful, so we change documentation and code to match. * libguile/Makefile.am (libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES): (DOT_X_FILES): (DOT_DOC_FILES): (noinst_HEADERS): (modinclude_HEADERS): * libguile.h: * libguile/deprecated.c: * libguile/deprecated.h: * libguile/init.c: * libguile/weak-vector.c: * libguile/weak-vector.h: Remove C weak vector implementation, replaced with deprecation stubs that call out to Scheme. * libguile/weak-set.c: * libguile/weak-table.c: * libguile/weak-list.h: Remove unused internal header. * libguile/eq.c: * libguile/evalext.c: * libguile/goops.c: * libguile/hash.c: * libguile/scm.h: * module/system/base/types.scm: * module/system/base/types/internal.scm: * module/system/vm/assembler.scm: Remove wvect tc7.
This commit is contained in:
Andy Wingo
parent
96589bd303
commit
c63f9101f8
22 changed files with 199 additions and 438 deletions
|
|
@ -316,10 +316,9 @@ nor a weak value hash table.
|
|||
|
||||
@deffn {Scheme Procedure} make-weak-vector size [fill]
|
||||
@deffnx {C Function} scm_make_weak_vector (size, fill)
|
||||
Return a weak vector with @var{size} elements. If the optional
|
||||
argument @var{fill} is given, all entries in the vector will be
|
||||
set to @var{fill}. The default value for @var{fill} is the
|
||||
empty list.
|
||||
Return a weak vector with @var{size} elements. If the optional argument
|
||||
@var{fill} is given, all entries in the vector will be set to
|
||||
@var{fill}. The default value for @var{fill} is @code{#f}.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} weak-vector elem @dots{}
|
||||
|
|
|
|||
|
|
@ -117,7 +117,6 @@ extern "C" {
|
|||
#include "libguile/vports.h"
|
||||
#include "libguile/weak-set.h"
|
||||
#include "libguile/weak-table.h"
|
||||
#include "libguile/weak-vector.h"
|
||||
#include "libguile/backtrace.h"
|
||||
#include "libguile/debug.h"
|
||||
#include "libguile/stacks.h"
|
||||
|
|
|
|||
|
|
@ -240,8 +240,7 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \
|
|||
vm.c \
|
||||
vports.c \
|
||||
weak-set.c \
|
||||
weak-table.c \
|
||||
weak-vector.c
|
||||
weak-table.c
|
||||
|
||||
if ENABLE_JIT
|
||||
libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES += $(lightening_c_files)
|
||||
|
|
@ -353,8 +352,7 @@ DOT_X_FILES = \
|
|||
version.x \
|
||||
vm.x \
|
||||
weak-set.x \
|
||||
weak-table.x \
|
||||
weak-vector.x
|
||||
weak-table.x
|
||||
|
||||
EXTRA_DOT_X_FILES = @EXTRA_DOT_X_FILES@
|
||||
|
||||
|
|
@ -454,8 +452,7 @@ DOT_DOC_FILES = \
|
|||
version.doc \
|
||||
vports.doc \
|
||||
weak-set.doc \
|
||||
weak-table.doc \
|
||||
weak-vector.doc
|
||||
weak-table.doc
|
||||
|
||||
EXTRA_DOT_DOC_FILES = @EXTRA_DOT_DOC_FILES@
|
||||
|
||||
|
|
@ -547,7 +544,6 @@ noinst_HEADERS = custom-ports.h \
|
|||
ports-internal.h \
|
||||
syntax.h \
|
||||
trace.h \
|
||||
weak-list.h \
|
||||
whippet-embedder.h
|
||||
|
||||
# vm instructions
|
||||
|
|
@ -719,8 +715,7 @@ modinclude_HEADERS = \
|
|||
vm.h \
|
||||
vports.h \
|
||||
weak-set.h \
|
||||
weak-table.h \
|
||||
weak-vector.h
|
||||
weak-table.h
|
||||
|
||||
nodist_modinclude_HEADERS = version.h scmconfig.h
|
||||
|
||||
|
|
|
|||
|
|
@ -27,6 +27,7 @@
|
|||
#include "eval.h"
|
||||
#include "gsubr.h"
|
||||
#include "modules.h"
|
||||
#include "numbers.h"
|
||||
#include "threads.h"
|
||||
#include "variable.h"
|
||||
|
||||
|
|
@ -60,6 +61,116 @@ scm_make_guardian (void)
|
|||
|
||||
|
||||
|
||||
static SCM make_weak_vector_var;
|
||||
static SCM weak_vector_var;
|
||||
static SCM weak_vector_p_var;
|
||||
static SCM weak_vector_length_var;
|
||||
static SCM weak_vector_ref_var;
|
||||
static SCM weak_vector_set_x_var;
|
||||
|
||||
static void
|
||||
init_weak_vector_vars (void)
|
||||
{
|
||||
make_weak_vector_var =
|
||||
scm_c_public_lookup ("ice-9 weak-vector", "make-weak-vector");
|
||||
weak_vector_var =
|
||||
scm_c_public_lookup ("ice-9 weak-vector", "weak-vector");
|
||||
weak_vector_p_var =
|
||||
scm_c_public_lookup ("ice-9 weak-vector", "weak-vector?");
|
||||
weak_vector_length_var =
|
||||
scm_c_public_lookup ("ice-9 weak-vector", "weak-vector-length");
|
||||
weak_vector_ref_var =
|
||||
scm_c_public_lookup ("ice-9 weak-vector", "weak-vector-ref");
|
||||
weak_vector_set_x_var =
|
||||
scm_c_public_lookup ("ice-9 weak-vector", "weak-vector-set!");
|
||||
}
|
||||
|
||||
static void
|
||||
init_weak_vectors (void)
|
||||
{
|
||||
static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
|
||||
scm_c_issue_deprecation_warning
|
||||
("The weak vector C interface is deprecated. Invoke the Scheme "
|
||||
"procedures from (ice-9 weak-vector) instead.");
|
||||
scm_i_pthread_once (&once, init_weak_vector_vars);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_make_weak_vector (SCM len, SCM fill)
|
||||
{
|
||||
init_weak_vectors ();
|
||||
return scm_call_2 (scm_variable_ref (make_weak_vector_var), len,
|
||||
SCM_UNBNDP (fill) ? SCM_BOOL_F : fill);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_weak_vector (SCM l)
|
||||
{
|
||||
init_weak_vectors ();
|
||||
return scm_call_1 (scm_variable_ref (weak_vector_var), l);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_weak_vector_p (SCM x)
|
||||
{
|
||||
init_weak_vectors ();
|
||||
return scm_call_1 (scm_variable_ref (weak_vector_p_var), x);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_weak_vector_length (SCM v)
|
||||
{
|
||||
init_weak_vectors ();
|
||||
return scm_call_1 (scm_variable_ref (weak_vector_length_var), v);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_weak_vector_ref (SCM v, SCM k)
|
||||
{
|
||||
init_weak_vectors ();
|
||||
return scm_call_2 (scm_variable_ref (weak_vector_ref_var), v, k);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_weak_vector_set_x (SCM v, SCM k, SCM x)
|
||||
{
|
||||
init_weak_vectors ();
|
||||
scm_call_3 (scm_variable_ref (weak_vector_set_x_var), v, k, x);
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_c_make_weak_vector (size_t len, SCM fill)
|
||||
{
|
||||
return scm_make_weak_vector (scm_from_size_t (len), fill);
|
||||
}
|
||||
|
||||
int
|
||||
scm_is_weak_vector (SCM obj)
|
||||
{
|
||||
return scm_is_true (scm_weak_vector_p (obj));
|
||||
}
|
||||
|
||||
size_t
|
||||
scm_c_weak_vector_length (SCM vec)
|
||||
{
|
||||
return scm_to_size_t (scm_weak_vector_length (vec));
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_c_weak_vector_ref (SCM v, size_t k)
|
||||
{
|
||||
return scm_weak_vector_ref (v, scm_from_size_t (k));
|
||||
}
|
||||
|
||||
void
|
||||
scm_c_weak_vector_set_x (SCM v, size_t k, SCM x)
|
||||
{
|
||||
scm_weak_vector_set_x (v, scm_from_size_t (k), x);
|
||||
}
|
||||
|
||||
|
||||
|
||||
void
|
||||
scm_i_init_deprecated ()
|
||||
{
|
||||
|
|
|
|||
|
|
@ -25,6 +25,22 @@
|
|||
#if (SCM_ENABLE_DEPRECATED == 1)
|
||||
|
||||
SCM_DEPRECATED SCM scm_make_guardian (void);
|
||||
|
||||
#define SCM_I_WVECTP(x) (scm_is_weak_vector (x))
|
||||
|
||||
SCM_DEPRECATED SCM scm_make_weak_vector (SCM len, SCM fill);
|
||||
SCM_DEPRECATED SCM scm_weak_vector (SCM l);
|
||||
SCM_DEPRECATED SCM scm_weak_vector_p (SCM x);
|
||||
SCM_DEPRECATED SCM scm_weak_vector_length (SCM v);
|
||||
SCM_DEPRECATED SCM scm_weak_vector_ref (SCM v, SCM k);
|
||||
SCM_DEPRECATED SCM scm_weak_vector_set_x (SCM v, SCM k, SCM x);
|
||||
|
||||
SCM_DEPRECATED SCM scm_c_make_weak_vector (size_t len, SCM fill);
|
||||
SCM_DEPRECATED int scm_is_weak_vector (SCM obj);
|
||||
SCM_DEPRECATED size_t scm_c_weak_vector_length (SCM vec);
|
||||
SCM_DEPRECATED SCM scm_c_weak_vector_ref (SCM v, size_t k);
|
||||
SCM_DEPRECATED void scm_c_weak_vector_set_x (SCM v, size_t k, SCM x);
|
||||
|
||||
/* Deprecated declarations go here. */
|
||||
|
||||
void scm_i_init_deprecated (void);
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright 1995-1998,2000-2001,2003-2004,2006,2009-2011,2017-2018,2022
|
||||
/* Copyright 1995-1998,2000-2001,2003-2004,2006,2009-2011,2017-2018,2022,2025
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
|
@ -371,7 +371,6 @@ scm_equal_p (SCM x, SCM y)
|
|||
case scm_tc7_bitvector:
|
||||
return scm_i_bitvector_equal_p (x, y);
|
||||
case scm_tc7_vector:
|
||||
case scm_tc7_wvect:
|
||||
return scm_i_vector_equal_p (x, y);
|
||||
case scm_tc7_syntax:
|
||||
if (scm_is_false (scm_equal_p (scm_syntax_wrap (x),
|
||||
|
|
|
|||
|
|
@ -77,7 +77,6 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
|
|||
switch (SCM_TYP7 (obj))
|
||||
{
|
||||
case scm_tc7_vector:
|
||||
case scm_tc7_wvect:
|
||||
case scm_tc7_pointer:
|
||||
case scm_tc7_hashtable:
|
||||
case scm_tc7_weak_set:
|
||||
|
|
|
|||
|
|
@ -230,7 +230,6 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
|
|||
case scm_tc7_symbol:
|
||||
return class_symbol;
|
||||
case scm_tc7_vector:
|
||||
case scm_tc7_wvect:
|
||||
return class_vector;
|
||||
case scm_tc7_pointer:
|
||||
return class_foreign;
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright 1995-1997,2000-2001,2003-2004,2006,2008-2015,2017-2018,2020,2023
|
||||
/* Copyright 1995-1997,2000-2001,2003-2004,2006,2008-2015,2017-2018,2020,2023,2025
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
|
@ -317,7 +317,6 @@ scm_raw_ihash (SCM obj, size_t depth)
|
|||
return SCM_I_KEYWORD_HASH (obj);
|
||||
case scm_tc7_pointer:
|
||||
return scm_raw_ihashq ((uintptr_t) SCM_POINTER_VALUE (obj));
|
||||
case scm_tc7_wvect:
|
||||
case scm_tc7_vector:
|
||||
{
|
||||
size_t len = SCM_SIMPLE_VECTOR_LENGTH (obj);
|
||||
|
|
|
|||
|
|
@ -149,7 +149,6 @@
|
|||
#include "vm.h"
|
||||
#include "weak-set.h"
|
||||
#include "weak-table.h"
|
||||
#include "weak-vector.h"
|
||||
|
||||
#include "init.h"
|
||||
|
||||
|
|
@ -460,7 +459,6 @@ scm_i_init_guile (struct gc_stack_addr base)
|
|||
scm_init_version ();
|
||||
scm_init_weak_set ();
|
||||
scm_init_weak_table ();
|
||||
scm_init_weak_vectors ();
|
||||
scm_init_standard_ports (); /* Requires fports */
|
||||
scm_init_expand (); /* Requires structs */
|
||||
scm_init_memoize (); /* Requires smob_prehistory */
|
||||
|
|
|
|||
|
|
@ -70,7 +70,6 @@
|
|||
#include "vm.h"
|
||||
#include "weak-set.h"
|
||||
#include "weak-table.h"
|
||||
#include "weak-vector.h"
|
||||
|
||||
#include "print.h"
|
||||
|
||||
|
|
@ -564,8 +563,8 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
|
|||
}
|
||||
|
||||
static void
|
||||
print_vector_or_weak_vector (SCM v, size_t len, SCM (*ref) (SCM, size_t),
|
||||
SCM port, scm_print_state *pstate)
|
||||
print_vector (SCM v, size_t len, SCM (*ref) (SCM, size_t),
|
||||
SCM port, scm_print_state *pstate)
|
||||
{
|
||||
long i;
|
||||
long last = len - 1;
|
||||
|
|
@ -710,8 +709,8 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
|
|||
break;
|
||||
case scm_tc7_values:
|
||||
scm_puts ("#<values (", port);
|
||||
print_vector_or_weak_vector (exp, scm_i_nvalues (exp),
|
||||
scm_c_value_ref, port, pstate);
|
||||
print_vector (exp, scm_i_nvalues (exp), scm_c_value_ref, port,
|
||||
pstate);
|
||||
scm_puts (">", port);
|
||||
break;
|
||||
case scm_tc7_program:
|
||||
|
|
@ -771,18 +770,11 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
|
|||
case scm_tc7_thread:
|
||||
scm_i_print_thread (exp, port, pstate);
|
||||
break;
|
||||
case scm_tc7_wvect:
|
||||
ENTER_NESTED_DATA (pstate, exp, circref);
|
||||
scm_puts ("#w(", port);
|
||||
print_vector_or_weak_vector (exp, scm_c_weak_vector_length (exp),
|
||||
scm_c_weak_vector_ref, port, pstate);
|
||||
EXIT_NESTED_DATA (pstate);
|
||||
break;
|
||||
case scm_tc7_vector:
|
||||
ENTER_NESTED_DATA (pstate, exp, circref);
|
||||
scm_puts ("#(", port);
|
||||
print_vector_or_weak_vector (exp, SCM_SIMPLE_VECTOR_LENGTH (exp),
|
||||
scm_c_vector_ref, port, pstate);
|
||||
print_vector (exp, SCM_SIMPLE_VECTOR_LENGTH (exp), scm_c_vector_ref,
|
||||
port, pstate);
|
||||
EXIT_NESTED_DATA (pstate);
|
||||
break;
|
||||
case scm_tc7_port:
|
||||
|
|
|
|||
|
|
@ -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_wvect 0x0f
|
||||
#define scm_tc7_unused_0f 0x0f
|
||||
#define scm_tc7_string 0x15
|
||||
#define scm_tc7_number 0x17
|
||||
#define scm_tc7_hashtable 0x1d
|
||||
|
|
|
|||
|
|
@ -1,66 +0,0 @@
|
|||
#ifndef SCM_WEAK_LIST_H
|
||||
#define SCM_WEAK_LIST_H
|
||||
|
||||
/* Copyright 2016,2018
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
||||
Guile is free software: you can redistribute it and/or modify it
|
||||
under the terms of the GNU Lesser General Public License as published
|
||||
by the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
Guile is distributed in the hope that it will be useful, but WITHOUT
|
||||
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
|
||||
License for more details.
|
||||
|
||||
You should have received a copy of the GNU Lesser General Public
|
||||
License along with Guile. If not, see
|
||||
<https://www.gnu.org/licenses/>. */
|
||||
|
||||
|
||||
|
||||
#include "libguile/pairs.h"
|
||||
#include "libguile/weak-vector.h"
|
||||
|
||||
|
||||
|
||||
static inline SCM
|
||||
scm_i_weak_cons (SCM car, SCM cdr)
|
||||
{
|
||||
return scm_cons (scm_c_make_weak_vector (1, car), cdr);
|
||||
}
|
||||
|
||||
static inline SCM
|
||||
scm_i_weak_car (SCM pair)
|
||||
{
|
||||
return scm_c_weak_vector_ref (scm_car (pair), 0);
|
||||
}
|
||||
|
||||
static inline void
|
||||
scm_i_visit_weak_list (SCM *list_loc, void (*visit) (SCM))
|
||||
{
|
||||
SCM in = *list_loc, out = SCM_EOL;
|
||||
|
||||
while (scm_is_pair (in))
|
||||
{
|
||||
SCM car = scm_i_weak_car (in);
|
||||
SCM cdr = scm_cdr (in);
|
||||
|
||||
if (!scm_is_eq (car, SCM_BOOL_F))
|
||||
{
|
||||
scm_set_cdr_x (in, out);
|
||||
out = in;
|
||||
visit (car);
|
||||
}
|
||||
|
||||
in = cdr;
|
||||
}
|
||||
|
||||
*list_loc = out;
|
||||
}
|
||||
|
||||
|
||||
#endif /* SCM_WEAK_LIST_H */
|
||||
|
|
@ -36,8 +36,6 @@
|
|||
#include "threads.h"
|
||||
#include "weak-set.h"
|
||||
|
||||
#include "weak-list.h"
|
||||
|
||||
|
||||
/* Weak Sets
|
||||
|
||||
|
|
|
|||
|
|
@ -37,7 +37,6 @@
|
|||
#include "ports.h"
|
||||
#include "procs.h"
|
||||
#include "threads.h"
|
||||
#include "weak-list.h"
|
||||
|
||||
#include "weak-table.h"
|
||||
|
||||
|
|
|
|||
|
|
@ -1,273 +0,0 @@
|
|||
/* Copyright 1995-1996,1998,2000-2001,2003,2006,2008-2014,2018,2025
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
||||
Guile is free software: you can redistribute it and/or modify it
|
||||
under the terms of the GNU Lesser General Public License as published
|
||||
by the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
Guile is distributed in the hope that it will be useful, but WITHOUT
|
||||
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
|
||||
License for more details.
|
||||
|
||||
You should have received a copy of the GNU Lesser General Public
|
||||
License along with Guile. If not, see
|
||||
<https://www.gnu.org/licenses/>. */
|
||||
|
||||
|
||||
|
||||
#ifdef HAVE_CONFIG_H
|
||||
# include <config.h>
|
||||
#endif
|
||||
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
#include "bdw-gc.h"
|
||||
#include "boolean.h"
|
||||
#include "extensions.h"
|
||||
#include "gsubr.h"
|
||||
#include "list.h"
|
||||
#include "pairs.h"
|
||||
#include "vectors.h"
|
||||
#include "version.h"
|
||||
|
||||
#include "weak-vector.h"
|
||||
|
||||
|
||||
|
||||
|
||||
/* {Weak Vectors}
|
||||
*/
|
||||
|
||||
#define VECTOR_MAX_LENGTH (SCM_T_BITS_MAX >> 8)
|
||||
|
||||
SCM
|
||||
scm_c_make_weak_vector (size_t len, SCM fill)
|
||||
#define FUNC_NAME "make-weak-vector"
|
||||
{
|
||||
SCM wv;
|
||||
size_t j;
|
||||
|
||||
SCM_ASSERT_RANGE (1, scm_from_size_t (len), len <= VECTOR_MAX_LENGTH);
|
||||
|
||||
if (SCM_UNBNDP (fill))
|
||||
fill = SCM_UNSPECIFIED;
|
||||
|
||||
wv = SCM_PACK_POINTER (scm_gc_malloc_pointerless ((len + 1) * sizeof (SCM),
|
||||
"weak vector"));
|
||||
|
||||
SCM_SET_CELL_WORD_0 (wv, (len << 8) | scm_tc7_wvect);
|
||||
|
||||
if (SCM_HEAP_OBJECT_P (fill))
|
||||
{
|
||||
memset (SCM_I_VECTOR_WELTS (wv), 0, len * sizeof (SCM));
|
||||
for (j = 0; j < len; j++)
|
||||
scm_c_weak_vector_set_x (wv, j, fill);
|
||||
}
|
||||
else
|
||||
for (j = 0; j < len; j++)
|
||||
SCM_SIMPLE_VECTOR_SET (wv, j, fill);
|
||||
|
||||
return wv;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE (scm_make_weak_vector, "make-weak-vector", 1, 1, 0,
|
||||
(SCM size, SCM fill),
|
||||
"Return a weak vector with @var{size} elements. If the optional\n"
|
||||
"argument @var{fill} is given, all entries in the vector will be\n"
|
||||
"set to @var{fill}. The default value for @var{fill} is the\n"
|
||||
"empty list.")
|
||||
#define FUNC_NAME s_scm_make_weak_vector
|
||||
{
|
||||
return scm_c_make_weak_vector (scm_to_size_t (size), fill);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_REGISTER_PROC(s_list_to_weak_vector, "list->weak-vector", 1, 0, 0, scm_weak_vector);
|
||||
|
||||
SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1,
|
||||
(SCM lst),
|
||||
"@deffnx {Scheme Procedure} list->weak-vector lst\n"
|
||||
"Construct a weak vector from a list: @code{weak-vector} uses\n"
|
||||
"the list of its arguments while @code{list->weak-vector} uses\n"
|
||||
"its only argument @var{l} (a list) to construct a weak vector\n"
|
||||
"the same way @code{list->vector} would.")
|
||||
#define FUNC_NAME s_scm_weak_vector
|
||||
{
|
||||
SCM wv;
|
||||
size_t i;
|
||||
long c_size;
|
||||
|
||||
SCM_VALIDATE_LIST_COPYLEN (SCM_ARG1, lst, c_size);
|
||||
|
||||
wv = scm_c_make_weak_vector ((size_t) c_size, SCM_BOOL_F);
|
||||
|
||||
for (i = 0; scm_is_pair (lst); lst = SCM_CDR (lst), i++)
|
||||
scm_c_weak_vector_set_x (wv, i, SCM_CAR (lst));
|
||||
|
||||
return wv;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_weak_vector_p, "weak-vector?", 1, 0, 0,
|
||||
(SCM obj),
|
||||
"Return @code{#t} if @var{obj} is a weak vector. Note that all\n"
|
||||
"weak hashes are also weak vectors.")
|
||||
#define FUNC_NAME s_scm_weak_vector_p
|
||||
{
|
||||
return scm_from_bool (scm_is_weak_vector (obj));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
int
|
||||
scm_is_weak_vector (SCM obj)
|
||||
#define FUNC_NAME s_scm_weak_vector_p
|
||||
{
|
||||
return SCM_I_WVECTP (obj);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
#define SCM_VALIDATE_WEAK_VECTOR(pos, var) \
|
||||
SCM_I_MAKE_VALIDATE_MSG2 (pos, var, SCM_I_WVECTP, "weak vector")
|
||||
|
||||
|
||||
SCM_DEFINE (scm_weak_vector_length, "weak-vector-length", 1, 0, 0,
|
||||
(SCM wvect),
|
||||
"Like @code{vector-length}, but for weak vectors.")
|
||||
#define FUNC_NAME s_scm_weak_vector_length
|
||||
{
|
||||
return scm_from_size_t (scm_c_weak_vector_length (wvect));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
size_t
|
||||
scm_c_weak_vector_length (SCM wvect)
|
||||
#define FUNC_NAME s_scm_weak_vector_length
|
||||
{
|
||||
SCM_VALIDATE_WEAK_VECTOR (1, wvect);
|
||||
return SCM_I_VECTOR_LENGTH (wvect);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_weak_vector_ref, "weak-vector-ref", 2, 0, 0,
|
||||
(SCM wvect, SCM k),
|
||||
"Like @code{vector-ref}, but for weak vectors.")
|
||||
#define FUNC_NAME s_scm_weak_vector_ref
|
||||
{
|
||||
return scm_c_weak_vector_ref (wvect, scm_to_size_t (k));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
struct weak_vector_ref_data
|
||||
{
|
||||
SCM wv;
|
||||
size_t k;
|
||||
};
|
||||
|
||||
static void*
|
||||
weak_vector_ref (void *data)
|
||||
{
|
||||
struct weak_vector_ref_data *d = data;
|
||||
|
||||
return (void *) SCM_UNPACK (SCM_SIMPLE_VECTOR_REF (d->wv, d->k));
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_c_weak_vector_ref (SCM wv, size_t k)
|
||||
#define FUNC_NAME s_scm_weak_vector_ref
|
||||
{
|
||||
struct weak_vector_ref_data d;
|
||||
void *ret;
|
||||
|
||||
SCM_VALIDATE_WEAK_VECTOR (1, wv);
|
||||
|
||||
d.wv = wv;
|
||||
d.k = k;
|
||||
|
||||
if (k >= SCM_I_VECTOR_LENGTH (wv))
|
||||
scm_out_of_range ("weak-vector-ref", scm_from_size_t (k));
|
||||
|
||||
ret = GC_call_with_alloc_lock (weak_vector_ref, &d);
|
||||
|
||||
if (ret)
|
||||
return SCM_PACK_POINTER (ret);
|
||||
else
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_weak_vector_set_x, "weak-vector-set!", 3, 0, 0,
|
||||
(SCM wvect, SCM k, SCM obj),
|
||||
"Like @code{vector-set!}, but for weak vectors.")
|
||||
#define FUNC_NAME s_scm_weak_vector_set_x
|
||||
{
|
||||
scm_c_weak_vector_set_x (wvect, scm_to_size_t (k), obj);
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
void
|
||||
scm_c_weak_vector_set_x (SCM wv, size_t k, SCM x)
|
||||
#define FUNC_NAME s_scm_weak_vector_set_x
|
||||
{
|
||||
SCM *elts;
|
||||
struct weak_vector_ref_data d;
|
||||
void *prev;
|
||||
|
||||
SCM_VALIDATE_WEAK_VECTOR (1, wv);
|
||||
|
||||
d.wv = wv;
|
||||
d.k = k;
|
||||
|
||||
if (k >= SCM_I_VECTOR_LENGTH (wv))
|
||||
scm_out_of_range ("weak-vector-set!", scm_from_size_t (k));
|
||||
|
||||
prev = GC_call_with_alloc_lock (weak_vector_ref, &d);
|
||||
|
||||
elts = SCM_I_VECTOR_WELTS (wv);
|
||||
|
||||
if (prev && SCM_HEAP_OBJECT_P (SCM_PACK_POINTER (prev)))
|
||||
GC_unregister_disappearing_link ((void **) &elts[k]);
|
||||
|
||||
elts[k] = x;
|
||||
|
||||
if (SCM_HEAP_OBJECT_P (x))
|
||||
SCM_I_REGISTER_DISAPPEARING_LINK ((void **) &elts[k],
|
||||
SCM2PTR (x));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
|
||||
static void
|
||||
scm_init_weak_vector_builtins (void)
|
||||
{
|
||||
#ifndef SCM_MAGIC_SNARFER
|
||||
#include "weak-vector.x"
|
||||
#endif
|
||||
}
|
||||
|
||||
void
|
||||
scm_init_weak_vectors ()
|
||||
{
|
||||
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
|
||||
"scm_init_weak_vector_builtins",
|
||||
(scm_t_extension_init_func)scm_init_weak_vector_builtins,
|
||||
NULL);
|
||||
}
|
||||
|
||||
|
|
@ -1,48 +0,0 @@
|
|||
#ifndef SCM_WEAK_VECTOR_H
|
||||
#define SCM_WEAK_VECTOR_H
|
||||
|
||||
/* Copyright 1995-1996,2000-2001,2003,2006,2008-2009,2011,2014,2018
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
||||
Guile is free software: you can redistribute it and/or modify it
|
||||
under the terms of the GNU Lesser General Public License as published
|
||||
by the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
Guile is distributed in the hope that it will be useful, but WITHOUT
|
||||
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
|
||||
License for more details.
|
||||
|
||||
You should have received a copy of the GNU Lesser General Public
|
||||
License along with Guile. If not, see
|
||||
<https://www.gnu.org/licenses/>. */
|
||||
|
||||
|
||||
|
||||
#include "libguile/scm.h"
|
||||
|
||||
|
||||
/* Weak vectors. */
|
||||
|
||||
#define SCM_I_WVECTP(x) (SCM_HAS_TYP7 (x, scm_tc7_wvect))
|
||||
|
||||
SCM_API SCM scm_make_weak_vector (SCM len, SCM fill);
|
||||
SCM_API SCM scm_weak_vector (SCM l);
|
||||
SCM_API SCM scm_weak_vector_p (SCM x);
|
||||
SCM_API SCM scm_weak_vector_length (SCM v);
|
||||
SCM_API SCM scm_weak_vector_ref (SCM v, SCM k);
|
||||
SCM_API SCM scm_weak_vector_set_x (SCM v, SCM k, SCM x);
|
||||
|
||||
SCM_API SCM scm_c_make_weak_vector (size_t len, SCM fill);
|
||||
SCM_API int scm_is_weak_vector (SCM obj);
|
||||
SCM_API size_t scm_c_weak_vector_length (SCM vec);
|
||||
SCM_API SCM scm_c_weak_vector_ref (SCM v, size_t k);
|
||||
SCM_API void scm_c_weak_vector_set_x (SCM v, size_t k, SCM x);
|
||||
|
||||
SCM_INTERNAL void scm_init_weak_vectors (void);
|
||||
|
||||
|
||||
#endif /* SCM_WEAK_VECTOR_H */
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
;;; installed-scm-file
|
||||
|
||||
;;;; Copyright (C) 2003, 2006, 2011, 2014 Free Software Foundation, Inc.
|
||||
;;;; Copyright (C) 2003, 2006, 2011, 2014, 2025 Free Software Foundation, Inc.
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
|
@ -19,6 +19,9 @@
|
|||
|
||||
|
||||
(define-module (ice-9 weak-vector)
|
||||
#:use-module (ice-9 ephemerons)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (srfi srfi-9)
|
||||
#:export (make-weak-vector
|
||||
list->weak-vector
|
||||
weak-vector
|
||||
|
|
@ -26,6 +29,54 @@
|
|||
weak-vector-ref
|
||||
weak-vector-set!))
|
||||
|
||||
(eval-when (load eval compile)
|
||||
(load-extension (string-append "libguile-" (effective-version))
|
||||
"scm_init_weak_vector_builtins"))
|
||||
(define (immediate? x)
|
||||
(cond
|
||||
((exact-integer? x) (<= most-negative-fixnum x most-positive-fixnum))
|
||||
((char? x) #t)
|
||||
((eq? x #f) #t)
|
||||
((eq? x #nil) #t)
|
||||
((eq? x '()) #t)
|
||||
((eq? x #t) #t)
|
||||
((unspecified? x) #t)
|
||||
((eof-object? x) #t)
|
||||
(else #f)))
|
||||
|
||||
(define-record-type <weak-vector>
|
||||
(%make-weak-vector weaks)
|
||||
weak-vector?
|
||||
(weaks weak-vector-weaks))
|
||||
|
||||
(define* (make-weak-vector size #:optional (fill #f))
|
||||
(let ((wv (%make-weak-vector (make-vector size #f))))
|
||||
(let lp ((i 0))
|
||||
(when (< i size)
|
||||
(weak-vector-set! wv i fill)
|
||||
(lp (1+ i))))
|
||||
wv))
|
||||
|
||||
(define (make-weak val)
|
||||
(if (immediate? val)
|
||||
val
|
||||
(make-ephemeron val #t)))
|
||||
|
||||
(define (weak-vector-set! wv idx val)
|
||||
(vector-set! (weak-vector-weaks wv) idx (make-weak val))
|
||||
(values))
|
||||
|
||||
(define (weak-vector-ref wv idx)
|
||||
(let ((weak (vector-ref (weak-vector-weaks wv) idx)))
|
||||
(if (ephemeron? weak)
|
||||
(ephemeron-key weak)
|
||||
weak)))
|
||||
|
||||
(define (list->weak-vector ls)
|
||||
(let ((wv (make-weak-vector (length ls) #f)))
|
||||
(let lp ((ls ls) (idx 0))
|
||||
(match ls
|
||||
(() wv)
|
||||
((elt . ls)
|
||||
(weak-vector-set! wv idx elt)
|
||||
(lp ls (1+ idx)))))))
|
||||
|
||||
(define (weak-vector . elts)
|
||||
(list->weak-vector elts))
|
||||
|
|
|
|||
|
|
@ -431,8 +431,6 @@ using BACKEND."
|
|||
(bytevector->uint-list words (native-endianness)
|
||||
%word-size)))
|
||||
vector)))
|
||||
(((_ & #x7f = %tc7-weak-vector))
|
||||
(inferior-object 'weak-vector address)) ; TODO: show elements
|
||||
(((_ & #x7f = %tc7-fluid) init-value)
|
||||
(inferior-object 'fluid address))
|
||||
(((_ & #x7f = %tc7-dynamic-state))
|
||||
|
|
|
|||
|
|
@ -36,7 +36,6 @@
|
|||
%tc7-vector
|
||||
%tc8-immutable-vector
|
||||
%tc8-mutable-vector
|
||||
%tc7-weak-vector
|
||||
%tc7-string
|
||||
%tc7-heap-number
|
||||
%tc7-hash-table
|
||||
|
|
@ -132,7 +131,7 @@
|
|||
(vector vector? #b1111111 #b0001101)
|
||||
(immutable-vector immutable-vector? #b11111111 #b10001101)
|
||||
(mutable-vector mutable-vector? #b11111111 #b00001101)
|
||||
(weak-vector weak-vector? #b1111111 #b0001111)
|
||||
;;(unused unused #b1111111 #b0001111)
|
||||
(string string? #b1111111 #b0010101)
|
||||
(heap-number heap-number? #b1111111 #b0010111)
|
||||
(hash-table hash-table? #b1111111 #b0011101)
|
||||
|
|
|
|||
|
|
@ -118,7 +118,6 @@
|
|||
emit-vector?
|
||||
emit-mutable-vector?
|
||||
emit-immutable-vector?
|
||||
emit-weak-vector?
|
||||
emit-string?
|
||||
emit-heap-number?
|
||||
emit-hash-table?
|
||||
|
|
|
|||
|
|
@ -22,7 +22,6 @@
|
|||
#:use-module (rnrs io ports)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (ice-9 weak-vector)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-9)
|
||||
#:use-module (system foreign)
|
||||
|
|
@ -101,7 +100,6 @@
|
|||
((open-input-string "hello") port (? inferior-object?))
|
||||
((lambda () #t) program _)
|
||||
((make-variable 'foo) variable _)
|
||||
((make-weak-vector 3 #t) weak-vector _)
|
||||
((make-weak-key-hash-table) weak-table _)
|
||||
((make-weak-value-hash-table) weak-table _)
|
||||
((make-doubly-weak-hash-table) weak-table _)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue