mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-07-01 23:30:28 +02:00
Move char-set-cursor implementation to Scheme
Also deprecate the C interface. * libguile/deprecated.h: * libguile/deprecated.c (scm_char_set_cursor): (scm_char_set_ref): (scm_char_set_cursor_next): (scm_end_of_char_set_p): Deprecate. * libguile/srfi-14.c (charset-mutable?, char-set-ranges) (charset-set-ranges!): New accessors, exposed internally to srfi-14.scm. * libguile/srfi-14.c (scm_boot_srfi_14): Remove scm_tc16_charset_cursor. * module/srfi/srfi-14.scm (<char-set-cursor>): Implement as a record.
This commit is contained in:
Andy Wingo
parent
4516119dd1
commit
7a1406891f
5 changed files with 182 additions and 158 deletions
|
|
@ -63,12 +63,6 @@ struct scm_charset
|
|||
struct scm_bytevector *ranges;
|
||||
};
|
||||
|
||||
typedef struct
|
||||
{
|
||||
size_t range;
|
||||
scm_t_wchar n;
|
||||
} scm_t_char_set_cursor;
|
||||
|
||||
static inline struct scm_charset*
|
||||
scm_to_charset (SCM scm)
|
||||
{
|
||||
|
|
@ -680,29 +674,6 @@ scm_i_print_char_set (SCM charset, SCM port, scm_print_state *pstate SCM_UNUSED)
|
|||
return 1;
|
||||
}
|
||||
|
||||
/* Smob print hook for character sets cursors. */
|
||||
int scm_tc16_charset_cursor = 0;
|
||||
static int
|
||||
charset_cursor_print (SCM cursor, SCM port,
|
||||
scm_print_state *pstate SCM_UNUSED)
|
||||
{
|
||||
scm_t_char_set_cursor *cur;
|
||||
|
||||
cur = (scm_t_char_set_cursor *) SCM_SMOB_DATA (cursor);
|
||||
|
||||
scm_puts ("#<charset-cursor ", port);
|
||||
if (cur->range == (size_t) (-1))
|
||||
scm_puts ("(empty)", port);
|
||||
else
|
||||
{
|
||||
scm_write (scm_from_size_t (cur->range), port);
|
||||
scm_puts (":", port);
|
||||
scm_write (scm_from_int32 (cur->n), port);
|
||||
}
|
||||
scm_puts (">", port);
|
||||
return 1;
|
||||
}
|
||||
|
||||
SCM_DEFINE (scm_char_set_p, "char-set?", 1, 0, 0,
|
||||
(SCM obj),
|
||||
"Return @code{#t} if @var{obj} is a character set, @code{#f}\n"
|
||||
|
|
@ -713,6 +684,46 @@ SCM_DEFINE (scm_char_set_p, "char-set?", 1, 0, 0,
|
|||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE_STATIC (scm_charset_mutable_p, "charset-mutable?", 1, 0, 0,
|
||||
(SCM cs),
|
||||
"Return @code{#t} if the character set @var{cs} is mutable,\n"
|
||||
"@code{#f} otherwise.")
|
||||
#define FUNC_NAME s_scm_char_set_p
|
||||
{
|
||||
SCM_VALIDATE_CHARSET (1, cs);
|
||||
return scm_from_bool (!charset_is_immutable (cs));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE_STATIC (scm_charset_ranges, "charset-ranges", 1, 0, 0,
|
||||
(SCM cs),
|
||||
"Return the {lo, hi} packed sorted array of inclusive\n"
|
||||
"ranges of the character set @var{cs}, as a u32vector.")
|
||||
#define FUNC_NAME s_scm_char_set_p
|
||||
{
|
||||
SCM_VALIDATE_CHARSET (1, cs);
|
||||
return scm_from_bytevector (scm_to_charset (cs)->ranges);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE_STATIC (scm_charset_set_ranges_x, "charset-set-ranges!", 2, 0, 0,
|
||||
(SCM cs, SCM ranges),
|
||||
"Replace the {lo, hi} packed sorted array of inclusive\n"
|
||||
"ranges of the character set @var{cs} with the given\n"
|
||||
"u32vector.")
|
||||
#define FUNC_NAME s_scm_char_set_p
|
||||
{
|
||||
SCM_VALIDATE_MUTABLE_CHARSET (1, cs);
|
||||
SCM_VALIDATE_BYTEVECTOR (2, ranges);
|
||||
struct scm_bytevector *bv = scm_to_bytevector (ranges);
|
||||
SCM_ASSERT_TYPE
|
||||
((bv->length % sizeof (scm_t_char_range)) == 0
|
||||
&& scm_bytevector_element_type (bv) == SCM_ARRAY_ELEMENT_TYPE_U32,
|
||||
ranges, 2, FUNC_NAME, "char ranges");
|
||||
scm_to_charset (cs)->ranges = bv;
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
int
|
||||
scm_i_char_sets_equal (SCM a, SCM b)
|
||||
|
|
@ -817,128 +828,6 @@ SCM_DEFINE (scm_char_set_hash, "char-set-hash", 1, 1, 0,
|
|||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_char_set_cursor, "char-set-cursor", 1, 0, 0,
|
||||
(SCM cs), "Return a cursor into the character set @var{cs}.")
|
||||
#define FUNC_NAME s_scm_char_set_cursor
|
||||
{
|
||||
struct scm_charset *cs_data;
|
||||
scm_t_char_set_cursor *cur_data;
|
||||
|
||||
SCM_VALIDATE_CHARSET (1, cs);
|
||||
cs_data = scm_to_charset (cs);
|
||||
cur_data =
|
||||
(scm_t_char_set_cursor *) scm_gc_malloc (sizeof (scm_t_char_set_cursor),
|
||||
"charset-cursor");
|
||||
if (charset_len (cs_data) == 0)
|
||||
{
|
||||
cur_data->range = (size_t) (-1);
|
||||
cur_data->n = 0;
|
||||
}
|
||||
else
|
||||
{
|
||||
cur_data->range = 0;
|
||||
cur_data->n = charset_range_lo (cs_data, 0);
|
||||
}
|
||||
SCM_RETURN_NEWSMOB (scm_tc16_charset_cursor, cur_data);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_char_set_ref, "char-set-ref", 2, 0, 0,
|
||||
(SCM cs, SCM cursor),
|
||||
"Return the character at the current cursor position\n"
|
||||
"@var{cursor} in the character set @var{cs}. It is an error to\n"
|
||||
"pass a cursor for which @code{end-of-char-set?} returns true.")
|
||||
#define FUNC_NAME s_scm_char_set_ref
|
||||
{
|
||||
struct scm_charset *cs_data;
|
||||
scm_t_char_set_cursor *cur_data;
|
||||
size_t i;
|
||||
|
||||
SCM_VALIDATE_CHARSET (1, cs);
|
||||
SCM_VALIDATE_SMOB (2, cursor, charset_cursor);
|
||||
|
||||
cs_data = scm_to_charset (cs);
|
||||
cur_data = (scm_t_char_set_cursor *) SCM_SMOB_DATA (cursor);
|
||||
|
||||
/* Validate that this cursor is still true. */
|
||||
i = cur_data->range;
|
||||
if (i == (size_t) (-1)
|
||||
|| i >= charset_len (cs_data)
|
||||
|| cur_data->n < charset_range_lo (cs_data, i)
|
||||
|| cur_data->n > charset_range_hi (cs_data, i))
|
||||
SCM_MISC_ERROR ("invalid character set cursor: ~A", scm_list_1 (cursor));
|
||||
return SCM_MAKE_CHAR (cur_data->n);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_char_set_cursor_next, "char-set-cursor-next", 2, 0, 0,
|
||||
(SCM cs, SCM cursor),
|
||||
"Advance the character set cursor @var{cursor} to the next\n"
|
||||
"character in the character set @var{cs}. It is an error if the\n"
|
||||
"cursor given satisfies @code{end-of-char-set?}.")
|
||||
#define FUNC_NAME s_scm_char_set_cursor_next
|
||||
{
|
||||
struct scm_charset *cs_data;
|
||||
scm_t_char_set_cursor *cur_data;
|
||||
size_t i;
|
||||
|
||||
SCM_VALIDATE_CHARSET (1, cs);
|
||||
SCM_VALIDATE_SMOB (2, cursor, charset_cursor);
|
||||
|
||||
cs_data = scm_to_charset (cs);
|
||||
cur_data = (scm_t_char_set_cursor *) SCM_SMOB_DATA (cursor);
|
||||
|
||||
/* Validate that this cursor is still true. */
|
||||
i = cur_data->range;
|
||||
if (i == (size_t) (-1)
|
||||
|| i >= charset_len (cs_data)
|
||||
|| !charset_range_contains (cs_data, i, cur_data->n))
|
||||
SCM_MISC_ERROR ("invalid character set cursor: ~A", scm_list_1 (cursor));
|
||||
/* Increment the cursor. */
|
||||
if (cur_data->n == charset_range_hi (cs_data, i))
|
||||
{
|
||||
if (i + 1 < charset_len (cs_data))
|
||||
{
|
||||
cur_data->range = i + 1;
|
||||
cur_data->n = charset_range_lo (cs_data, i + 1);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* This is the end of the road. */
|
||||
cur_data->range = (size_t) (-1);
|
||||
cur_data->n = 0;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
cur_data->n = cur_data->n + 1;
|
||||
}
|
||||
|
||||
return cursor;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_end_of_char_set_p, "end-of-char-set?", 1, 0, 0,
|
||||
(SCM cursor),
|
||||
"Return @code{#t} if @var{cursor} has reached the end of a\n"
|
||||
"character set, @code{#f} otherwise.")
|
||||
#define FUNC_NAME s_scm_end_of_char_set_p
|
||||
{
|
||||
scm_t_char_set_cursor *cur_data;
|
||||
SCM_VALIDATE_SMOB (1, cursor, charset_cursor);
|
||||
|
||||
cur_data = (scm_t_char_set_cursor *) SCM_SMOB_DATA (cursor);
|
||||
if (cur_data->range == (size_t) (-1))
|
||||
return SCM_BOOL_T;
|
||||
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_char_set_fold, "char-set-fold", 3, 0, 0,
|
||||
(SCM kons, SCM knil, SCM cs),
|
||||
"Fold the procedure @var{kons} over the character set @var{cs},\n"
|
||||
|
|
@ -2079,9 +1968,6 @@ scm_boot_srfi_14 (void)
|
|||
empty_charset_ranges =
|
||||
scm_i_make_typed_bytevector (0, SCM_ARRAY_ELEMENT_TYPE_U32);
|
||||
|
||||
scm_tc16_charset_cursor = scm_make_smob_type ("char-set-cursor", 0);
|
||||
scm_set_smob_print (scm_tc16_charset_cursor, charset_cursor_print);
|
||||
|
||||
FOR_EACH_STANDARD_CHARSET (DEFINE_C_CHARSET);
|
||||
|
||||
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue