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.

10 files changed, 149 insertions, 250 deletions

diff --git a/NEWS b/NEWS
index 7912259c3..3c65d989e 100644
--- a/NEWS
+++ b/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,
diff --git a/doc/ref/api-utility.texi b/doc/ref/api-utility.texi
index fb747eef8..ba6139f8c 100644
--- a/doc/ref/api-utility.texi
+++ b/doc/ref/api-utility.texi
@@ -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)
diff --git a/libguile.h b/libguile.h
index 5e8c792bc..2c10d05e9 100644
--- a/libguile.h
+++ b/libguile.h
@@ -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"
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index dd797eaad..79f886bb3 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -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				\
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 59ff34148..fd23e2dc9 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -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"
 }
 
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 84258fa9f..68aee6362 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -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);
 
 
 
diff --git a/libguile/init.c b/libguile/init.c
index cf7447dfe..243e15e06 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -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 */
diff --git a/libguile/properties.c b/libguile/properties.c
deleted file mode 100644
index 1f3c668a2..000000000
--- a/libguile/properties.c
+++ /dev/null
@@ -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:
-*/
diff --git a/libguile/properties.h b/libguile/properties.h
deleted file mode 100644
index efeaf3a59..000000000
--- a/libguile/properties.h
+++ /dev/null
@@ -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:
-*/
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index f706a716b..83b87fd48 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -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))))))
+