wingo pushed a commit to branch wip-whippet
in repository guile.
commit 08f991b85657b52fe74454c62836c5059739af23
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Tue Jul 15 12:43:15 2025 +0200
Add (srfi srfi-14 gnu), for char-set:designated
* module/srfi/srfi-14/gnu.scm: New file.
* am/bootstrap.am (SOURCES): Add.
* libguile/srfi-14.c: Adapt to register char-set:designated in the right
place.
* module/ice-9/deprecated.scm: Provide the right deprecation shims.
* module/ice-9/sandbox.scm: Update expected location for
char-set:designated.
---
am/bootstrap.am | 1 +
libguile/srfi-14.c | 19 +++++++++++++++----
module/ice-9/deprecated.scm | 4 ++++
module/ice-9/sandbox.scm | 5 +++--
module/srfi/srfi-14/gnu.scm | 31 +++++++++++++++++++++++++++++++
5 files changed, 54 insertions(+), 6 deletions(-)
diff --git a/am/bootstrap.am b/am/bootstrap.am
index 48134cfd5..6851d5cf4 100644
--- a/am/bootstrap.am
+++ b/am/bootstrap.am
@@ -328,6 +328,7 @@ SOURCES = \
srfi/srfi-11.scm \
srfi/srfi-13.scm \
srfi/srfi-14.scm \
+ srfi/srfi-14/gnu.scm \
srfi/srfi-16.scm \
srfi/srfi-17.scm \
srfi/srfi-18.scm \
diff --git a/libguile/srfi-14.c b/libguile/srfi-14.c
index 9e193b7e3..8840cbabf 100644
--- a/libguile/srfi-14.c
+++ b/libguile/srfi-14.c
@@ -1906,16 +1906,26 @@ SCM_DEFINE (scm_sys_char_set_dump, "%char-set-dump", 1,
0, 0, (SCM charset),
M ("designated", designated) \
M ("full", full)
+#define FOR_EACH_EXTENDED_CHARSET(M) \
+ M ("designated", designated)
+
FOR_EACH_STANDARD_CHARSET(DECLARE_C_CHARSET)
+FOR_EACH_EXTENDED_CHARSET(DECLARE_C_CHARSET)
static void
-scm_init_srfi_14 (void)
+scm_init_srfi_14 (void *unused)
{
FOR_EACH_STANDARD_CHARSET (DEFINE_SCM_CHARSET);
#include "srfi-14.x"
}
+static void
+scm_init_srfi_14_gnu (void *unused)
+{
+ FOR_EACH_EXTENDED_CHARSET (DEFINE_SCM_CHARSET);
+}
+
void
scm_boot_srfi_14 (void)
{
@@ -1923,11 +1933,12 @@ scm_boot_srfi_14 (void)
scm_i_make_typed_bytevector (0, SCM_ARRAY_ELEMENT_TYPE_U32);
FOR_EACH_STANDARD_CHARSET (DEFINE_C_CHARSET);
+ FOR_EACH_EXTENDED_CHARSET (DEFINE_C_CHARSET);
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
- "scm_init_srfi_14",
- (scm_t_extension_init_func) scm_init_srfi_14,
- NULL);
+ "scm_init_srfi_14", scm_init_srfi_14, NULL);
+ scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
+ "scm_init_srfi_14_gnu", scm_init_srfi_14_gnu,
NULL);
}
/* End of srfi-14.c. */
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index 64ceb7575..d9bd4f2b9 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -27,6 +27,7 @@
#:use-module (system repl hooks)
#:use-module (system repl reader)
#:use-module (srfi srfi-14)
+ #:use-module (srfi srfi-14 gnu)
#:export ((make-guardian* . make-guardian)
module-observe-weak
(make-object-property* . make-object-property)
@@ -114,6 +115,7 @@
(char-set:ascii* . char-set:ascii)
(char-set:empty* . char-set:empty)
(char-set:full* . char-set:full)
+ (char-set:designated* . char-set:designated)
(abort-hook* . abort-hook)
(before-backtrace-hook* . before-backtrace-hook)
(after-backtrace-hook* . after-backtrace-hook)
@@ -339,6 +341,8 @@
char-set:ascii
char-set:empty
char-set:full)
+(define-deprecated*/stx (srfi srfi-14 gnu)
+ char-set:designated)
(define-deprecated*/stx (system repl hooks)
before-error-hook
diff --git a/module/ice-9/sandbox.scm b/module/ice-9/sandbox.scm
index 3a441402b..20d27fb29 100644
--- a/module/ice-9/sandbox.scm
+++ b/module/ice-9/sandbox.scm
@@ -754,7 +754,6 @@ allocation limit is exceeded, an exception will be thrown
to the
char-set-xor
char-set:ascii
char-set:blank
- char-set:designated
char-set:digit
char-set:empty
char-set:full
@@ -776,7 +775,9 @@ allocation limit is exceeded, an exception will be thrown
to the
end-of-char-set?
list->char-set
string->char-set
- ucs-range->char-set)))
+ ucs-range->char-set)
+ ((srfi srfi-14 gnu)
+ char-set:designated)))
;; These can only form part of a safe binding set if no mutable char-set
;; is exposed to the sandbox. Unfortunately all charsets in Guile are
diff --git a/module/srfi/srfi-14/gnu.scm b/module/srfi/srfi-14/gnu.scm
new file mode 100644
index 000000000..a2437aa31
--- /dev/null
+++ b/module/srfi/srfi-14/gnu.scm
@@ -0,0 +1,31 @@
+;;; Copyright (C) 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
+;;; 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 program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;;
+;;; Provide char-set:designated, a standard charset not supplied in
+;;; SRFI-14.
+;;;
+;;; Code:
+
+(define-module (srfi srfi-14 gnu)
+ ;; FIXME: Use #:export instead of #:replace once deprecated bindings
+ ;; are removed.
+ #:replace (char-set:designated))
+
+(eval-when (expand load eval)
+ (load-extension (string-append "libguile-" (effective-version))
+ "scm_init_srfi_14_gnu"))
