mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

Deprecate object-properties in the main environment

Browse source 
They should be deprecated entirely except that they are used for object
documentation.  Some other day.

* libguile/objprop.c:
* libguile/objprop.h: Remove.
* libguile/deprecated.h:
* libguile/deprecated.c (scm_object_properties):
(scm_set_object_properties_x):
(scm_object_property):
(scm_set_object_property_x): Add deprecation shims.
* module/ice-9/deprecated.scm (object-properties*):
(set-object-properties!*):
(object-property*):
(set-object-property!*): Add deprecation shims.
* libguile/init.c:
* libguile.h: Remove objprops.
* module/ice-9/object-properties.scm: Add pure Scheme implementation
here.
* module/ice-9/documentation.scm:
* module/scripts/api-diff.scm:
* module/scripts/read-text-outline.scm:
* module/scripts/scan-api.scm:
* module/scripts/summarize-guile-TODO.scm:
* module/srfi/srfi-64.scm: Include object-properties module.
This commit is contained in:
Andy Wingo 2025-05-09 13:49:17 +02:00
parent bdadd4b057
commit be6a5c6c75
15 changed files with 139 additions and 170 deletions
Download patch file Download diff file Expand all files Collapse all files

1
libguile.h
View file

@ -77,7 +77,6 @@ extern "C" {
#include "libguile/modules.h"
#include "libguile/net_db.h"
#include "libguile/numbers.h"
#include "libguile/objprop.h"
#include "libguile/options.h"
#include "libguile/pairs.h"
#include "libguile/ports.h"

4
libguile/Makefile.am
View file

@ -195,7 +195,6 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \
modules.c \
null-threads.c \
numbers.c \
objprop.c \
options.c \
pairs.c \
poll.c \
@ -309,7 +308,6 @@ DOT_X_FILES = \
memoize.x \
modules.x \
numbers.x \
objprop.x \
options.x \
pairs.x \
ports.x \
@ -410,7 +408,6 @@ DOT_DOC_FILES = \
memoize.doc \
modules.doc \
numbers.doc \
objprop.doc \
options.doc \
pairs.doc \
ports.doc \
@ -662,7 +659,6 @@ modinclude_HEADERS = \
net_db.h \
null-threads.h \
numbers.h \
objprop.h \
options.h \
pairs.h \
poll.h \

61
libguile/deprecated.c
View file

@ -169,6 +169,67 @@ 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);
}
static SCM object_properties_var;
static SCM set_object_properties_var;
static SCM object_property_var;
static SCM set_object_property_var;
static void
init_object_properties_vars (void)
{
object_properties_var =
scm_c_public_lookup ("ice-9 object-properties", "object-properties");
set_object_properties_var =
scm_c_public_lookup ("ice-9 object-properties", "set-object-properties!");
object_property_var =
scm_c_public_lookup ("ice-9 object-properties", "object-property");
set_object_property_var =
scm_c_public_lookup ("ice-9 object-properties", "set-object-property!");
}
static void
init_object_properties (void)
{
static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
scm_c_issue_deprecation_warning
("The object properties C interface is deprecated. Invoke the Scheme "
"procedures from (ice-9 object-properties) instead.");
scm_i_pthread_once (&once, init_object_properties_vars);
}
SCM
scm_object_properties (SCM obj)
{
init_object_properties ();
return scm_call_1 (scm_variable_ref (object_properties_var), obj);
}
SCM
scm_set_object_properties_x (SCM obj, SCM alist)
{
init_object_properties ();
return scm_call_2 (scm_variable_ref (set_object_properties_var), obj, alist);
}
SCM
scm_object_property (SCM obj, SCM key)
{
init_object_properties ();
return scm_call_2 (scm_variable_ref (object_property_var), obj, key);
}
SCM
scm_set_object_property_x (SCM obj, SCM key, SCM value)
{
init_object_properties ();
return scm_call_3 (scm_variable_ref (set_object_property_var), obj, key, value);
}
void

5
libguile/deprecated.h
View file

@ -41,6 +41,11 @@ 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);
SCM_DEPRECATED SCM scm_object_properties (SCM obj);
SCM_DEPRECATED SCM scm_set_object_properties_x (SCM obj, SCM plist);
SCM_DEPRECATED SCM scm_object_property (SCM obj, SCM key);
SCM_DEPRECATED SCM scm_set_object_property_x (SCM obj, SCM key, SCM val);
/* Deprecated declarations go here. */
void scm_i_init_deprecated (void);

2
libguile/init.c
View file

@ -99,7 +99,6 @@
#include "modules.h"
#include "net_db.h"
#include "numbers.h"
#include "objprop.h"
#include "options.h"
#include "pairs.h"
#include "poll.h"
@ -401,7 +400,6 @@ scm_i_init_guile (struct gc_stack_addr base)
scm_init_hash ();
scm_init_hashtab ();
scm_init_deprecation ();
scm_init_objprop ();
scm_init_promises (); /* requires smob_prehistory */
scm_init_hooks (); /* Requires smob_prehistory */
scm_init_stime ();

105
libguile/objprop.c
View file

@ -1,105 +0,0 @@
/* Copyright 1995-1996,2000-2001,2003,2006,2008-2011,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/>. */
#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include "alist.h"
#include "async.h"
#include "gsubr.h"
#include "hashtab.h"
#include "pairs.h"
#include "weak-table.h"
#include "objprop.h"
/* {Object Properties}
*/
static SCM object_whash;
SCM_DEFINE (scm_object_properties, "object-properties", 1, 0, 0,
(SCM obj),
"Return @var{obj}'s property list.")
#define FUNC_NAME s_scm_object_properties
{
return scm_weak_table_refq (object_whash, obj, SCM_EOL);
}
#undef FUNC_NAME
SCM_DEFINE (scm_set_object_properties_x, "set-object-properties!", 2, 0, 0,
(SCM obj, SCM alist),
"Set @var{obj}'s property list to @var{alist}.")
#define FUNC_NAME s_scm_set_object_properties_x
{
scm_weak_table_putq_x (object_whash, obj, alist);
return alist;
}
#undef FUNC_NAME
SCM_DEFINE (scm_object_property, "object-property", 2, 0, 0,
(SCM obj, SCM key),
"Return the property of @var{obj} with name @var{key}.")
#define FUNC_NAME s_scm_object_property
{
SCM assoc;
assoc = scm_assq (key, scm_object_properties (obj));
return (scm_is_pair (assoc) ? SCM_CDR (assoc) : SCM_BOOL_F);
}
#undef FUNC_NAME
SCM_DEFINE (scm_set_object_property_x, "set-object-property!", 3, 0, 0,
(SCM obj, SCM key, SCM value),
"In @var{obj}'s property list, set the property named @var{key}\n"
"to @var{value}.")
#define FUNC_NAME s_scm_set_object_property_x
{
SCM alist;
SCM assoc;
scm_i_pthread_mutex_lock (&scm_i_misc_mutex);
alist = scm_weak_table_refq (object_whash, obj, SCM_EOL);
assoc = scm_assq (key, alist);
if (scm_is_pair (assoc))
SCM_SETCDR (assoc, value);
else
scm_weak_table_putq_x (object_whash, obj, scm_acons (key, value, alist));
scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
return value;
}
#undef FUNC_NAME
void
scm_init_objprop ()
{
object_whash = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
#include "objprop.x"
}

35
libguile/objprop.h
View file

@ -1,35 +0,0 @@
#ifndef SCM_OBJPROP_H
#define SCM_OBJPROP_H
/* Copyright 1995,2000-2001,2006,2008,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"
SCM_API SCM scm_object_properties (SCM obj);
SCM_API SCM scm_set_object_properties_x (SCM obj, SCM plist);
SCM_API SCM scm_object_property (SCM obj, SCM key);
SCM_API SCM scm_set_object_property_x (SCM obj, SCM key, SCM val);
SCM_INTERNAL void scm_init_objprop (void);
#endif /* SCM_OBJPROP_H */

24
module/ice-9/deprecated.scm
View file

@ -56,6 +56,30 @@ from (ice-9 guardians) instead.")
it from (ice-9 object-properties) instead.")
(make-object-property))
(define (object-properties* obj)
(issue-deprecation-warning
"object-properties in the default environment is deprecated. Import
it from (ice-9 object-properties) instead.")
(object-properties obj))
(define (set-object-properties!* obj props)
(issue-deprecation-warning
"set-object-properties! in the default environment is deprecated. Import
it from (ice-9 object-properties) instead.")
(set-object-properties! obj props))
(define (object-property* obj key)
(issue-deprecation-warning
"object-property in the default environment is deprecated. Import
it from (ice-9 object-properties) instead.")
(object-property obj key))
(define (set-object-property!* obj key value)
(issue-deprecation-warning
"set-object-properties! in the default environment is deprecated. Import
it from (ice-9 object-properties) instead.")
(set-object-property! obj key value))
(define* (make-weak-key-hash-table* #:optional (n 0))
(issue-deprecation-warning
"make-weak-key-hash-table in the default environment is deprecated.

3
module/ice-9/documentation.scm
View file

@ -1,5 +1,5 @@
;;; documentation.scm --- Run-time documentation facility
;;; Copyright (C) 2000-2003,2006,2009,2010,2024 Free Software Foundation, Inc.
;;; Copyright (C) 2000-2003,2006,2009,2010,2024,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 License as
@ -79,6 +79,7 @@
;;; Code:
(define-module (ice-9 documentation)
#:use-module (ice-9 object-properties)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:use-module (ice-9 match)

22
module/ice-9/object-properties.scm
View file

@ -34,7 +34,12 @@
(define-module (ice-9 object-properties)
#:use-module (ice-9 weak-tables)
;; FIXME: Change to #:export when deprecated bindings removed.
#:replace (make-object-property))
#:replace (make-object-property
object-properties
set-object-properties!
object-property
set-object-property!))
(define (make-object-property)
;; Weak tables are thread-safe.
@ -42,3 +47,18 @@
(make-procedure-with-setter
(lambda (obj) (hashq-ref prop obj))
(lambda (obj val) (hashq-set! prop obj val)))))
;; FIXME: Deprecate these global properties.
(define global-properties (make-weak-key-hash-table))
(define (object-properties obj)
(hashq-ref global-properties obj '()))
(define (set-object-properties! obj props)
(hashq-set! global-properties obj props))
(define (object-property obj key)
(assq-ref (object-properties obj) key))
(define (set-object-property! obj key value)
(set-object-properties! obj (assq-set! (object-properties obj) key value)))

15
module/scripts/api-diff.scm
View file

@ -1,6 +1,6 @@
;;; api-diff --- diff guile-api.alist files
;; Copyright (C) 2002, 2006, 2011 Free Software Foundation, Inc.
;; Copyright (C) 2002, 2006, 2011, 2025 Free Software Foundation, Inc.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public License
@ -40,11 +40,12 @@
;;; Code:
(define-module (scripts api-diff)
:use-module (ice-9 common-list)
:use-module (ice-9 format)
:use-module (ice-9 getopt-long)
:autoload (srfi srfi-13) (string-tokenize)
:export (api-diff))
#:use-module (ice-9 common-list)
#:use-module (ice-9 format)
#:use-module (ice-9 getopt-long)
#:use-module (ice-9 object-properties)
#:autoload (srfi srfi-13) (string-tokenize)
#:export (api-diff))
(define %include-in-guild-list #f)
(define %summary "Show differences between two scan-api files.")
@ -54,7 +55,7 @@
(lambda () (read))))
(define put set-object-property!)
(define get object-property)
(define get yobject-property)
(define (read-api-alist-file file)
(let* ((alist (read-alist-file file))

3
module/scripts/read-text-outline.scm
View file

@ -1,6 +1,6 @@
;;; read-text-outline --- Read a text outline and display it as a sexp
;; Copyright (C) 2002, 2006, 2011 Free Software Foundation, Inc.
;; Copyright (C) 2002, 2006, 2011, 2025 Free Software Foundation, Inc.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public License
@ -115,6 +115,7 @@
read-text-outline-silently
make-text-outline-reader)
:use-module (ice-9 regex)
:use-module (ice-9 object-properties)
:autoload (ice-9 rdelim) (read-line)
:autoload (ice-9 getopt-long) (getopt-long))

11
module/scripts/scan-api.scm
View file

@ -1,6 +1,6 @@
;;; scan-api --- Scan and group interpreter and libguile interface elements
;; Copyright (C) 2002, 2006, 2011 Free Software Foundation, Inc.
;; Copyright (C) 2002, 2006, 2011, 2025 Free Software Foundation, Inc.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public License
@ -60,10 +60,11 @@
;;; Code:
(define-module (scripts scan-api)
:use-module (ice-9 popen)
:use-module (ice-9 rdelim)
:use-module (ice-9 regex)
:export (scan-api))
#:use-module (ice-9 object-properties)
#:use-module (ice-9 popen)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:export (scan-api))
(define %include-in-guild-list #f)
(define %summary "Generate an API description for a Guile extension.")

15
module/scripts/summarize-guile-TODO.scm
View file

@ -1,6 +1,6 @@
;;; summarize-guile-TODO --- Display Guile TODO list in various ways
;; Copyright (C) 2002, 2006, 2010, 2011 Free Software Foundation, Inc.
;; Copyright (C) 2002, 2006, 2010, 2011, 2025 Free Software Foundation, Inc.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public License
@ -66,12 +66,13 @@
(debug-enable 'backtrace)
(define-module (scripts summarize-guile-TODO)
:use-module (scripts read-text-outline)
:use-module (ice-9 getopt-long)
:autoload (srfi srfi-13) (string-tokenize) ; string library
:autoload (srfi srfi-14) (char-set) ; string library
:autoload (ice-9 common-list) (remove-if-not)
:export (summarize-guile-TODO))
#:use-module (scripts read-text-outline)
#:use-module (ice-9 getopt-long)
#:use-module (ice-9 object-properties)
#:autoload (srfi srfi-13) (string-tokenize) ; string library
#:autoload (srfi srfi-14) (char-set) ; string library
#:autoload (ice-9 common-list) (remove-if-not)
#:export (summarize-guile-TODO))
(define %include-in-guild-list #f)
(define %summary "A quaint relic of the past.")

3
module/srfi/srfi-64.scm
View file

@ -1,4 +1,4 @@
;;; Copyright (C) 2024 Tomas Volf <~@wolfsden.cz>
;;; Copyright (C) 2024, 2025 Tomas Volf <~@wolfsden.cz>
;;
;; This library is free software; you can redistribute it and/or
@ -27,6 +27,7 @@
#:use-module (ice-9 exceptions)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (ice-9 object-properties)
#:use-module (ice-9 pretty-print)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)