mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

deprecate primitive properties

Browse source 
* 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 2011-02-10 23:07:03 +01:00
parent 8269ba5b2c
commit 7948811252
10 changed files with 149 additions and 250 deletions
Download patch file Download diff file Expand all files Collapse all files

8
NEWS
View file

@ -10,6 +10,14 @@ latest prerelease, and a full NEWS corresponding to 1.8 -> 2.0.
Changes since the 1.9.15 prerelease: 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 ** New syntax: define-once
`define-once' is like Lisp's `defvar': it creates a toplevel binding, `define-once' is like Lisp's `defvar': it creates a toplevel binding,

57
doc/ref/api-utility.texi
View file

@ -1,6 +1,6 @@
@c -*-texinfo-*- @c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual. @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 Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions. @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 property table is removed and so the (ex-) property values are no longer
protected by the table. protected by the table.
@menu Guile also implements a more traditional Lispy interface to properties,
* Property Primitives:: Low level property implementation. in which each object has an list of key-value pairs associated with it.
* Old-fashioned Properties:: An older approach to properties. Properties in that list are keyed by symbols. This is a legacy
@end menu interface; you should use weak hash tables or object properties instead.
@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.)
@deffn {Scheme Procedure} object-properties obj @deffn {Scheme Procedure} object-properties obj
@deffnx {C Function} scm_object_properties (obj) @deffnx {C Function} scm_object_properties (obj)

3
libguile.h
View file

@ -1,7 +1,7 @@
#ifndef SCM_LIBGUILE_H #ifndef SCM_LIBGUILE_H
#define 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -82,7 +82,6 @@ extern "C" {
#include "libguile/print.h" #include "libguile/print.h"
#include "libguile/procprop.h" #include "libguile/procprop.h"
#include "libguile/promises.h" #include "libguile/promises.h"
#include "libguile/properties.h"
#include "libguile/procs.h" #include "libguile/procs.h"
#include "libguile/r6rs-ports.h" #include "libguile/r6rs-ports.h"
#include "libguile/random.h" #include "libguile/random.h"

6
libguile/Makefile.am
View file

@ -1,6 +1,6 @@
## Process this file with Automake to create Makefile.in ## 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. ## This file is part of GUILE.
## ##
@ -177,7 +177,6 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \
procs.c \ procs.c \
programs.c \ programs.c \
promises.c \ promises.c \
properties.c \
r6rs-ports.c \ r6rs-ports.c \
random.c \ random.c \
rdelim.c \ rdelim.c \
@ -274,7 +273,6 @@ DOT_X_FILES = \
procprop.x \ procprop.x \
procs.x \ procs.x \
promises.x \ promises.x \
properties.x \
r6rs-ports.x \ r6rs-ports.x \
random.x \ random.x \
rdelim.x \ rdelim.x \
@ -375,7 +373,6 @@ DOT_DOC_FILES = \
procprop.doc \ procprop.doc \
procs.doc \ procs.doc \
promises.doc \ promises.doc \
properties.doc \
r6rs-ports.doc \ r6rs-ports.doc \
random.doc \ random.doc \
rdelim.doc \ rdelim.doc \
@ -550,7 +547,6 @@ modinclude_HEADERS = \
procs.h \ procs.h \
programs.h \ programs.h \
promises.h \ promises.h \
properties.h \
pthread-threads.h \ pthread-threads.h \
r6rs-ports.h \ r6rs-ports.h \
random.h \ random.h \

113
libguile/deprecated.c
View file

@ -2,7 +2,7 @@
deprecate something, move it here when that is feasible. 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * 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 void
scm_i_init_deprecated () scm_i_init_deprecated ()
{ {
properties_whash = scm_make_weak_key_hash_table (SCM_UNDEFINED);
#include "libguile/deprecated.x" #include "libguile/deprecated.x"
} }

13
libguile/deprecated.h
View file

@ -5,7 +5,7 @@
#ifndef SCM_DEPRECATED_H #ifndef SCM_DEPRECATED_H
#define 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * 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. /* 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);

2
libguile/init.c
View file

@ -99,7 +99,6 @@
#include "libguile/procs.h" #include "libguile/procs.h"
#include "libguile/programs.h" #include "libguile/programs.h"
#include "libguile/promises.h" #include "libguile/promises.h"
#include "libguile/properties.h"
#include "libguile/array-map.h" #include "libguile/array-map.h"
#include "libguile/random.h" #include "libguile/random.h"
#include "libguile/rdelim.h" #include "libguile/rdelim.h"
@ -458,7 +457,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_deprecation (); scm_init_deprecation ();
scm_init_objprop (); scm_init_objprop ();
scm_init_promises (); /* requires smob_prehistory */ scm_init_promises (); /* requires smob_prehistory */
scm_init_properties ();
scm_init_hooks (); /* Requires smob_prehistory */ scm_init_hooks (); /* Requires smob_prehistory */
scm_init_gc (); /* Requires hooks */ scm_init_gc (); /* Requires hooks */
scm_init_gc_protect_object (); /* requires threads_prehistory */ scm_init_gc_protect_object (); /* requires threads_prehistory */

142
libguile/properties.c
View file

@ -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:
*/

41
libguile/properties.h
View file

@ -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:
*/

14
module/ice-9/boot-9.scm
View file

@ -587,10 +587,18 @@ VALUE."
;; properties within the object itself. ;; properties within the object itself.
(define (make-object-property) (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 (make-procedure-with-setter
(lambda (obj) (primitive-property-ref prop obj)) (lambda (obj) (with-mutex lock (hashq-ref prop obj)))
(lambda (obj val) (primitive-property-set! prop obj val))))) (lambda (obj val) (with-mutex lock (hashq-set! prop obj val))))))