mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
deprecate primitive properties
* libguile.h: * libguile/Makefile.am: * libguile/deprecated.h: * libguile/deprecated.c: * libguile/init.c: * libguile/properties.c: * libguile/properties.h: Deprecate the "primitive properties" interface. It was only used to implement object properties, and that is no longer the case. * module/ice-9/boot-9.scm (make-object-property): Reimplement just in terms of weak hash tables, and make threadsafe. * NEWS: * doc/ref/api-utility.texi: Update.
This commit is contained in:
Andy Wingo
parent
8269ba5b2c
commit
7948811252
10 changed files with 149 additions and 250 deletions
8
NEWS
8
NEWS
|
|
@ -10,6 +10,14 @@ latest prerelease, and a full NEWS corresponding to 1.8 -> 2.0.
|
|||
|
||||
Changes since the 1.9.15 prerelease:
|
||||
|
||||
** Deprecated: primitive properties
|
||||
|
||||
The `primitive-make-property', `primitive-property-set!',
|
||||
`primitive-property-ref', and `primitive-property-del!' procedures were
|
||||
crufty and only used to implement object properties, which has a new,
|
||||
threadsafe implementation. Use object properties or weak hash tables
|
||||
instead.
|
||||
|
||||
** New syntax: define-once
|
||||
|
||||
`define-once' is like Lisp's `defvar': it creates a toplevel binding,
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
@c -*-texinfo-*-
|
||||
@c This is part of the GNU Guile Reference Manual.
|
||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004
|
||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2011
|
||||
@c Free Software Foundation, Inc.
|
||||
@c See the file guile.texi for copying conditions.
|
||||
|
||||
|
|
@ -229,57 +229,10 @@ protected. When the Scheme value is collected, its entry in the
|
|||
property table is removed and so the (ex-) property values are no longer
|
||||
protected by the table.
|
||||
|
||||
@menu
|
||||
* Property Primitives:: Low level property implementation.
|
||||
* Old-fashioned Properties:: An older approach to properties.
|
||||
@end menu
|
||||
|
||||
|
||||
@node Property Primitives
|
||||
@subsubsection Low Level Property Implementation.
|
||||
|
||||
@deffn {Scheme Procedure} primitive-make-property not-found-proc
|
||||
@deffnx {C Function} scm_primitive_make_property (not_found_proc)
|
||||
Create a @dfn{property token} that can be used with
|
||||
@code{primitive-property-ref} and @code{primitive-property-set!}.
|
||||
See @code{primitive-property-ref} for the significance of
|
||||
@var{not-found-proc}.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} primitive-property-ref prop obj
|
||||
@deffnx {C Function} scm_primitive_property_ref (prop, obj)
|
||||
Return the property @var{prop} of @var{obj}.
|
||||
|
||||
When no value has yet been associated with @var{prop} and @var{obj},
|
||||
the @var{not-found-proc} from @var{prop} is used. A call
|
||||
@code{(@var{not-found-proc} @var{prop} @var{obj})} is made and the
|
||||
result set as the property value. If @var{not-found-proc} is
|
||||
@code{#f} then @code{#f} is the property value.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} primitive-property-set! prop obj val
|
||||
@deffnx {C Function} scm_primitive_property_set_x (prop, obj, val)
|
||||
Set the property @var{prop} of @var{obj} to @var{val}.
|
||||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} primitive-property-del! prop obj
|
||||
@deffnx {C Function} scm_primitive_property_del_x (prop, obj)
|
||||
Remove any value associated with @var{prop} and @var{obj}.
|
||||
@end deffn
|
||||
|
||||
|
||||
@node Old-fashioned Properties
|
||||
@subsubsection An Older Approach to Properties
|
||||
|
||||
Traditionally, Lisp systems provide a different object property
|
||||
interface to that provided by @code{make-object-property}, in which the
|
||||
object property that is being set or retrieved is indicated by a symbol.
|
||||
|
||||
Guile includes this older kind of interface as well, but it may well be
|
||||
removed in a future release, as it is less powerful than
|
||||
@code{make-object-property} and so increases the size of the Guile
|
||||
library for no benefit. (And it is trivial to write a compatibility
|
||||
layer in Scheme.)
|
||||
Guile also implements a more traditional Lispy interface to properties,
|
||||
in which each object has an list of key-value pairs associated with it.
|
||||
Properties in that list are keyed by symbols. This is a legacy
|
||||
interface; you should use weak hash tables or object properties instead.
|
||||
|
||||
@deffn {Scheme Procedure} object-properties obj
|
||||
@deffnx {C Function} scm_object_properties (obj)
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#ifndef SCM_LIBGUILE_H
|
||||
#define SCM_LIBGUILE_H
|
||||
|
||||
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2008, 2009, 2010, 2011 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 License
|
||||
|
|
@ -82,7 +82,6 @@ extern "C" {
|
|||
#include "libguile/print.h"
|
||||
#include "libguile/procprop.h"
|
||||
#include "libguile/promises.h"
|
||||
#include "libguile/properties.h"
|
||||
#include "libguile/procs.h"
|
||||
#include "libguile/r6rs-ports.h"
|
||||
#include "libguile/random.h"
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
## Process this file with Automake to create Makefile.in
|
||||
##
|
||||
## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
|
||||
## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
|
||||
##
|
||||
## This file is part of GUILE.
|
||||
##
|
||||
|
|
@ -177,7 +177,6 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \
|
|||
procs.c \
|
||||
programs.c \
|
||||
promises.c \
|
||||
properties.c \
|
||||
r6rs-ports.c \
|
||||
random.c \
|
||||
rdelim.c \
|
||||
|
|
@ -274,7 +273,6 @@ DOT_X_FILES = \
|
|||
procprop.x \
|
||||
procs.x \
|
||||
promises.x \
|
||||
properties.x \
|
||||
r6rs-ports.x \
|
||||
random.x \
|
||||
rdelim.x \
|
||||
|
|
@ -375,7 +373,6 @@ DOT_DOC_FILES = \
|
|||
procprop.doc \
|
||||
procs.doc \
|
||||
promises.doc \
|
||||
properties.doc \
|
||||
r6rs-ports.doc \
|
||||
random.doc \
|
||||
rdelim.doc \
|
||||
|
|
@ -550,7 +547,6 @@ modinclude_HEADERS = \
|
|||
procs.h \
|
||||
programs.h \
|
||||
promises.h \
|
||||
properties.h \
|
||||
pthread-threads.h \
|
||||
r6rs-ports.h \
|
||||
random.h \
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
deprecate something, move it here when that is feasible.
|
||||
*/
|
||||
|
||||
/* Copyright (C) 2003, 2004, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 2003, 2004, 2006, 2008, 2009, 2010, 2011 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 License
|
||||
|
|
@ -2390,9 +2390,120 @@ SCM_DEFINE (scm_cuserid, "cuserid", 0, 0, 0,
|
|||
|
||||
|
||||
|
||||
/* {Properties}
|
||||
*/
|
||||
|
||||
static SCM properties_whash;
|
||||
|
||||
SCM_DEFINE (scm_primitive_make_property, "primitive-make-property", 1, 0, 0,
|
||||
(SCM not_found_proc),
|
||||
"Create a @dfn{property token} that can be used with\n"
|
||||
"@code{primitive-property-ref} and @code{primitive-property-set!}.\n"
|
||||
"See @code{primitive-property-ref} for the significance of\n"
|
||||
"@var{not_found_proc}.")
|
||||
#define FUNC_NAME s_scm_primitive_make_property
|
||||
{
|
||||
scm_c_issue_deprecation_warning
|
||||
("`primitive-make-property' is deprecated. Use object properties.");
|
||||
|
||||
if (not_found_proc != SCM_BOOL_F)
|
||||
SCM_VALIDATE_PROC (SCM_ARG1, not_found_proc);
|
||||
return scm_cons (not_found_proc, SCM_EOL);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_primitive_property_ref, "primitive-property-ref", 2, 0, 0,
|
||||
(SCM prop, SCM obj),
|
||||
"Return the property @var{prop} of @var{obj}.\n"
|
||||
"\n"
|
||||
"When no value has yet been associated with @var{prop} and\n"
|
||||
"@var{obj}, the @var{not-found-proc} from @var{prop} is used. A\n"
|
||||
"call @code{(@var{not-found-proc} @var{prop} @var{obj})} is made\n"
|
||||
"and the result set as the property value. If\n"
|
||||
"@var{not-found-proc} is @code{#f} then @code{#f} is the\n"
|
||||
"property value.")
|
||||
#define FUNC_NAME s_scm_primitive_property_ref
|
||||
{
|
||||
SCM h;
|
||||
|
||||
scm_c_issue_deprecation_warning
|
||||
("`primitive-property-ref' is deprecated. Use object properties.");
|
||||
|
||||
SCM_VALIDATE_CONS (SCM_ARG1, prop);
|
||||
|
||||
h = scm_hashq_get_handle (properties_whash, obj);
|
||||
if (scm_is_true (h))
|
||||
{
|
||||
SCM assoc = scm_assq (prop, SCM_CDR (h));
|
||||
if (scm_is_true (assoc))
|
||||
return SCM_CDR (assoc);
|
||||
}
|
||||
|
||||
if (scm_is_false (SCM_CAR (prop)))
|
||||
return SCM_BOOL_F;
|
||||
else
|
||||
{
|
||||
SCM val = scm_call_2 (SCM_CAR (prop), prop, obj);
|
||||
if (scm_is_false (h))
|
||||
h = scm_hashq_create_handle_x (properties_whash, obj, SCM_EOL);
|
||||
SCM_SETCDR (h, scm_acons (prop, val, SCM_CDR (h)));
|
||||
return val;
|
||||
}
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_primitive_property_set_x, "primitive-property-set!", 3, 0, 0,
|
||||
(SCM prop, SCM obj, SCM val),
|
||||
"Set the property @var{prop} of @var{obj} to @var{val}.")
|
||||
#define FUNC_NAME s_scm_primitive_property_set_x
|
||||
{
|
||||
SCM h, assoc;
|
||||
|
||||
scm_c_issue_deprecation_warning
|
||||
("`primitive-property-set!' is deprecated. Use object properties.");
|
||||
|
||||
SCM_VALIDATE_CONS (SCM_ARG1, prop);
|
||||
h = scm_hashq_create_handle_x (properties_whash, obj, SCM_EOL);
|
||||
assoc = scm_assq (prop, SCM_CDR (h));
|
||||
if (SCM_NIMP (assoc))
|
||||
SCM_SETCDR (assoc, val);
|
||||
else
|
||||
{
|
||||
assoc = scm_acons (prop, val, SCM_CDR (h));
|
||||
SCM_SETCDR (h, assoc);
|
||||
}
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_primitive_property_del_x, "primitive-property-del!", 2, 0, 0,
|
||||
(SCM prop, SCM obj),
|
||||
"Remove any value associated with @var{prop} and @var{obj}.")
|
||||
#define FUNC_NAME s_scm_primitive_property_del_x
|
||||
{
|
||||
SCM h;
|
||||
|
||||
scm_c_issue_deprecation_warning
|
||||
("`primitive-property-del!' is deprecated. Use object properties.");
|
||||
|
||||
SCM_VALIDATE_CONS (SCM_ARG1, prop);
|
||||
h = scm_hashq_get_handle (properties_whash, obj);
|
||||
if (scm_is_true (h))
|
||||
SCM_SETCDR (h, scm_assq_remove_x (SCM_CDR (h), prop));
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
|
||||
|
||||
void
|
||||
scm_i_init_deprecated ()
|
||||
{
|
||||
properties_whash = scm_make_weak_key_hash_table (SCM_UNDEFINED);
|
||||
#include "libguile/deprecated.x"
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
#ifndef SCM_DEPRECATED_H
|
||||
#define SCM_DEPRECATED_H
|
||||
|
||||
/* Copyright (C) 2003,2004, 2005, 2006, 2007, 2009, 2010 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 2003,2004, 2005, 2006, 2007, 2009, 2010, 2011 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 License
|
||||
|
|
@ -738,7 +738,16 @@ SCM_DEPRECATED int scm_internal_select (int fds,
|
|||
|
||||
/* Deprecated because the cuserid call is deprecated.
|
||||
*/
|
||||
SCM_API SCM scm_cuserid (void);
|
||||
SCM_DEPRECATED SCM scm_cuserid (void);
|
||||
|
||||
|
||||
|
||||
/* Deprecated because it's yet another property interface.
|
||||
*/
|
||||
SCM_DEPRECATED SCM scm_primitive_make_property (SCM not_found_proc);
|
||||
SCM_DEPRECATED SCM scm_primitive_property_ref (SCM prop, SCM obj);
|
||||
SCM_DEPRECATED SCM scm_primitive_property_set_x (SCM prop, SCM obj, SCM val);
|
||||
SCM_DEPRECATED SCM scm_primitive_property_del_x (SCM prop, SCM obj);
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -99,7 +99,6 @@
|
|||
#include "libguile/procs.h"
|
||||
#include "libguile/programs.h"
|
||||
#include "libguile/promises.h"
|
||||
#include "libguile/properties.h"
|
||||
#include "libguile/array-map.h"
|
||||
#include "libguile/random.h"
|
||||
#include "libguile/rdelim.h"
|
||||
|
|
@ -458,7 +457,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
|
|||
scm_init_deprecation ();
|
||||
scm_init_objprop ();
|
||||
scm_init_promises (); /* requires smob_prehistory */
|
||||
scm_init_properties ();
|
||||
scm_init_hooks (); /* Requires smob_prehistory */
|
||||
scm_init_gc (); /* Requires hooks */
|
||||
scm_init_gc_protect_object (); /* requires threads_prehistory */
|
||||
|
|
|
|||
|
|
@ -1,142 +0,0 @@
|
|||
/* Copyright (C) 1995,1996,2000,2001, 2003, 2006, 2008, 2009 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 License
|
||||
* as published by the Free Software Foundation; either version 3 of
|
||||
* the License, or (at your option) any later version.
|
||||
*
|
||||
* This library 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 this library; if not, write to the Free Software
|
||||
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
||||
* 02110-1301 USA
|
||||
*/
|
||||
|
||||
|
||||
|
||||
#ifdef HAVE_CONFIG_H
|
||||
# include <config.h>
|
||||
#endif
|
||||
|
||||
#include "libguile/_scm.h"
|
||||
#include "libguile/hashtab.h"
|
||||
#include "libguile/alist.h"
|
||||
#include "libguile/root.h"
|
||||
#include "libguile/weaks.h"
|
||||
#include "libguile/validate.h"
|
||||
#include "libguile/eval.h"
|
||||
|
||||
#include "libguile/properties.h"
|
||||
|
||||
|
||||
/* {Properties}
|
||||
*/
|
||||
|
||||
static SCM properties_whash;
|
||||
|
||||
SCM_DEFINE (scm_primitive_make_property, "primitive-make-property", 1, 0, 0,
|
||||
(SCM not_found_proc),
|
||||
"Create a @dfn{property token} that can be used with\n"
|
||||
"@code{primitive-property-ref} and @code{primitive-property-set!}.\n"
|
||||
"See @code{primitive-property-ref} for the significance of\n"
|
||||
"@var{not_found_proc}.")
|
||||
#define FUNC_NAME s_scm_primitive_make_property
|
||||
{
|
||||
if (not_found_proc != SCM_BOOL_F)
|
||||
SCM_VALIDATE_PROC (SCM_ARG1, not_found_proc);
|
||||
return scm_cons (not_found_proc, SCM_EOL);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_primitive_property_ref, "primitive-property-ref", 2, 0, 0,
|
||||
(SCM prop, SCM obj),
|
||||
"Return the property @var{prop} of @var{obj}.\n"
|
||||
"\n"
|
||||
"When no value has yet been associated with @var{prop} and\n"
|
||||
"@var{obj}, the @var{not-found-proc} from @var{prop} is used. A\n"
|
||||
"call @code{(@var{not-found-proc} @var{prop} @var{obj})} is made\n"
|
||||
"and the result set as the property value. If\n"
|
||||
"@var{not-found-proc} is @code{#f} then @code{#f} is the\n"
|
||||
"property value.")
|
||||
#define FUNC_NAME s_scm_primitive_property_ref
|
||||
{
|
||||
SCM h;
|
||||
|
||||
SCM_VALIDATE_CONS (SCM_ARG1, prop);
|
||||
|
||||
h = scm_hashq_get_handle (properties_whash, obj);
|
||||
if (scm_is_true (h))
|
||||
{
|
||||
SCM assoc = scm_assq (prop, SCM_CDR (h));
|
||||
if (scm_is_true (assoc))
|
||||
return SCM_CDR (assoc);
|
||||
}
|
||||
|
||||
if (scm_is_false (SCM_CAR (prop)))
|
||||
return SCM_BOOL_F;
|
||||
else
|
||||
{
|
||||
SCM val = scm_call_2 (SCM_CAR (prop), prop, obj);
|
||||
if (scm_is_false (h))
|
||||
h = scm_hashq_create_handle_x (properties_whash, obj, SCM_EOL);
|
||||
SCM_SETCDR (h, scm_acons (prop, val, SCM_CDR (h)));
|
||||
return val;
|
||||
}
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_primitive_property_set_x, "primitive-property-set!", 3, 0, 0,
|
||||
(SCM prop, SCM obj, SCM val),
|
||||
"Set the property @var{prop} of @var{obj} to @var{val}.")
|
||||
#define FUNC_NAME s_scm_primitive_property_set_x
|
||||
{
|
||||
SCM h, assoc;
|
||||
SCM_VALIDATE_CONS (SCM_ARG1, prop);
|
||||
h = scm_hashq_create_handle_x (properties_whash, obj, SCM_EOL);
|
||||
assoc = scm_assq (prop, SCM_CDR (h));
|
||||
if (SCM_NIMP (assoc))
|
||||
SCM_SETCDR (assoc, val);
|
||||
else
|
||||
{
|
||||
assoc = scm_acons (prop, val, SCM_CDR (h));
|
||||
SCM_SETCDR (h, assoc);
|
||||
}
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_primitive_property_del_x, "primitive-property-del!", 2, 0, 0,
|
||||
(SCM prop, SCM obj),
|
||||
"Remove any value associated with @var{prop} and @var{obj}.")
|
||||
#define FUNC_NAME s_scm_primitive_property_del_x
|
||||
{
|
||||
SCM h;
|
||||
SCM_VALIDATE_CONS (SCM_ARG1, prop);
|
||||
h = scm_hashq_get_handle (properties_whash, obj);
|
||||
if (scm_is_true (h))
|
||||
SCM_SETCDR (h, scm_assq_remove_x (SCM_CDR (h), prop));
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
void
|
||||
scm_init_properties ()
|
||||
{
|
||||
properties_whash = scm_make_weak_key_hash_table (SCM_UNDEFINED);
|
||||
#include "libguile/properties.x"
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
Local Variables:
|
||||
c-file-style: "gnu"
|
||||
End:
|
||||
*/
|
||||
|
|
@ -1,41 +0,0 @@
|
|||
/* classes: h_files */
|
||||
|
||||
#ifndef SCM_PROPERTIES_H
|
||||
#define SCM_PROPERTIES_H
|
||||
|
||||
/* Copyright (C) 1995,1996,1998,2000, 2006, 2008 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 License
|
||||
* as published by the Free Software Foundation; either version 3 of
|
||||
* the License, or (at your option) any later version.
|
||||
*
|
||||
* This library 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 this library; if not, write to the Free Software
|
||||
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
||||
* 02110-1301 USA
|
||||
*/
|
||||
|
||||
|
||||
|
||||
#include "libguile/__scm.h"
|
||||
|
||||
SCM_API SCM scm_primitive_make_property (SCM not_found_proc);
|
||||
SCM_API SCM scm_primitive_property_ref (SCM prop, SCM obj);
|
||||
SCM_API SCM scm_primitive_property_set_x (SCM prop, SCM obj, SCM val);
|
||||
SCM_API SCM scm_primitive_property_del_x (SCM prop, SCM obj);
|
||||
|
||||
SCM_INTERNAL void scm_init_properties (void);
|
||||
|
||||
#endif /* SCM_PROPERTIES_H */
|
||||
|
||||
/*
|
||||
Local Variables:
|
||||
c-file-style: "gnu"
|
||||
End:
|
||||
*/
|
||||
|
|
@ -587,10 +587,18 @@ VALUE."
|
|||
;; properties within the object itself.
|
||||
|
||||
(define (make-object-property)
|
||||
(let ((prop (primitive-make-property #f)))
|
||||
(define-syntax with-mutex
|
||||
(syntax-rules ()
|
||||
((_ lock exp)
|
||||
(dynamic-wind (lambda () (lock-mutex lock))
|
||||
(lambda () exp)
|
||||
(lambda () (unlock-mutex lock))))))
|
||||
(let ((prop (make-weak-key-hash-table))
|
||||
(lock (make-mutex)))
|
||||
(make-procedure-with-setter
|
||||
(lambda (obj) (primitive-property-ref prop obj))
|
||||
(lambda (obj val) (primitive-property-set! prop obj val)))))
|
||||
(lambda (obj) (with-mutex lock (hashq-ref prop obj)))
|
||||
(lambda (obj val) (with-mutex lock (hashq-set! prop obj val))))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue