From 8e2e2ceb1745620bef318fc403b6dea2c590f318 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 4 Feb 2022 10:41:44 +0100 Subject: [PATCH] Deprecate symbol properties. * libguile/strings.c (scm_i_make_symbol): Remove 'props' argument. Use 3 words instead of 'scm_double_cell'. * libguile/strings.h: Adjust accordingly. * libguile/symbols.c (scm_i_str2symbol, scm_i_str2uninterned_symbol): Likewise. (scm_symbol_fref, scm_symbol_pref, scm_symbol_fset_x, scm_symbol_pset_x): Move to... * libguile/deprecated.c: ... here. Rewrite in terms of object properties. (symbol_function_slot, symbol_property_slot): New variables. * libguile/symbols.h (SCM_SYMBOL_FUNC, SCM_SET_SYMBOL_FUNC) (SCM_SYMBOL_PROPS, SCM_SET_SYMBOL_PROPS) (scm_symbol_fref, scm_symbol_pref, scm_symbol_fset_x) (scm_symbol_pset_x): Move to... * libguile/deprecated.h: ... here. Mark declarations as 'SCM_DEPRECATED'. * module/system/base/types.scm (cell->object): Remove 'props' field for %TC7-SYMBOL. * doc/ref/api-data.texi (Symbol Props): Remove. * NEWS: Update. --- NEWS | 8 ++++ doc/ref/api-data.texi | 81 +----------------------------------- libguile/deprecated.c | 52 +++++++++++++++++++++++ libguile/deprecated.h | 10 +++++ libguile/strings.c | 13 +++--- libguile/strings.h | 4 +- libguile/symbols.c | 54 ++---------------------- libguile/symbols.h | 11 +---- module/system/base/types.scm | 4 +- 9 files changed, 87 insertions(+), 150 deletions(-) diff --git a/NEWS b/NEWS index 17a4c3961..93eac87b8 100644 --- a/NEWS +++ b/NEWS @@ -175,6 +175,14 @@ SCM_SET_ARRAY_CONTIGUOUS_FLAG, SCM_CLR_ARRAY_CONTIGUOUS_FLAG, SCM_I_ARRAY_CONTP preprocessor interfaces, as they were internal and there is no longer a sensible way of using them. +** Deprecate symbol properties + +Symbols used to have a "function slot" and a "property slot", inherited +from Emacs Lisp and early Lisps, which one would access with +'symbol-pref', 'symbol-fref', 'symbol-pset!', and 'symbol-fset!'. These +procedures have been discouraged in favor of object properties; they are +now deprecated. This saves a few words of memory per symbol. + * Bug fixes ** Fix compilation of (ash x N), where N is a literal, at -O1 and below diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index b6c2c4d61..8658b9785 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000-2004, 2006-2017, 2019-2020 +@c Copyright (C) 1996, 1997, 2000-2004, 2006-2017, 2019-2020, 2022 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -4657,7 +4657,6 @@ which more below (@pxref{Symbol Variables}). * Symbol Keys:: Symbols as lookup keys. * Symbol Variables:: Symbols as denoting variables. * Symbol Primitives:: Operations related to symbols. -* Symbol Props:: Function slots and property lists. * Symbol Read Syntax:: Extended read syntax for symbols. * Symbol Uninterned:: Uninterned symbols. @end menu @@ -5028,84 +5027,6 @@ so. Uniqueness can be guaranteed by instead using uninterned symbols and read back in. -@node Symbol Props -@subsubsection Function Slots and Property Lists - -In traditional Lisp dialects, symbols are often understood as having -three kinds of value at once: - -@itemize @bullet -@item -a @dfn{variable} value, which is used when the symbol appears in -code in a variable reference context - -@item -a @dfn{function} value, which is used when the symbol appears in -code in a function name position (i.e.@: as the first element in an -unquoted list) - -@item -a @dfn{property list} value, which is used when the symbol is given as -the first argument to Lisp's @code{put} or @code{get} functions. -@end itemize - -Although Scheme (as one of its simplifications with respect to Lisp) -does away with the distinction between variable and function namespaces, -Guile currently retains some elements of the traditional structure in -case they turn out to be useful when implementing translators for other -languages, in particular Emacs Lisp. - -Specifically, Guile symbols have two extra slots, one for a symbol's -property list, and one for its ``function value.'' The following procedures -are provided to access these slots. - -@deffn {Scheme Procedure} symbol-fref symbol -@deffnx {C Function} scm_symbol_fref (symbol) -Return the contents of @var{symbol}'s @dfn{function slot}. -@end deffn - -@deffn {Scheme Procedure} symbol-fset! symbol value -@deffnx {C Function} scm_symbol_fset_x (symbol, value) -Set the contents of @var{symbol}'s function slot to @var{value}. -@end deffn - -@deffn {Scheme Procedure} symbol-pref symbol -@deffnx {C Function} scm_symbol_pref (symbol) -Return the @dfn{property list} currently associated with @var{symbol}. -@end deffn - -@deffn {Scheme Procedure} symbol-pset! symbol value -@deffnx {C Function} scm_symbol_pset_x (symbol, value) -Set @var{symbol}'s property list to @var{value}. -@end deffn - -@deffn {Scheme Procedure} symbol-property sym prop -From @var{sym}'s property list, return the value for property -@var{prop}. The assumption is that @var{sym}'s property list is an -association list whose keys are distinguished from each other using -@code{equal?}; @var{prop} should be one of the keys in that list. If -the property list has no entry for @var{prop}, @code{symbol-property} -returns @code{#f}. -@end deffn - -@deffn {Scheme Procedure} set-symbol-property! sym prop val -In @var{sym}'s property list, set the value for property @var{prop} to -@var{val}, or add a new entry for @var{prop}, with value @var{val}, if -none already exists. For the structure of the property list, see -@code{symbol-property}. -@end deffn - -@deffn {Scheme Procedure} symbol-property-remove! sym prop -From @var{sym}'s property list, remove the entry for property -@var{prop}, if there is one. For the structure of the property list, -see @code{symbol-property}. -@end deffn - -Support for these extra slots may be removed in a future release, and it -is probably better to avoid using them. For a more modern and Schemely -approach to properties, see @ref{Object Properties}. - - @node Symbol Read Syntax @subsubsection Extended Read Syntax for Symbols diff --git a/libguile/deprecated.c b/libguile/deprecated.c index 8622e3bb8..0df946482 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -41,6 +41,7 @@ #include "gc.h" #include "gsubr.h" #include "modules.h" +#include "objprop.h" #include "procprop.h" #include "srcprop.h" #include "srfi-4.h" @@ -677,6 +678,57 @@ scm_copy_tree (SCM obj) return scm_call_1 (scm_c_public_ref ("ice-9 copy-tree", "copy-tree"), obj); } + +/* Symbol properties. */ + +SCM_SYMBOL (symbol_function_slot, "symbol-function-slot"); +SCM_SYMBOL (symbol_property_slot, "symbol-property-slot"); + +SCM_DEFINE (scm_symbol_fref, "symbol-fref", 1, 0, 0, + (SCM s), + "Return the contents of the symbol @var{s}'s @dfn{function slot}.") +#define FUNC_NAME s_scm_symbol_fref +{ + SCM_VALIDATE_SYMBOL (1, s); + return scm_object_property (s, symbol_function_slot); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_symbol_pref, "symbol-pref", 1, 0, 0, + (SCM s), + "Return the @dfn{property list} currently associated with the\n" + "symbol @var{s}.") +#define FUNC_NAME s_scm_symbol_pref +{ + SCM result; + + SCM_VALIDATE_SYMBOL (1, s); + result = scm_object_property (s, symbol_property_slot); + return scm_is_false (result) ? SCM_EOL : result; +} +#undef FUNC_NAME + + +SCM_DEFINE (scm_symbol_fset_x, "symbol-fset!", 2, 0, 0, + (SCM s, SCM val), + "Change the binding of the symbol @var{s}'s function slot.") +#define FUNC_NAME s_scm_symbol_fset_x +{ + SCM_VALIDATE_SYMBOL (1, s); + return scm_set_object_property_x (s, symbol_function_slot, val); +} +#undef FUNC_NAME + + +SCM_DEFINE (scm_symbol_pset_x, "symbol-pset!", 2, 0, 0, + (SCM s, SCM val), + "Change the binding of the symbol @var{s}'s property slot.") +#define FUNC_NAME s_scm_symbol_pset_x +{ + SCM_VALIDATE_SYMBOL (1, s); + return scm_set_object_property_x (s, symbol_property_slot, val); +} +#undef FUNC_NAME diff --git a/libguile/deprecated.h b/libguile/deprecated.h index be5b55676..75a6e78e1 100644 --- a/libguile/deprecated.h +++ b/libguile/deprecated.h @@ -144,6 +144,16 @@ SCM_DEPRECATED SCM scm_make_srcprops (long line, int col, SCM filename, SCM_DEPRECATED SCM scm_copy_tree (SCM obj); +#define SCM_SYMBOL_FUNC(x) (scm_symbol_fref (x)) +#define SCM_SET_SYMBOL_FUNC(x,f) (scm_symbol_fset_x (x, f)) +#define SCM_SYMBOL_PROPS(x) (scm_symbol_pref (x)) +#define SCM_SET_SYMBOL_PROPS(x,p) (scm_symbol_pset_x (x, p)) + +SCM_DEPRECATED SCM scm_symbol_fref (SCM s); +SCM_DEPRECATED SCM scm_symbol_pref (SCM s); +SCM_DEPRECATED SCM scm_symbol_fset_x (SCM s, SCM val); +SCM_DEPRECATED SCM scm_symbol_pset_x (SCM s, SCM val); + SCM_DEPRECATED SCM scm_dynamic_unlink (SCM obj); /* Each bignum is just an mpz_t stored in a double cell starting at word 1. */ diff --git a/libguile/strings.c b/libguile/strings.c index 5eb92bb3f..a5b4b0386 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -760,16 +760,19 @@ scm_i_string_set_x (SCM str, size_t p, scm_t_wchar chr) #define SYMBOL_STRINGBUF SCM_CELL_OBJECT_1 SCM -scm_i_make_symbol (SCM name, scm_t_bits flags, - unsigned long hash, SCM props) +scm_i_make_symbol (SCM name, scm_t_bits flags, unsigned long hash) { - SCM buf; + SCM buf, symbol; size_t length = STRING_LENGTH (name); name = scm_i_substring_copy (name, 0, length); buf = STRING_STRINGBUF (name); - return scm_double_cell (scm_tc7_symbol | flags, SCM_UNPACK (buf), - (scm_t_bits) hash, SCM_UNPACK (props)); + + symbol = scm_words (scm_tc7_symbol | flags, 3); + SCM_SET_CELL_WORD_1 (symbol, SCM_UNPACK (buf)); + SCM_SET_CELL_WORD_2 (symbol, hash); + + return symbol; } /* Returns the number of characters in SYM. This may be different diff --git a/libguile/strings.h b/libguile/strings.h index e8f93ee0f..f28ef3246 100644 --- a/libguile/strings.h +++ b/libguile/strings.h @@ -1,7 +1,7 @@ #ifndef SCM_STRINGS_H #define SCM_STRINGS_H -/* Copyright 1995-1998,2000-2001,2004-2006,2008-2011,2013,2015-2019 +/* Copyright 1995-1998,2000-2001,2004-2006,2008-2011,2013,2015-2019,2022 Free Software Foundation, Inc. This file is part of Guile. @@ -250,7 +250,7 @@ SCM_INTERNAL void scm_i_string_set_x (SCM str, size_t p, scm_t_wchar chr); /* internal functions related to symbols. */ SCM_INTERNAL SCM scm_i_make_symbol (SCM name, scm_t_bits flags, - unsigned long hash, SCM props); + unsigned long hash); SCM_INTERNAL const char *scm_i_symbol_chars (SCM sym); SCM_INTERNAL const scm_t_wchar *scm_i_symbol_wide_chars (SCM sym); SCM_INTERNAL size_t scm_i_symbol_length (SCM sym); diff --git a/libguile/symbols.c b/libguile/symbols.c index b9d575778..02be7c1c4 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -1,4 +1,4 @@ -/* Copyright 1995-1998,2000-2001,2003-2004,2006,2009,2011,2013,2015,2018 +/* Copyright 1995-1998,2000-2001,2003-2004,2006,2009,2011,2013,2015,2018,2022 Free Software Foundation, Inc. This file is part of Guile. @@ -247,8 +247,7 @@ scm_i_str2symbol (SCM str) else { /* The symbol was not found, create it. */ - symbol = scm_i_make_symbol (str, 0, raw_hash, - scm_cons (SCM_BOOL_F, SCM_EOL)); + symbol = scm_i_make_symbol (str, 0, raw_hash); /* Might return a different symbol, if another one was interned at the same time. */ @@ -264,8 +263,7 @@ scm_i_str2uninterned_symbol (SCM str) { size_t raw_hash = scm_i_string_hash (str); - return scm_i_make_symbol (str, SCM_I_F_SYMBOL_UNINTERNED, - raw_hash, scm_cons (SCM_BOOL_F, SCM_EOL)); + return scm_i_make_symbol (str, SCM_I_F_SYMBOL_UNINTERNED, raw_hash); } SCM_DEFINE (scm_symbol_p, "symbol?", 1, 0, 0, @@ -421,52 +419,6 @@ SCM_DEFINE (scm_symbol_hash, "symbol-hash", 1, 0, 0, } #undef FUNC_NAME -SCM_DEFINE (scm_symbol_fref, "symbol-fref", 1, 0, 0, - (SCM s), - "Return the contents of the symbol @var{s}'s @dfn{function slot}.") -#define FUNC_NAME s_scm_symbol_fref -{ - SCM_VALIDATE_SYMBOL (1, s); - return SCM_CAR (SCM_CELL_OBJECT_3 (s)); -} -#undef FUNC_NAME - - -SCM_DEFINE (scm_symbol_pref, "symbol-pref", 1, 0, 0, - (SCM s), - "Return the @dfn{property list} currently associated with the\n" - "symbol @var{s}.") -#define FUNC_NAME s_scm_symbol_pref -{ - SCM_VALIDATE_SYMBOL (1, s); - return SCM_CDR (SCM_CELL_OBJECT_3 (s)); -} -#undef FUNC_NAME - - -SCM_DEFINE (scm_symbol_fset_x, "symbol-fset!", 2, 0, 0, - (SCM s, SCM val), - "Change the binding of the symbol @var{s}'s function slot.") -#define FUNC_NAME s_scm_symbol_fset_x -{ - SCM_VALIDATE_SYMBOL (1, s); - scm_set_car_x (SCM_CELL_OBJECT_3 (s), val); - return SCM_UNSPECIFIED; -} -#undef FUNC_NAME - - -SCM_DEFINE (scm_symbol_pset_x, "symbol-pset!", 2, 0, 0, - (SCM s, SCM val), - "Change the binding of the symbol @var{s}'s property slot.") -#define FUNC_NAME s_scm_symbol_pset_x -{ - SCM_VALIDATE_SYMBOL (1, s); - scm_set_cdr_x (SCM_CELL_OBJECT_3 (s), val); - return SCM_UNSPECIFIED; -} -#undef FUNC_NAME - SCM scm_from_locale_symbol (const char *sym) { diff --git a/libguile/symbols.h b/libguile/symbols.h index e2a1d173f..e8bc3346f 100644 --- a/libguile/symbols.h +++ b/libguile/symbols.h @@ -1,7 +1,7 @@ #ifndef SCM_SYMBOLS_H #define SCM_SYMBOLS_H -/* Copyright 1995-1998,2000-2001,2003-2004,2006,2008,2010-2011,2018 +/* Copyright 1995-1998,2000-2001,2003-2004,2006,2008,2010-2011,2018,2022 Free Software Foundation, Inc. This file is part of Guile. @@ -80,10 +80,6 @@ SCM_SNARF_INIT(c_name = scm_from_utf8_symbol (scheme_name)) /* Older spellings; don't use in new code. */ #define SCM_SYMBOLP(x) (scm_is_symbol (x)) -#define SCM_SYMBOL_FUNC(x) (scm_symbol_fref (x)) -#define SCM_SET_SYMBOL_FUNC(x,f) (scm_symbol_fset_x (x, f)) -#define SCM_SYMBOL_PROPS(x) (scm_symbol_pref (x)) -#define SCM_SET_SYMBOL_PROPS(x,p) (scm_symbol_pset_x (x, p)) #define SCM_SYMBOL_HASH(x) (scm_i_symbol_hash (x)) #define SCM_SYMBOL_INTERNED_P(x) (scm_i_symbol_is_interned (x)) @@ -100,11 +96,6 @@ SCM_API SCM scm_symbol_to_string (SCM s); SCM_API SCM scm_string_to_symbol (SCM s); SCM_API SCM scm_string_ci_to_symbol (SCM s); -SCM_API SCM scm_symbol_fref (SCM s); -SCM_API SCM scm_symbol_pref (SCM s); -SCM_API SCM scm_symbol_fset_x (SCM s, SCM val); -SCM_API SCM scm_symbol_pset_x (SCM s, SCM val); - SCM_API SCM scm_symbol_hash (SCM s); SCM_API SCM scm_gensym (SCM prefix); diff --git a/module/system/base/types.scm b/module/system/base/types.scm index 418c9fed4..b63febff8 100644 --- a/module/system/base/types.scm +++ b/module/system/base/types.scm @@ -1,5 +1,5 @@ ;;; 'SCM' type tag decoding. -;;; Copyright (C) 2014, 2015, 2017, 2018 Free Software Foundation, Inc. +;;; Copyright (C) 2014, 2015, 2017, 2018, 2022 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 @@ -397,7 +397,7 @@ using BACKEND." (address->inferior-struct address (- vtable-address %tc3-struct) backend)) - (((_ & #x7f = %tc7-symbol) buf hash props) + (((_ & #x7f = %tc7-symbol) buf hash) (match (cell->object buf backend) (($ string) (string->symbol string))))