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

Add srfi-14-internal.h

Browse source 
* libguile/srfi-14-internal.h: New file.
* libguile/Makefile.am (noinst_HEADERS): Add file.
* libguile/srfi-14.h: Remove internal definitions.
* libguile/init.c:
* libguile/srfi-14.c:
* libguile/eq.c:
* libguile/print.c: Use internal file.
This commit is contained in:
Andy Wingo 2025-06-30 15:43:56 +02:00
parent c66668a87a
commit 7c13e983b3
7 changed files with 84 additions and 56 deletions
Download patch file Download diff file Expand all files Collapse all files

1
libguile/Makefile.am
View file

@ -532,6 +532,7 @@ noinst_HEADERS = atomic.h \
ports-internal.h \
regex-posix.h \
smob-internal.h \
srfi-14-internal.h \
strings-internal.h \
syntax.h \
threads-internal.h \

2
libguile/eq.c
View file

@ -39,7 +39,7 @@
#include "pairs.h"
#include "private-options.h"
#include "smob.h"
#include "srfi-14.h"
#include "srfi-14-internal.h"
#include "stackchk.h"
#include "strorder.h"
#include "struct.h"

2
libguile/init.c
View file

@ -121,7 +121,7 @@
#include "socket.h"
#include "sort.h"
#include "srfi-13.h"
#include "srfi-14.h"
#include "srfi-14-internal.h"
#include "srfi-4.h"
#include "srfi-60.h"
#include "stackchk.h"

2
libguile/print.c
View file

@ -62,7 +62,7 @@
#include "programs.h"
#include "read.h"
#include "smob.h"
#include "srfi-14.h"
#include "srfi-14-internal.h"
#include "strings-internal.h"
#include "strports.h"
#include "struct.h"

78
libguile/srfi-14-internal.h Normal file
View file

@ -0,0 +1,78 @@
#ifndef SCM_SRFI_14_INTERNAL_H
#define SCM_SRFI_14_INTERNAL_H
/* srfi-14.c --- SRFI-14 procedures for Guile
Copyright 2001,2004,2006,2008,2011,2018,2025
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/srfi-14.h"
typedef struct scm_char_range
{
scm_t_wchar lo;
scm_t_wchar hi;
} scm_t_char_range;
/* We call this "charset" instead of "char_set" to avoid confusion with
"set" as a verb. */
struct scm_charset
{
scm_t_bits tag_and_flags;
struct scm_bytevector *ranges;
};
static inline struct scm_charset*
scm_to_charset (SCM scm)
{
if (!scm_is_char_set (scm)) abort();
return (struct scm_charset *) SCM_UNPACK_POINTER (scm);
}
static inline SCM
scm_from_charset (struct scm_charset *s)
{
return SCM_PACK_POINTER (s);
}
static const scm_t_bits SCM_CHARSET_F_IMMUTABLE = 1 << 16;
static inline int
scm_charset_is_immutable (SCM charset)
{
return scm_to_charset (charset)->tag_and_flags & SCM_CHARSET_F_IMMUTABLE;
}
#define SCM_VALIDATE_CHARSET(pos, x) \
do { \
SCM_ASSERT_TYPE (SCM_CHARSETP (x), x, pos, FUNC_NAME, "charset"); \
} while (0)
#define SCM_VALIDATE_MUTABLE_CHARSET(pos, x) \
do { \
SCM_ASSERT_TYPE (SCM_CHARSETP (x) && !scm_charset_is_immutable (x), \
x, pos, FUNC_NAME, "mutable charset"); \
} while (0)
SCM_INTERNAL int scm_i_char_sets_equal (SCM a, SCM b);
SCM_INTERNAL int scm_i_print_char_set (SCM charset, SCM port,
scm_print_state *pstate);
SCM_INTERNAL void scm_boot_srfi_14 (void);
#endif /* SCM_SRFI_14_INTERNAL_H */

50
libguile/srfi-14.c
View file

@ -43,39 +43,12 @@
#include "values.h"
#include "version.h"
#include "srfi-14.h"
#include "srfi-14-internal.h"
typedef struct scm_char_range
{
scm_t_wchar lo;
scm_t_wchar hi;
} scm_t_char_range;
/* Include the pre-computed standard charset data. */
#include "srfi-14.i.c"
/* We call this "charset" instead of "char_set" to avoid confusion with
"set" as a verb. */
struct scm_charset
{
scm_t_bits tag_and_flags;
struct scm_bytevector *ranges;
};
static inline struct scm_charset*
scm_to_charset (SCM scm)
{
if (!scm_is_char_set (scm)) abort();
return (struct scm_charset *) SCM_UNPACK_POINTER (scm);
}
static inline SCM
scm_from_charset (struct scm_charset *s)
{
return SCM_PACK_POINTER (s);
}
static inline scm_t_char_range*
char_ranges (struct scm_bytevector *bv)
{
@ -131,25 +104,6 @@ charset_range_contains (struct scm_charset *s, size_t idx, scm_t_wchar c)
return range->lo <= c && c <= range->hi;
}
static const scm_t_bits SCM_CHARSET_F_IMMUTABLE = 1 << 16;
static inline int
charset_is_immutable (SCM charset)
{
return scm_to_charset (charset)->tag_and_flags & SCM_CHARSET_F_IMMUTABLE;
}
#define SCM_VALIDATE_CHARSET(pos, x) \
do { \
SCM_ASSERT_TYPE (SCM_CHARSETP (x), x, pos, FUNC_NAME, "charset"); \
} while (0)
#define SCM_VALIDATE_MUTABLE_CHARSET(pos, x) \
do { \
SCM_ASSERT_TYPE (SCM_CHARSETP (x) && !charset_is_immutable (x), \
x, pos, FUNC_NAME, "mutable charset"); \
} while (0)
static const scm_t_char_range cs_full_ranges[] = {
{0x0000, SCM_CODEPOINT_SURROGATE_START - 1},
{SCM_CODEPOINT_SURROGATE_END + 1, SCM_CODEPOINT_MAX}
@ -691,7 +645,7 @@ SCM_DEFINE_STATIC (scm_charset_mutable_p, "charset-mutable?", 1, 0, 0,
#define FUNC_NAME s_scm_char_set_p
{
SCM_VALIDATE_CHARSET (1, cs);
return scm_from_bool (!charset_is_immutable (cs));
return scm_from_bool (!scm_charset_is_immutable (cs));
}
#undef FUNC_NAME

5
libguile/srfi-14.h
View file

@ -94,9 +94,4 @@ SCM_API SCM scm_char_set_ascii;
SCM_API SCM scm_char_set_empty;
SCM_API SCM scm_char_set_full;
SCM_INTERNAL int scm_i_char_sets_equal (SCM a, SCM b);
SCM_INTERNAL int scm_i_print_char_set (SCM charset, SCM port,
scm_print_state *pstate);
SCM_INTERNAL void scm_boot_srfi_14 (void);
#endif /* SCM_SRFI_14_H */