summaryrefslogtreecommitdiff
path: root/libguile/srfi-14.c
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2009-08-28 19:01:19 +0200
committerLudovic Courtès <ludo@gnu.org>2009-08-28 19:16:46 +0200
commit7af531508c5931261ff8957708642cac67bf86a5 (patch)
treebd36d27d9f7a11d954093d4121ccb9e645f5c59f /libguile/srfi-14.c
parentf86f3b5b113b4cb383c531150b13bef9b2789221 (diff)
parentce3ed0125fcfb9ad09da815f133a2320102d164c (diff)
downloadguile-7af531508c5931261ff8957708642cac67bf86a5.tar.gz
Merge branch 'master' into boehm-demers-weiser-gc
Conflicts: libguile/Makefile.am libguile/bytevectors.c libguile/gc-card.c libguile/gc-mark.c libguile/programs.c libguile/srcprop.c libguile/srfi-14.c libguile/symbols.c libguile/threads.c libguile/unif.c libguile/vm.c
Diffstat (limited to 'libguile/srfi-14.c')
-rw-r--r--libguile/srfi-14.c1477
1 files changed, 928 insertions, 549 deletions
diff --git a/libguile/srfi-14.c b/libguile/srfi-14.c
index 0d614f6d9..7c0013193 100644
--- a/libguile/srfi-14.c
+++ b/libguile/srfi-14.c
@@ -24,59 +24,511 @@
#include <string.h>
-#include <ctype.h>
+#include <unictype.h>
#include "libguile.h"
#include "libguile/srfi-14.h"
+#include "libguile/strings.h"
+/* Include the pre-computed standard charset data. */
+#include "libguile/srfi-14.i.c"
-#define SCM_CHARSET_SET(cs, idx) \
- (((long *) SCM_SMOB_DATA (cs))[(idx) / SCM_BITS_PER_LONG] |= \
- (1L << ((idx) % SCM_BITS_PER_LONG)))
+#define SCM_CHARSET_DATA(charset) ((scm_t_char_set *) SCM_SMOB_DATA (charset))
-#define SCM_CHARSET_UNSET(cs, idx) \
- (((long *) SCM_SMOB_DATA (cs))[(idx) / SCM_BITS_PER_LONG] &= \
- (~(1L << ((idx) % SCM_BITS_PER_LONG))))
-
-#define BYTES_PER_CHARSET (SCM_CHARSET_SIZE / 8)
-#define LONGS_PER_CHARSET (SCM_CHARSET_SIZE / SCM_BITS_PER_LONG)
+#define SCM_CHARSET_SET(cs, idx) \
+ scm_i_charset_set (SCM_CHARSET_DATA (cs), idx)
+#define SCM_CHARSET_UNSET(cs, idx) \
+ scm_i_charset_unset (SCM_CHARSET_DATA (cs), idx)
/* Smob type code for character sets. */
int scm_tc16_charset = 0;
+int scm_tc16_charset_cursor = 0;
+
+/* True if N exists in charset CS. */
+int
+scm_i_charset_get (scm_t_char_set *cs, scm_t_wchar n)
+{
+ size_t i;
+
+ i = 0;
+ while (i < cs->len)
+ {
+ if (cs->ranges[i].lo <= n && n <= cs->ranges[i].hi)
+ return 1;
+ i++;
+ }
+
+ return 0;
+}
+
+/* Put N into charset CS. */
+void
+scm_i_charset_set (scm_t_char_set *cs, scm_t_wchar n)
+{
+ size_t i;
+ size_t len;
+
+ len = cs->len;
+
+ i = 0;
+ while (i < len)
+ {
+ /* Already in this range */
+ if (cs->ranges[i].lo <= n && n <= cs->ranges[i].hi)
+ {
+ return;
+ }
+
+ if (n == cs->ranges[i].lo - 1)
+ {
+ /* This char is one below the current range. */
+ if (i > 0 && cs->ranges[i - 1].hi + 1 == n)
+ {
+ /* It is also one above the previous range, so combine them. */
+ cs->ranges[i - 1].hi = cs->ranges[i].hi;
+ if (i < len - 1)
+ memmove (cs->ranges + i, cs->ranges + (i + 1),
+ sizeof (scm_t_char_range) * (len - i - 1));
+ cs->ranges = scm_gc_realloc (cs->ranges,
+ sizeof (scm_t_char_range) * len,
+ sizeof (scm_t_char_range) * (len -
+ 1),
+ "character-set");
+ cs->len = len - 1;
+ return;
+ }
+ else
+ {
+ /* Expand the range down by one. */
+ cs->ranges[i].lo = n;
+ return;
+ }
+ }
+ else if (n == cs->ranges[i].hi + 1)
+ {
+ /* This char is one above the current range. */
+ if (i < len - 1 && cs->ranges[i + 1].lo - 1 == n)
+ {
+ /* It is also one below the next range, so combine them. */
+ cs->ranges[i].hi = cs->ranges[i + 1].hi;
+ if (i < len - 2)
+ memmove (cs->ranges + (i + 1), cs->ranges + (i + 2),
+ sizeof (scm_t_char_range) * (len - i - 2));
+ cs->ranges = scm_gc_realloc (cs->ranges,
+ sizeof (scm_t_char_range) * len,
+ sizeof (scm_t_char_range) * (len -
+ 1),
+ "character-set");
+ cs->len = len - 1;
+ return;
+ }
+ else
+ {
+ /* Expand the range up by one. */
+ cs->ranges[i].hi = n;
+ return;
+ }
+ }
+ else if (n < cs->ranges[i].lo - 1)
+ {
+ /* This is a new range below the current one. */
+ cs->ranges = scm_gc_realloc (cs->ranges,
+ sizeof (scm_t_char_range) * len,
+ sizeof (scm_t_char_range) * (len + 1),
+ "character-set");
+ memmove (cs->ranges + (i + 1), cs->ranges + i,
+ sizeof (scm_t_char_range) * (len - i));
+ cs->ranges[i].lo = n;
+ cs->ranges[i].hi = n;
+ cs->len = len + 1;
+ return;
+ }
+
+ i++;
+ }
+
+ /* This is a new range above all previous ranges. */
+ if (len == 0)
+ {
+ cs->ranges = scm_gc_malloc (sizeof (scm_t_char_range), "character-set");
+ }
+ else
+ {
+ cs->ranges = scm_gc_realloc (cs->ranges,
+ sizeof (scm_t_char_range) * len,
+ sizeof (scm_t_char_range) * (len + 1),
+ "character-set");
+ }
+ cs->ranges[len].lo = n;
+ cs->ranges[len].hi = n;
+ cs->len = len + 1;
+
+ return;
+}
+
+/* If N is in charset CS, remove it. */
+void
+scm_i_charset_unset (scm_t_char_set *cs, scm_t_wchar n)
+{
+ size_t i;
+ size_t len;
+
+ len = cs->len;
+
+ i = 0;
+ while (i < len)
+ {
+ if (n < cs->ranges[i].lo)
+ /* Not in this set. */
+ return;
+
+ if (n == cs->ranges[i].lo && n == cs->ranges[i].hi)
+ {
+ /* Remove this one-character range. */
+ if (len == 1)
+ {
+ scm_gc_free (cs->ranges,
+ sizeof (scm_t_char_range) * cs->len,
+ "character-set");
+ cs->ranges = NULL;
+ cs->len = 0;
+ return;
+ }
+ else if (i < len - 1)
+ {
+ memmove (cs->ranges + i, cs->ranges + (i + 1),
+ sizeof (scm_t_char_range) * (len - i - 1));
+ cs->ranges = scm_gc_realloc (cs->ranges,
+ sizeof (scm_t_char_range) * len,
+ sizeof (scm_t_char_range) * (len -
+ 1),
+ "character-set");
+ cs->len = len - 1;
+ return;
+ }
+ else if (i == len - 1)
+ {
+ cs->ranges = scm_gc_realloc (cs->ranges,
+ sizeof (scm_t_char_range) * len,
+ sizeof (scm_t_char_range) * (len -
+ 1),
+ "character-set");
+ cs->len = len - 1;
+ return;
+ }
+ }
+ else if (n == cs->ranges[i].lo)
+ {
+ /* Shrink this range from the left. */
+ cs->ranges[i].lo = n + 1;
+ return;
+ }
+ else if (n == cs->ranges[i].hi)
+ {
+ /* Shrink this range from the right. */
+ cs->ranges[i].hi = n - 1;
+ return;
+ }
+ else if (n > cs->ranges[i].lo && n < cs->ranges[i].hi)
+ {
+ /* Split this range into two pieces. */
+ cs->ranges = scm_gc_realloc (cs->ranges,
+ sizeof (scm_t_char_range) * len,
+ sizeof (scm_t_char_range) * (len + 1),
+ "character-set");
+ if (i < len - 1)
+ memmove (cs->ranges + (i + 2), cs->ranges + (i + 1),
+ sizeof (scm_t_char_range) * (len - i - 1));
+ cs->ranges[i + 1].hi = cs->ranges[i].hi;
+ cs->ranges[i + 1].lo = n + 1;
+ cs->ranges[i].hi = n - 1;
+ cs->len = len + 1;
+ return;
+ }
+
+ i++;
+ }
+
+ /* This value is above all ranges, so do nothing here. */
+ return;
+}
+
+static int
+charsets_equal (scm_t_char_set *a, scm_t_char_set *b)
+{
+ if (a->len != b->len)
+ return 0;
+
+ if (memcmp (a->ranges, b->ranges, sizeof (scm_t_char_range) * a->len) != 0)
+ return 0;
+
+ return 1;
+}
+
+/* Return true if every character in A is also in B. */
+static int
+charsets_leq (scm_t_char_set *a, scm_t_char_set *b)
+{
+ size_t i = 0, j = 0;
+ scm_t_wchar alo, ahi;
+
+ if (a->len == 0)
+ return 1;
+ if (b->len == 0)
+ return 0;
+ while (i < a->len)
+ {
+ alo = a->ranges[i].lo;
+ ahi = a->ranges[i].hi;
+ while (b->ranges[j].hi < alo)
+ {
+ if (j < b->len - 1)
+ j++;
+ else
+ return 0;
+ }
+ if (alo < b->ranges[j].lo || ahi > b->ranges[j].hi)
+ return 0;
+ i++;
+ }
+
+ return 1;
+}
+
+/* Merge B into A. */
+static void
+charsets_union (scm_t_char_set *a, scm_t_char_set *b)
+{
+ size_t i = 0;
+ scm_t_wchar blo, bhi, n;
+
+ if (b->len == 0)
+ return;
+
+ if (a->len == 0)
+ {
+ a->len = b->len;
+ a->ranges = scm_gc_malloc (sizeof (scm_t_char_range) * b->len,
+ "character-set");
+ memcpy (a->ranges, b->ranges, sizeof (scm_t_char_range) * b->len);
+ return;
+ }
+
+ /* This needs optimization. */
+ while (i < b->len)
+ {
+ blo = b->ranges[i].lo;
+ bhi = b->ranges[i].hi;
+ for (n = blo; n <= bhi; n++)
+ scm_i_charset_set (a, n);
+
+ i++;
+ }
+
+ return;
+}
+
+/* Remove elements not both in A and B from A. */
+static void
+charsets_intersection (scm_t_char_set *a, scm_t_char_set *b)
+{
+ size_t i = 0;
+ scm_t_wchar blo, bhi, n;
+ scm_t_char_set *c;
+
+ if (a->len == 0)
+ return;
+
+ if (b->len == 0)
+ {
+ scm_gc_free (a->ranges, sizeof (scm_t_char_range) * a->len,
+ "character-set");
+ a->len = 0;
+ return;
+ }
+
+ c = (scm_t_char_set *) scm_malloc (sizeof (scm_t_char_set));
+ c->len = 0;
+ c->ranges = NULL;
+
+ while (i < b->len)
+ {
+ blo = b->ranges[i].lo;
+ bhi = b->ranges[i].hi;
+ for (n = blo; n <= bhi; n++)
+ if (scm_i_charset_get (a, n))
+ scm_i_charset_set (c, n);
+ i++;
+ }
+ scm_gc_free (a->ranges, sizeof (scm_t_char_range) * a->len,
+ "character-set");
+
+ a->len = c->len;
+ if (c->len != 0)
+ a->ranges = c->ranges;
+ else
+ a->ranges = NULL;
+ free (c);
+ return;
+}
+
+/* Make P the compelement of Q. */
+static void
+charsets_complement (scm_t_char_set *p, scm_t_char_set *q)
+{
+ int k, idx;
+
+ if (q->len == 0)
+ {
+ /* Fill with all valid codepoints. */
+ p->len = 2;
+ p->ranges = scm_gc_malloc (sizeof (scm_t_char_range) * 2,
+ "character-set");
+ p->ranges[0].lo = 0;
+ p->ranges[0].hi = 0xd7ff;
+ p->ranges[1].lo = 0xe000;
+ p->ranges[1].hi = SCM_CODEPOINT_MAX;
+ return;
+ }
+
+ if (p->len > 0)
+ scm_gc_free (p->ranges, sizeof (scm_t_char_set) * p->len,
+ "character-set");
+
+ p->len = 0;
+ if (q->ranges[0].lo > 0)
+ p->len++;
+ if (q->ranges[q->len - 1].hi < SCM_CODEPOINT_MAX)
+ p->len++;
+ p->len += q->len - 1;
+ p->ranges =
+ (scm_t_char_range *) scm_gc_malloc (sizeof (scm_t_char_range) * p->len,
+ "character-set");
+ idx = 0;
+ if (q->ranges[0].lo > 0)
+ {
+ p->ranges[idx].lo = 0;
+ p->ranges[idx++].hi = q->ranges[0].lo - 1;
+ }
+ for (k = 1; k < q->len; k++)
+ {
+ p->ranges[idx].lo = q->ranges[k - 1].hi + 1;
+ p->ranges[idx++].hi = q->ranges[k].lo - 1;
+ }
+ if (q->ranges[q->len - 1].hi < SCM_CODEPOINT_MAX)
+ {
+ p->ranges[idx].lo = q->ranges[q->len - 1].hi + 1;
+ p->ranges[idx].hi = SCM_CODEPOINT_MAX;
+ }
+ return;
+}
+
+/* Replace A with elements only found in one of A or B. */
+static void
+charsets_xor (scm_t_char_set *a, scm_t_char_set *b)
+{
+ size_t i = 0;
+ scm_t_wchar blo, bhi, n;
+
+ if (b->len == 0)
+ {
+ return;
+ }
+ if (a->len == 0)
+ {
+ a->ranges =
+ (scm_t_char_range *) scm_gc_malloc (sizeof (scm_t_char_range) *
+ b->len, "character-set");
+ a->len = b->len;
+ memcpy (a->ranges, b->ranges, sizeof (scm_t_char_range) * a->len);
+ return;
+ }
+
+ while (i < b->len)
+ {
+ blo = b->ranges[i].lo;
+ bhi = b->ranges[i].hi;
+ for (n = blo; n <= bhi; n++)
+ {
+ if (scm_i_charset_get (a, n))
+ scm_i_charset_unset (a, n);
+ else
+ scm_i_charset_set (a, n);
+ }
+
+ i++;
+ }
+ return;
+}
/* Smob print hook for character sets. */
static int
charset_print (SCM charset, SCM port, scm_print_state *pstate SCM_UNUSED)
{
- int i;
+ size_t i;
int first = 1;
+ scm_t_char_set *p;
+ const size_t max_ranges_to_print = 50;
+
+ p = SCM_CHARSET_DATA (charset);
scm_puts ("#<charset {", port);
- for (i = 0; i < SCM_CHARSET_SIZE; i++)
- if (SCM_CHARSET_GET (charset, i))
- {
- if (first)
- first = 0;
- else
- scm_puts (" ", port);
- scm_write (SCM_MAKE_CHAR (i), port);
- }
+ for (i = 0; i < p->len; i++)
+ {
+ if (first)
+ first = 0;
+ else
+ scm_puts (" ", port);
+ scm_write (SCM_MAKE_CHAR (p->ranges[i].lo), port);
+ if (p->ranges[i].lo != p->ranges[i].hi)
+ {
+ scm_puts ("..", port);
+ scm_write (SCM_MAKE_CHAR (p->ranges[i].hi), port);
+ }
+ if (i >= max_ranges_to_print)
+ {
+ /* Too many to print here. Quit early. */
+ scm_puts (" ...", port);
+ break;
+ }
+ }
scm_puts ("}>", port);
return 1;
}
+/* Smob print hook for character sets cursors. */
+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;
+}
/* Create a new, empty character set. */
static SCM
-make_char_set (const char * func_name)
+make_char_set (const char *func_name)
{
- long * p;
+ scm_t_char_set *p;
- p = scm_gc_malloc (BYTES_PER_CHARSET, "character-set");
- memset (p, 0, BYTES_PER_CHARSET);
+ p = scm_gc_malloc (sizeof (scm_t_char_set), "character-set");
+ memset (p, 0, sizeof (scm_t_char_set));
SCM_RETURN_NEWSMOB (scm_tc16_charset, p);
}
@@ -98,22 +550,22 @@ SCM_DEFINE (scm_char_set_eq, "char-set=", 0, 0, 1,
#define FUNC_NAME s_scm_char_set_eq
{
int argnum = 1;
- long *cs1_data = NULL;
+ scm_t_char_set *cs1_data = NULL;
SCM_VALIDATE_REST_ARGUMENT (char_sets);
while (!scm_is_null (char_sets))
{
SCM csi = SCM_CAR (char_sets);
- long *csi_data;
+ scm_t_char_set *csi_data;
SCM_VALIDATE_SMOB (argnum, csi, charset);
argnum++;
- csi_data = (long *) SCM_SMOB_DATA (csi);
+ csi_data = SCM_CHARSET_DATA (csi);
if (cs1_data == NULL)
- cs1_data = csi_data;
- else if (memcmp (cs1_data, csi_data, BYTES_PER_CHARSET) != 0)
- return SCM_BOOL_F;
+ cs1_data = csi_data;
+ else if (!charsets_equal (cs1_data, csi_data))
+ return SCM_BOOL_F;
char_sets = SCM_CDR (char_sets);
}
return SCM_BOOL_T;
@@ -128,28 +580,23 @@ SCM_DEFINE (scm_char_set_leq, "char-set<=", 0, 0, 1,
#define FUNC_NAME s_scm_char_set_leq
{
int argnum = 1;
- long *prev_data = NULL;
+ scm_t_char_set *prev_data = NULL;
SCM_VALIDATE_REST_ARGUMENT (char_sets);
while (!scm_is_null (char_sets))
{
SCM csi = SCM_CAR (char_sets);
- long *csi_data;
+ scm_t_char_set *csi_data;
SCM_VALIDATE_SMOB (argnum, csi, charset);
argnum++;
- csi_data = (long *) SCM_SMOB_DATA (csi);
+ csi_data = SCM_CHARSET_DATA (csi);
if (prev_data)
- {
- int k;
-
- for (k = 0; k < LONGS_PER_CHARSET; k++)
- {
- if ((prev_data[k] & csi_data[k]) != prev_data[k])
- return SCM_BOOL_F;
- }
- }
+ {
+ if (!charsets_leq (prev_data, csi_data))
+ return SCM_BOOL_F;
+ }
prev_data = csi_data;
char_sets = SCM_CDR (char_sets);
}
@@ -167,9 +614,10 @@ SCM_DEFINE (scm_char_set_hash, "char-set-hash", 1, 1, 0,
{
const unsigned long default_bnd = 871;
unsigned long bnd;
- long * p;
+ scm_t_char_set *p;
unsigned long val = 0;
int k;
+ scm_t_wchar c;
SCM_VALIDATE_SMOB (1, cs, charset);
@@ -179,14 +627,14 @@ SCM_DEFINE (scm_char_set_hash, "char-set-hash", 1, 1, 0,
{
bnd = scm_to_ulong (bound);
if (bnd == 0)
- bnd = default_bnd;
+ bnd = default_bnd;
}
- p = (long *) SCM_SMOB_DATA (cs);
- for (k = 0; k < LONGS_PER_CHARSET; k++)
+ p = SCM_CHARSET_DATA (cs);
+ for (k = 0; k < p->len; k++)
{
- if (p[k] != 0)
- val = p[k] + (val << 1);
+ for (c = p->ranges[k].lo; c <= p->ranges[k].hi; c++)
+ val = c + (val << 1);
}
return scm_from_ulong (val % bnd);
}
@@ -194,89 +642,150 @@ SCM_DEFINE (scm_char_set_hash, "char-set-hash", 1, 1, 0,
SCM_DEFINE (scm_char_set_cursor, "char-set-cursor", 1, 0, 0,
- (SCM cs),
- "Return a cursor into the character set @var{cs}.")
+ (SCM cs), "Return a cursor into the character set @var{cs}.")
#define FUNC_NAME s_scm_char_set_cursor
{
- int idx;
+ scm_t_char_set *cs_data;
+ scm_t_char_set_cursor *cur_data;
SCM_VALIDATE_SMOB (1, cs, charset);
- for (idx = 0; idx < SCM_CHARSET_SIZE; idx++)
+ cs_data = SCM_CHARSET_DATA (cs);
+ cur_data =
+ (scm_t_char_set_cursor *) scm_gc_malloc (sizeof (scm_t_char_set_cursor),
+ "charset-cursor");
+ if (cs_data->len == 0)
{
- if (SCM_CHARSET_GET (cs, idx))
- break;
+ cur_data->range = (size_t) (-1);
+ cur_data->n = 0;
}
- return SCM_I_MAKINUM (idx);
+ else
+ {
+ cur_data->range = 0;
+ cur_data->n = cs_data->ranges[0].lo;
+ }
+ 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.")
+ (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
{
- size_t ccursor = scm_to_size_t (cursor);
+ scm_t_char_set *cs_data;
+ scm_t_char_set_cursor *cur_data;
+ size_t i;
+
SCM_VALIDATE_SMOB (1, cs, charset);
+ SCM_VALIDATE_SMOB (2, cursor, charset_cursor);
- if (ccursor >= SCM_CHARSET_SIZE || !SCM_CHARSET_GET (cs, ccursor))
+ cs_data = SCM_CHARSET_DATA (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 >= cs_data->len
+ || cur_data->n < cs_data->ranges[i].lo
+ || cur_data->n > cs_data->ranges[i].hi)
SCM_MISC_ERROR ("invalid character set cursor: ~A", scm_list_1 (cursor));
- return SCM_MAKE_CHAR (ccursor);
+ 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?}.")
+ (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
{
- size_t ccursor = scm_to_size_t (cursor);
+ scm_t_char_set *cs_data;
+ scm_t_char_set_cursor *cur_data;
+ size_t i;
+
SCM_VALIDATE_SMOB (1, cs, charset);
+ SCM_VALIDATE_SMOB (2, cursor, charset_cursor);
+
+ cs_data = SCM_CHARSET_DATA (cs);
+ cur_data = (scm_t_char_set_cursor *) SCM_SMOB_DATA (cursor);
- if (ccursor >= SCM_CHARSET_SIZE || !SCM_CHARSET_GET (cs, ccursor))
+ /* Validate that this cursor is still true. */
+ i = cur_data->range;
+ if (i == (size_t) (-1)
+ || i >= cs_data->len
+ || cur_data->n < cs_data->ranges[i].lo
+ || cur_data->n > cs_data->ranges[i].hi)
SCM_MISC_ERROR ("invalid character set cursor: ~A", scm_list_1 (cursor));
- for (ccursor++; ccursor < SCM_CHARSET_SIZE; ccursor++)
+ /* Increment the cursor. */
+ if (cur_data->n == cs_data->ranges[i].hi)
{
- if (SCM_CHARSET_GET (cs, ccursor))
- break;
+ if (i + 1 < cs_data->len)
+ {
+ cur_data->range = i + 1;
+ cur_data->n = cs_data->ranges[i + 1].lo;
+ }
+ else
+ {
+ /* This is the end of the road. */
+ cur_data->range = (size_t) (-1);
+ cur_data->n = 0;
+ }
}
- return SCM_I_MAKINUM (ccursor);
+ 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.")
+ (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
{
- size_t ccursor = scm_to_size_t (cursor);
- return scm_from_bool (ccursor >= SCM_CHARSET_SIZE);
+ 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"
- "initializing it with @var{knil}.")
+ (SCM kons, SCM knil, SCM cs),
+ "Fold the procedure @var{kons} over the character set @var{cs},\n"
+ "initializing it with @var{knil}.")
#define FUNC_NAME s_scm_char_set_fold
{
+ scm_t_char_set *cs_data;
int k;
+ scm_t_wchar n;
SCM_VALIDATE_PROC (1, kons);
SCM_VALIDATE_SMOB (3, cs, charset);
- for (k = 0; k < SCM_CHARSET_SIZE; k++)
- if (SCM_CHARSET_GET (cs, k))
+ cs_data = SCM_CHARSET_DATA (cs);
+
+ if (cs_data->len == 0)
+ return knil;
+
+ for (k = 0; k < cs_data->len; k++)
+ for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
{
- knil = scm_call_2 (kons, SCM_MAKE_CHAR (k), knil);
+ knil = scm_call_2 (kons, SCM_MAKE_CHAR (n), knil);
}
return knil;
}
@@ -366,19 +875,29 @@ SCM_DEFINE (scm_char_set_unfold_x, "char-set-unfold!", 5, 0, 0,
SCM_DEFINE (scm_char_set_for_each, "char-set-for-each", 2, 0, 0,
- (SCM proc, SCM cs),
- "Apply @var{proc} to every character in the character set\n"
- "@var{cs}. The return value is not specified.")
+ (SCM proc, SCM cs),
+ "Apply @var{proc} to every character in the character set\n"
+ "@var{cs}. The return value is not specified.")
#define FUNC_NAME s_scm_char_set_for_each
{
+ scm_t_char_set *cs_data;
int k;
+ scm_t_wchar n;
SCM_VALIDATE_PROC (1, proc);
SCM_VALIDATE_SMOB (2, cs, charset);
- for (k = 0; k < SCM_CHARSET_SIZE; k++)
- if (SCM_CHARSET_GET (cs, k))
- scm_call_1 (proc, SCM_MAKE_CHAR (k));
+ cs_data = SCM_CHARSET_DATA (cs);
+
+ if (cs_data->len == 0)
+ return SCM_UNSPECIFIED;
+
+ for (k = 0; k < cs_data->len; k++)
+ for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
+ {
+ scm_call_1 (proc, SCM_MAKE_CHAR (n));
+ }
+
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@@ -392,18 +911,26 @@ SCM_DEFINE (scm_char_set_map, "char-set-map", 2, 0, 0,
{
SCM result;
int k;
+ scm_t_char_set *cs_data;
+ scm_t_wchar n;
SCM_VALIDATE_PROC (1, proc);
SCM_VALIDATE_SMOB (2, cs, charset);
result = make_char_set (FUNC_NAME);
- for (k = 0; k < SCM_CHARSET_SIZE; k++)
- if (SCM_CHARSET_GET (cs, k))
+ cs_data = SCM_CHARSET_DATA (cs);
+
+ if (cs_data->len == 0)
+ return result;
+
+ for (k = 0; k < cs_data->len; k++)
+ for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
{
- SCM ch = scm_call_1 (proc, SCM_MAKE_CHAR (k));
- if (!SCM_CHARP (ch))
- SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
- SCM_CHARSET_SET (result, SCM_CHAR (ch));
+ SCM ch = scm_call_1 (proc, SCM_MAKE_CHAR (n));
+ if (!SCM_CHARP (ch))
+ SCM_MISC_ERROR ("procedure ~S returned non-char",
+ scm_list_1 (proc));
+ SCM_CHARSET_SET (result, SCM_CHAR (ch));
}
return result;
}
@@ -417,15 +944,23 @@ SCM_DEFINE (scm_char_set_copy, "char-set-copy", 1, 0, 0,
#define FUNC_NAME s_scm_char_set_copy
{
SCM ret;
- long * p1, * p2;
- int k;
+ scm_t_char_set *p1, *p2;
SCM_VALIDATE_SMOB (1, cs, charset);
ret = make_char_set (FUNC_NAME);
- p1 = (long *) SCM_SMOB_DATA (cs);
- p2 = (long *) SCM_SMOB_DATA (ret);
- for (k = 0; k < LONGS_PER_CHARSET; k++)
- p2[k] = p1[k];
+ p1 = SCM_CHARSET_DATA (cs);
+ p2 = SCM_CHARSET_DATA (ret);
+ p2->len = p1->len;
+
+ if (p1->len == 0)
+ p2->ranges = NULL;
+ else
+ {
+ p2->ranges = scm_gc_malloc (sizeof (scm_t_char_range) * p1->len,
+ "character-set");
+ memcpy (p2->ranges, p1->ranges, sizeof (scm_t_char_range) * p1->len);
+ }
+
return ret;
}
#undef FUNC_NAME
@@ -437,20 +972,18 @@ SCM_DEFINE (scm_char_set, "char-set", 0, 0, 1,
#define FUNC_NAME s_scm_char_set
{
SCM cs;
- long * p;
int argnum = 1;
SCM_VALIDATE_REST_ARGUMENT (rest);
cs = make_char_set (FUNC_NAME);
- p = (long *) SCM_SMOB_DATA (cs);
while (!scm_is_null (rest))
{
- int c;
+ scm_t_wchar c;
SCM_VALIDATE_CHAR_COPY (argnum, SCM_CAR (rest), c);
argnum++;
rest = SCM_CDR (rest);
- p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+ SCM_CHARSET_SET (cs, c);
}
return cs;
}
@@ -465,7 +998,6 @@ SCM_DEFINE (scm_list_to_char_set, "list->char-set", 1, 1, 0,
#define FUNC_NAME s_scm_list_to_char_set
{
SCM cs;
- long * p;
SCM_VALIDATE_LIST (1, list);
if (SCM_UNBNDP (base_cs))
@@ -475,16 +1007,16 @@ SCM_DEFINE (scm_list_to_char_set, "list->char-set", 1, 1, 0,
SCM_VALIDATE_SMOB (2, base_cs, charset);
cs = scm_char_set_copy (base_cs);
}
- p = (long *) SCM_SMOB_DATA (cs);
while (!scm_is_null (list))
{
SCM chr = SCM_CAR (list);
- int c;
+ scm_t_wchar c;
SCM_VALIDATE_CHAR_COPY (0, chr, c);
list = SCM_CDR (list);
- p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+
+ SCM_CHARSET_SET (cs, c);
}
return cs;
}
@@ -492,26 +1024,23 @@ SCM_DEFINE (scm_list_to_char_set, "list->char-set", 1, 1, 0,
SCM_DEFINE (scm_list_to_char_set_x, "list->char-set!", 2, 0, 0,
- (SCM list, SCM base_cs),
- "Convert the character list @var{list} to a character set. The\n"
- "characters are added to @var{base_cs} and @var{base_cs} is\n"
- "returned.")
+ (SCM list, SCM base_cs),
+ "Convert the character list @var{list} to a character set. The\n"
+ "characters are added to @var{base_cs} and @var{base_cs} is\n"
+ "returned.")
#define FUNC_NAME s_scm_list_to_char_set_x
{
- long * p;
-
SCM_VALIDATE_LIST (1, list);
SCM_VALIDATE_SMOB (2, base_cs, charset);
- p = (long *) SCM_SMOB_DATA (base_cs);
while (!scm_is_null (list))
{
SCM chr = SCM_CAR (list);
- int c;
+ scm_t_wchar c;
SCM_VALIDATE_CHAR_COPY (0, chr, c);
list = SCM_CDR (list);
- p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+ SCM_CHARSET_SET (base_cs, c);
}
return base_cs;
}
@@ -526,8 +1055,6 @@ SCM_DEFINE (scm_string_to_char_set, "string->char-set", 1, 1, 0,
#define FUNC_NAME s_scm_string_to_char_set
{
SCM cs;
- long * p;
- const char * s;
size_t k = 0, len;
SCM_VALIDATE_STRING (1, str);
@@ -538,13 +1065,11 @@ SCM_DEFINE (scm_string_to_char_set, "string->char-set", 1, 1, 0,
SCM_VALIDATE_SMOB (2, base_cs, charset);
cs = scm_char_set_copy (base_cs);
}
- p = (long *) SCM_SMOB_DATA (cs);
- s = scm_i_string_chars (str);
len = scm_i_string_length (str);
while (k < len)
{
- int c = s[k++];
- p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+ scm_t_wchar c = scm_i_string_ref (str, k++);
+ SCM_CHARSET_SET (cs, c);
}
scm_remember_upto_here_1 (str);
return cs;
@@ -553,25 +1078,21 @@ SCM_DEFINE (scm_string_to_char_set, "string->char-set", 1, 1, 0,
SCM_DEFINE (scm_string_to_char_set_x, "string->char-set!", 2, 0, 0,
- (SCM str, SCM base_cs),
- "Convert the string @var{str} to a character set. The\n"
- "characters from the string are added to @var{base_cs}, and\n"
- "@var{base_cs} is returned.")
+ (SCM str, SCM base_cs),
+ "Convert the string @var{str} to a character set. The\n"
+ "characters from the string are added to @var{base_cs}, and\n"
+ "@var{base_cs} is returned.")
#define FUNC_NAME s_scm_string_to_char_set_x
{
- long * p;
- const char * s;
size_t k = 0, len;
SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_SMOB (2, base_cs, charset);
- p = (long *) SCM_SMOB_DATA (base_cs);
- s = scm_i_string_chars (str);
len = scm_i_string_length (str);
while (k < len)
{
- int c = s[k++];
- p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+ scm_t_wchar c = scm_i_string_ref (str, k++);
+ SCM_CHARSET_SET (base_cs, c);
}
scm_remember_upto_here_1 (str);
return base_cs;
@@ -588,7 +1109,8 @@ SCM_DEFINE (scm_char_set_filter, "char-set-filter", 2, 1, 0,
{
SCM ret;
int k;
- long * p;
+ scm_t_wchar n;
+ scm_t_char_set *p;
SCM_VALIDATE_PROC (1, pred);
SCM_VALIDATE_SMOB (2, cs, charset);
@@ -599,17 +1121,20 @@ SCM_DEFINE (scm_char_set_filter, "char-set-filter", 2, 1, 0,
}
else
ret = make_char_set (FUNC_NAME);
- p = (long *) SCM_SMOB_DATA (ret);
- for (k = 0; k < SCM_CHARSET_SIZE; k++)
- {
- if (SCM_CHARSET_GET (cs, k))
- {
- SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
- if (scm_is_true (res))
- p[k / SCM_BITS_PER_LONG] |= 1L << (k % SCM_BITS_PER_LONG);
- }
- }
+ p = SCM_CHARSET_DATA (cs);
+
+ if (p->len == 0)
+ return ret;
+
+ for (k = 0; k < p->len; k++)
+ for (n = p->ranges[k].lo; n <= p->ranges[k].hi; n++)
+ {
+ SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (n));
+
+ if (scm_is_true (res))
+ SCM_CHARSET_SET (ret, n);
+ }
return ret;
}
#undef FUNC_NAME
@@ -623,22 +1148,24 @@ SCM_DEFINE (scm_char_set_filter_x, "char-set-filter!", 3, 0, 0,
#define FUNC_NAME s_scm_char_set_filter_x
{
int k;
- long * p;
+ scm_t_wchar n;
+ scm_t_char_set *p;
SCM_VALIDATE_PROC (1, pred);
SCM_VALIDATE_SMOB (2, cs, charset);
SCM_VALIDATE_SMOB (3, base_cs, charset);
- p = (long *) SCM_SMOB_DATA (base_cs);
- for (k = 0; k < SCM_CHARSET_SIZE; k++)
- {
- if (SCM_CHARSET_GET (cs, k))
- {
- SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
+ p = SCM_CHARSET_DATA (cs);
+ if (p->len == 0)
+ return base_cs;
- if (scm_is_true (res))
- p[k / SCM_BITS_PER_LONG] |= 1L << (k % SCM_BITS_PER_LONG);
- }
- }
+ for (k = 0; k < p->len; k++)
+ for (n = p->ranges[k].lo; n <= p->ranges[k].hi; n++)
+ {
+ SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
+
+ if (scm_is_true (res))
+ SCM_CHARSET_SET (base_cs, n);
+ }
return base_cs;
}
#undef FUNC_NAME
@@ -662,7 +1189,6 @@ SCM_DEFINE (scm_ucs_range_to_char_set, "ucs-range->char-set", 2, 2, 0,
{
SCM cs;
size_t clower, cupper;
- long * p;
clower = scm_to_size_t (lower);
cupper = scm_to_size_t (upper);
@@ -670,15 +1196,15 @@ SCM_DEFINE (scm_ucs_range_to_char_set, "ucs-range->char-set", 2, 2, 0,
if (!SCM_UNBNDP (error))
{
if (scm_is_true (error))
- {
- SCM_ASSERT_RANGE (1, lower, clower <= SCM_CHARSET_SIZE);
- SCM_ASSERT_RANGE (2, upper, cupper <= SCM_CHARSET_SIZE);
- }
+ {
+ SCM_ASSERT_RANGE (1, lower, SCM_IS_UNICODE_CHAR (clower));
+ SCM_ASSERT_RANGE (2, upper, SCM_IS_UNICODE_CHAR (cupper));
+ }
}
- if (clower > SCM_CHARSET_SIZE)
- clower = SCM_CHARSET_SIZE;
- if (cupper > SCM_CHARSET_SIZE)
- cupper = SCM_CHARSET_SIZE;
+ if (clower > 0x10FFFF)
+ clower = 0x10FFFF;
+ if (cupper > 0x10FFFF)
+ cupper = 0x10FFFF;
if (SCM_UNBNDP (base_cs))
cs = make_char_set (FUNC_NAME);
else
@@ -686,10 +1212,11 @@ SCM_DEFINE (scm_ucs_range_to_char_set, "ucs-range->char-set", 2, 2, 0,
SCM_VALIDATE_SMOB (4, base_cs, charset);
cs = scm_char_set_copy (base_cs);
}
- p = (long *) SCM_SMOB_DATA (cs);
+ /* It not be difficult to write a more optimized version of the
+ following. */
while (clower < cupper)
{
- p[clower / SCM_BITS_PER_LONG] |= 1L << (clower % SCM_BITS_PER_LONG);
+ SCM_CHARSET_SET (cs, clower);
clower++;
}
return cs;
@@ -714,24 +1241,24 @@ SCM_DEFINE (scm_ucs_range_to_char_set_x, "ucs-range->char-set!", 4, 0, 0,
#define FUNC_NAME s_scm_ucs_range_to_char_set_x
{
size_t clower, cupper;
- long * p;
clower = scm_to_size_t (lower);
cupper = scm_to_size_t (upper);
SCM_ASSERT_RANGE (2, upper, cupper >= clower);
if (scm_is_true (error))
{
- SCM_ASSERT_RANGE (1, lower, clower <= SCM_CHARSET_SIZE);
- SCM_ASSERT_RANGE (2, upper, cupper <= SCM_CHARSET_SIZE);
+ SCM_ASSERT_RANGE (1, lower, SCM_IS_UNICODE_CHAR (clower));
+ SCM_ASSERT_RANGE (2, upper, SCM_IS_UNICODE_CHAR (cupper));
}
- if (clower > SCM_CHARSET_SIZE)
- clower = SCM_CHARSET_SIZE;
- if (cupper > SCM_CHARSET_SIZE)
- cupper = SCM_CHARSET_SIZE;
- p = (long *) SCM_SMOB_DATA (base_cs);
+ if (clower > SCM_CODEPOINT_MAX)
+ clower = SCM_CODEPOINT_MAX;
+ if (cupper > SCM_CODEPOINT_MAX)
+ cupper = SCM_CODEPOINT_MAX;
+
while (clower < cupper)
{
- p[clower / SCM_BITS_PER_LONG] |= 1L << (clower % SCM_BITS_PER_LONG);
+ if (SCM_IS_UNICODE_CHAR (clower))
+ SCM_CHARSET_SET (base_cs, clower);
clower++;
}
return base_cs;
@@ -760,12 +1287,18 @@ SCM_DEFINE (scm_char_set_size, "char-set-size", 1, 0, 0,
#define FUNC_NAME s_scm_char_set_size
{
int k, count = 0;
+ scm_t_char_set *cs_data;
SCM_VALIDATE_SMOB (1, cs, charset);
- for (k = 0; k < SCM_CHARSET_SIZE; k++)
- if (SCM_CHARSET_GET (cs, k))
- count++;
- return SCM_I_MAKINUM (count);
+ cs_data = SCM_CHARSET_DATA (cs);
+
+ if (cs_data->len == 0)
+ return scm_from_int (0);
+
+ for (k = 0; k < cs_data->len; k++)
+ count += cs_data->ranges[k].hi - cs_data->ranges[k].lo + 1;
+
+ return scm_from_int (count);
}
#undef FUNC_NAME
@@ -777,16 +1310,21 @@ SCM_DEFINE (scm_char_set_count, "char-set-count", 2, 0, 0,
#define FUNC_NAME s_scm_char_set_count
{
int k, count = 0;
+ scm_t_wchar n;
+ scm_t_char_set *cs_data;
SCM_VALIDATE_PROC (1, pred);
SCM_VALIDATE_SMOB (2, cs, charset);
+ cs_data = SCM_CHARSET_DATA (cs);
+ if (cs_data->len == 0)
+ return scm_from_int (0);
- for (k = 0; k < SCM_CHARSET_SIZE; k++)
- if (SCM_CHARSET_GET (cs, k))
+ for (k = 0; k < cs_data->len; k++)
+ for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
{
- SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
- if (scm_is_true (res))
- count++;
+ SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (n));
+ if (scm_is_true (res))
+ count++;
}
return SCM_I_MAKINUM (count);
}
@@ -800,12 +1338,18 @@ SCM_DEFINE (scm_char_set_to_list, "char-set->list", 1, 0, 0,
#define FUNC_NAME s_scm_char_set_to_list
{
int k;
+ scm_t_wchar n;
SCM result = SCM_EOL;
+ scm_t_char_set *p;
SCM_VALIDATE_SMOB (1, cs, charset);
- for (k = SCM_CHARSET_SIZE; k > 0; k--)
- if (SCM_CHARSET_GET (cs, k - 1))
- result = scm_cons (SCM_MAKE_CHAR (k - 1), result);
+ p = SCM_CHARSET_DATA (cs);
+ if (p->len == 0)
+ return SCM_EOL;
+
+ for (k = p->len - 1; k >= 0; k--)
+ for (n = p->ranges[k].hi; n >= p->ranges[k].lo; n--)
+ result = scm_cons (SCM_MAKE_CHAR (n), result);
return result;
}
#undef FUNC_NAME
@@ -821,17 +1365,35 @@ SCM_DEFINE (scm_char_set_to_string, "char-set->string", 1, 0, 0,
int k;
int count = 0;
int idx = 0;
+ int wide = 0;
SCM result;
- char * p;
+ scm_t_wchar n;
+ scm_t_char_set *cs_data;
+ char *buf;
+ scm_t_wchar *wbuf;
SCM_VALIDATE_SMOB (1, cs, charset);
- for (k = 0; k < SCM_CHARSET_SIZE; k++)
- if (SCM_CHARSET_GET (cs, k))
- count++;
- result = scm_i_make_string (count, &p);
- for (k = 0; k < SCM_CHARSET_SIZE; k++)
- if (SCM_CHARSET_GET (cs, k))
- p[idx++] = k;
+ cs_data = SCM_CHARSET_DATA (cs);
+ if (cs_data->len == 0)
+ return scm_nullstr;
+
+ if (cs_data->ranges[cs_data->len - 1].hi > 255)
+ wide = 1;
+
+ count = scm_to_int (scm_char_set_size (cs));
+ if (wide)
+ result = scm_i_make_wide_string (count, &wbuf);
+ else
+ result = scm_i_make_string (count, &buf);
+
+ for (k = 0; k < cs_data->len; k++)
+ for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
+ {
+ if (wide)
+ wbuf[idx++] = n;
+ else
+ buf[idx++] = n;
+ }
return result;
}
#undef FUNC_NAME
@@ -857,19 +1419,25 @@ SCM_DEFINE (scm_char_set_every, "char-set-every", 2, 0, 0,
#define FUNC_NAME s_scm_char_set_every
{
int k;
+ scm_t_wchar n;
SCM res = SCM_BOOL_T;
+ scm_t_char_set *cs_data;
SCM_VALIDATE_PROC (1, pred);
SCM_VALIDATE_SMOB (2, cs, charset);
- for (k = 0; k < SCM_CHARSET_SIZE; k++)
- if (SCM_CHARSET_GET (cs, k))
+ cs_data = SCM_CHARSET_DATA (cs);
+ if (cs_data->len == 0)
+ return SCM_BOOL_T;
+
+ for (k = 0; k < cs_data->len; k++)
+ for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
{
- res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
- if (scm_is_false (res))
- return res;
+ res = scm_call_1 (pred, SCM_MAKE_CHAR (n));
+ if (scm_is_false (res))
+ return res;
}
- return res;
+ return SCM_BOOL_T;
}
#undef FUNC_NAME
@@ -881,16 +1449,20 @@ SCM_DEFINE (scm_char_set_any, "char-set-any", 2, 0, 0,
#define FUNC_NAME s_scm_char_set_any
{
int k;
+ scm_t_wchar n;
+ scm_t_char_set *cs_data;
SCM_VALIDATE_PROC (1, pred);
SCM_VALIDATE_SMOB (2, cs, charset);
- for (k = 0; k < SCM_CHARSET_SIZE; k++)
- if (SCM_CHARSET_GET (cs, k))
+ cs_data = (scm_t_char_set *) cs;
+
+ for (k = 0; k < cs_data->len; k++)
+ for (n = cs_data->ranges[k].lo; n <= cs_data->ranges[k].hi; n++)
{
- SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
- if (scm_is_true (res))
- return res;
+ SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (n));
+ if (scm_is_true (res))
+ return res;
}
return SCM_BOOL_F;
}
@@ -898,27 +1470,24 @@ SCM_DEFINE (scm_char_set_any, "char-set-any", 2, 0, 0,
SCM_DEFINE (scm_char_set_adjoin, "char-set-adjoin", 1, 0, 1,
- (SCM cs, SCM rest),
- "Add all character arguments to the first argument, which must\n"
- "be a character set.")
+ (SCM cs, SCM rest),
+ "Add all character arguments to the first argument, which must\n"
+ "be a character set.")
#define FUNC_NAME s_scm_char_set_adjoin
{
- long * p;
-
SCM_VALIDATE_SMOB (1, cs, charset);
SCM_VALIDATE_REST_ARGUMENT (rest);
cs = scm_char_set_copy (cs);
- p = (long *) SCM_SMOB_DATA (cs);
while (!scm_is_null (rest))
{
SCM chr = SCM_CAR (rest);
- int c;
+ scm_t_wchar c;
SCM_VALIDATE_CHAR_COPY (1, chr, c);
rest = SCM_CDR (rest);
- p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+ SCM_CHARSET_SET (cs, c);
}
return cs;
}
@@ -926,27 +1495,24 @@ SCM_DEFINE (scm_char_set_adjoin, "char-set-adjoin", 1, 0, 1,
SCM_DEFINE (scm_char_set_delete, "char-set-delete", 1, 0, 1,
- (SCM cs, SCM rest),
- "Delete all character arguments from the first argument, which\n"
- "must be a character set.")
+ (SCM cs, SCM rest),
+ "Delete all character arguments from the first argument, which\n"
+ "must be a character set.")
#define FUNC_NAME s_scm_char_set_delete
{
- long * p;
-
SCM_VALIDATE_SMOB (1, cs, charset);
SCM_VALIDATE_REST_ARGUMENT (rest);
cs = scm_char_set_copy (cs);
- p = (long *) SCM_SMOB_DATA (cs);
while (!scm_is_null (rest))
{
SCM chr = SCM_CAR (rest);
- int c;
+ scm_t_wchar c;
SCM_VALIDATE_CHAR_COPY (1, chr, c);
rest = SCM_CDR (rest);
- p[c / SCM_BITS_PER_LONG] &= ~(1L << (c % SCM_BITS_PER_LONG));
+ SCM_CHARSET_UNSET (cs, c);
}
return cs;
}
@@ -954,26 +1520,23 @@ SCM_DEFINE (scm_char_set_delete, "char-set-delete", 1, 0, 1,
SCM_DEFINE (scm_char_set_adjoin_x, "char-set-adjoin!", 1, 0, 1,
- (SCM cs, SCM rest),
- "Add all character arguments to the first argument, which must\n"
- "be a character set.")
+ (SCM cs, SCM rest),
+ "Add all character arguments to the first argument, which must\n"
+ "be a character set.")
#define FUNC_NAME s_scm_char_set_adjoin_x
{
- long * p;
-
SCM_VALIDATE_SMOB (1, cs, charset);
SCM_VALIDATE_REST_ARGUMENT (rest);
- p = (long *) SCM_SMOB_DATA (cs);
while (!scm_is_null (rest))
{
SCM chr = SCM_CAR (rest);
- int c;
+ scm_t_wchar c;
SCM_VALIDATE_CHAR_COPY (1, chr, c);
rest = SCM_CDR (rest);
- p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
+ SCM_CHARSET_SET (cs, c);
}
return cs;
}
@@ -981,26 +1544,23 @@ SCM_DEFINE (scm_char_set_adjoin_x, "char-set-adjoin!", 1, 0, 1,
SCM_DEFINE (scm_char_set_delete_x, "char-set-delete!", 1, 0, 1,
- (SCM cs, SCM rest),
- "Delete all character arguments from the first argument, which\n"
- "must be a character set.")
+ (SCM cs, SCM rest),
+ "Delete all character arguments from the first argument, which\n"
+ "must be a character set.")
#define FUNC_NAME s_scm_char_set_delete_x
{
- long * p;
-
SCM_VALIDATE_SMOB (1, cs, charset);
SCM_VALIDATE_REST_ARGUMENT (rest);
- p = (long *) SCM_SMOB_DATA (cs);
while (!scm_is_null (rest))
{
SCM chr = SCM_CAR (rest);
- int c;
+ scm_t_wchar c;
SCM_VALIDATE_CHAR_COPY (1, chr, c);
rest = SCM_CDR (rest);
- p[c / SCM_BITS_PER_LONG] &= ~(1L << (c % SCM_BITS_PER_LONG));
+ SCM_CHARSET_UNSET (cs, c);
}
return cs;
}
@@ -1008,21 +1568,19 @@ SCM_DEFINE (scm_char_set_delete_x, "char-set-delete!", 1, 0, 1,
SCM_DEFINE (scm_char_set_complement, "char-set-complement", 1, 0, 0,
- (SCM cs),
- "Return the complement of the character set @var{cs}.")
+ (SCM cs), "Return the complement of the character set @var{cs}.")
#define FUNC_NAME s_scm_char_set_complement
{
- int k;
SCM res;
- long * p, * q;
+ scm_t_char_set *p, *q;
SCM_VALIDATE_SMOB (1, cs, charset);
res = make_char_set (FUNC_NAME);
- p = (long *) SCM_SMOB_DATA (res);
- q = (long *) SCM_SMOB_DATA (cs);
- for (k = 0; k < LONGS_PER_CHARSET; k++)
- p[k] = ~q[k];
+ p = SCM_CHARSET_DATA (res);
+ q = SCM_CHARSET_DATA (cs);
+
+ charsets_complement (p, q);
return res;
}
#undef FUNC_NAME
@@ -1035,22 +1593,21 @@ SCM_DEFINE (scm_char_set_union, "char-set-union", 0, 0, 1,
{
int c = 1;
SCM res;
- long * p;
+ scm_t_char_set *p;
SCM_VALIDATE_REST_ARGUMENT (rest);
res = make_char_set (FUNC_NAME);
- p = (long *) SCM_SMOB_DATA (res);
+ p = SCM_CHARSET_DATA (res);
while (!scm_is_null (rest))
{
- int k;
SCM cs = SCM_CAR (rest);
SCM_VALIDATE_SMOB (c, cs, charset);
c++;
rest = SCM_CDR (rest);
- for (k = 0; k < LONGS_PER_CHARSET; k++)
- p[k] |= ((long *) SCM_SMOB_DATA (cs))[k];
+
+ charsets_union (p, (scm_t_char_set *) SCM_SMOB_DATA (cs));
}
return res;
}
@@ -1070,26 +1627,24 @@ SCM_DEFINE (scm_char_set_intersection, "char-set-intersection", 0, 0, 1,
res = make_char_set (FUNC_NAME);
else
{
- long *p;
+ scm_t_char_set *p;
int argnum = 2;
res = scm_char_set_copy (SCM_CAR (rest));
- p = (long *) SCM_SMOB_DATA (res);
+ p = SCM_CHARSET_DATA (res);
rest = SCM_CDR (rest);
while (scm_is_pair (rest))
- {
- int k;
- SCM cs = SCM_CAR (rest);
- long *cs_data;
-
- SCM_VALIDATE_SMOB (argnum, cs, charset);
- argnum++;
- cs_data = (long *) SCM_SMOB_DATA (cs);
- rest = SCM_CDR (rest);
- for (k = 0; k < LONGS_PER_CHARSET; k++)
- p[k] &= cs_data[k];
- }
+ {
+ SCM cs = SCM_CAR (rest);
+ scm_t_char_set *cs_data;
+
+ SCM_VALIDATE_SMOB (argnum, cs, charset);
+ argnum++;
+ cs_data = SCM_CHARSET_DATA (cs);
+ rest = SCM_CDR (rest);
+ charsets_intersection (p, cs_data);
+ }
}
return res;
@@ -1103,24 +1658,25 @@ SCM_DEFINE (scm_char_set_difference, "char-set-difference", 1, 0, 1,
#define FUNC_NAME s_scm_char_set_difference
{
int c = 2;
- SCM res;
- long * p;
+ SCM res, compl;
+ scm_t_char_set *p, *q;
SCM_VALIDATE_SMOB (1, cs1, charset);
SCM_VALIDATE_REST_ARGUMENT (rest);
res = scm_char_set_copy (cs1);
- p = (long *) SCM_SMOB_DATA (res);
+ p = SCM_CHARSET_DATA (res);
+ compl = make_char_set (FUNC_NAME);
+ q = SCM_CHARSET_DATA (compl);
while (!scm_is_null (rest))
{
- int k;
SCM cs = SCM_CAR (rest);
SCM_VALIDATE_SMOB (c, cs, charset);
c++;
rest = SCM_CDR (rest);
- for (k = 0; k < LONGS_PER_CHARSET; k++)
- p[k] &= ~((long *) SCM_SMOB_DATA (cs))[k];
+ charsets_complement (q, SCM_CHARSET_DATA (cs));
+ charsets_intersection (p, q);
}
return res;
}
@@ -1141,26 +1697,24 @@ SCM_DEFINE (scm_char_set_xor, "char-set-xor", 0, 0, 1,
else
{
int argnum = 2;
- long * p;
+ scm_t_char_set *p;
res = scm_char_set_copy (SCM_CAR (rest));
- p = (long *) SCM_SMOB_DATA (res);
+ p = SCM_CHARSET_DATA (res);
rest = SCM_CDR (rest);
while (scm_is_pair (rest))
- {
- SCM cs = SCM_CAR (rest);
- long *cs_data;
- int k;
-
- SCM_VALIDATE_SMOB (argnum, cs, charset);
- argnum++;
- cs_data = (long *) SCM_SMOB_DATA (cs);
- rest = SCM_CDR (rest);
-
- for (k = 0; k < LONGS_PER_CHARSET; k++)
- p[k] ^= cs_data[k];
- }
+ {
+ SCM cs = SCM_CAR (rest);
+ scm_t_char_set *cs_data;
+
+ SCM_VALIDATE_SMOB (argnum, cs, charset);
+ argnum++;
+ cs_data = SCM_CHARSET_DATA (cs);
+ rest = SCM_CDR (rest);
+
+ charsets_xor (p, cs_data);
+ }
}
return res;
}
@@ -1175,30 +1729,26 @@ SCM_DEFINE (scm_char_set_diff_plus_intersection, "char-set-diff+intersection", 1
{
int c = 2;
SCM res1, res2;
- long * p, * q;
+ scm_t_char_set *p, *q;
SCM_VALIDATE_SMOB (1, cs1, charset);
SCM_VALIDATE_REST_ARGUMENT (rest);
res1 = scm_char_set_copy (cs1);
res2 = make_char_set (FUNC_NAME);
- p = (long *) SCM_SMOB_DATA (res1);
- q = (long *) SCM_SMOB_DATA (res2);
+ p = SCM_CHARSET_DATA (res1);
+ q = SCM_CHARSET_DATA (res2);
while (!scm_is_null (rest))
{
- int k;
SCM cs = SCM_CAR (rest);
- long *r;
+ scm_t_char_set *r;
SCM_VALIDATE_SMOB (c, cs, charset);
c++;
- r = (long *) SCM_SMOB_DATA (cs);
+ r = SCM_CHARSET_DATA (cs);
- for (k = 0; k < LONGS_PER_CHARSET; k++)
- {
- q[k] |= p[k] & r[k];
- p[k] &= ~r[k];
- }
+ charsets_union (q, r);
+ charsets_intersection (p, r);
rest = SCM_CDR (rest);
}
return scm_values (scm_list_2 (res1, res2));
@@ -1207,101 +1757,53 @@ SCM_DEFINE (scm_char_set_diff_plus_intersection, "char-set-diff+intersection", 1
SCM_DEFINE (scm_char_set_complement_x, "char-set-complement!", 1, 0, 0,
- (SCM cs),
- "Return the complement of the character set @var{cs}.")
+ (SCM cs), "Return the complement of the character set @var{cs}.")
#define FUNC_NAME s_scm_char_set_complement_x
{
- int k;
- long * p;
-
SCM_VALIDATE_SMOB (1, cs, charset);
- p = (long *) SCM_SMOB_DATA (cs);
- for (k = 0; k < LONGS_PER_CHARSET; k++)
- p[k] = ~p[k];
+ cs = scm_char_set_complement (cs);
return cs;
}
#undef FUNC_NAME
SCM_DEFINE (scm_char_set_union_x, "char-set-union!", 1, 0, 1,
- (SCM cs1, SCM rest),
- "Return the union of all argument character sets.")
+ (SCM cs1, SCM rest),
+ "Return the union of all argument character sets.")
#define FUNC_NAME s_scm_char_set_union_x
{
- int c = 2;
- long * p;
-
SCM_VALIDATE_SMOB (1, cs1, charset);
SCM_VALIDATE_REST_ARGUMENT (rest);
- p = (long *) SCM_SMOB_DATA (cs1);
- while (!scm_is_null (rest))
- {
- int k;
- SCM cs = SCM_CAR (rest);
- SCM_VALIDATE_SMOB (c, cs, charset);
- c++;
- rest = SCM_CDR (rest);
-
- for (k = 0; k < LONGS_PER_CHARSET; k++)
- p[k] |= ((long *) SCM_SMOB_DATA (cs))[k];
- }
+ cs1 = scm_char_set_union (scm_cons (cs1, rest));
return cs1;
}
#undef FUNC_NAME
SCM_DEFINE (scm_char_set_intersection_x, "char-set-intersection!", 1, 0, 1,
- (SCM cs1, SCM rest),
- "Return the intersection of all argument character sets.")
+ (SCM cs1, SCM rest),
+ "Return the intersection of all argument character sets.")
#define FUNC_NAME s_scm_char_set_intersection_x
{
- int c = 2;
- long * p;
-
SCM_VALIDATE_SMOB (1, cs1, charset);
SCM_VALIDATE_REST_ARGUMENT (rest);
- p = (long *) SCM_SMOB_DATA (cs1);
- while (!scm_is_null (rest))
- {
- int k;
- SCM cs = SCM_CAR (rest);
- SCM_VALIDATE_SMOB (c, cs, charset);
- c++;
- rest = SCM_CDR (rest);
-
- for (k = 0; k < LONGS_PER_CHARSET; k++)
- p[k] &= ((long *) SCM_SMOB_DATA (cs))[k];
- }
+ cs1 = scm_char_set_intersection (scm_cons (cs1, rest));
return cs1;
}
#undef FUNC_NAME
SCM_DEFINE (scm_char_set_difference_x, "char-set-difference!", 1, 0, 1,
- (SCM cs1, SCM rest),
- "Return the difference of all argument character sets.")
+ (SCM cs1, SCM rest),
+ "Return the difference of all argument character sets.")
#define FUNC_NAME s_scm_char_set_difference_x
{
- int c = 2;
- long * p;
-
SCM_VALIDATE_SMOB (1, cs1, charset);
SCM_VALIDATE_REST_ARGUMENT (rest);
- p = (long *) SCM_SMOB_DATA (cs1);
- while (!scm_is_null (rest))
- {
- int k;
- SCM cs = SCM_CAR (rest);
- SCM_VALIDATE_SMOB (c, cs, charset);
- c++;
- rest = SCM_CDR (rest);
-
- for (k = 0; k < LONGS_PER_CHARSET; k++)
- p[k] &= ~((long *) SCM_SMOB_DATA (cs))[k];
- }
+ cs1 = scm_char_set_difference (cs1, rest);
return cs1;
}
#undef FUNC_NAME
@@ -1316,86 +1818,32 @@ SCM_DEFINE (scm_char_set_xor_x, "char-set-xor!", 1, 0, 1,
(define a (char-set #\a))
(char-set-xor a a a) -> char set #\a
(char-set-xor! a a a) -> char set #\a
- */
+ */
return scm_char_set_xor (scm_cons (cs1, rest));
-
-#if 0
- /* this would give (char-set-xor! a a a) -> empty char set. */
- int c = 2;
- long * p;
-
- SCM_VALIDATE_SMOB (1, cs1, charset);
- SCM_VALIDATE_REST_ARGUMENT (rest);
-
- p = (long *) SCM_SMOB_DATA (cs1);
- while (!scm_is_null (rest))
- {
- int k;
- SCM cs = SCM_CAR (rest);
- SCM_VALIDATE_SMOB (c, cs, charset);
- c++;
- rest = SCM_CDR (rest);
-
- for (k = 0; k < LONGS_PER_CHARSET; k++)
- p[k] ^= ((long *) SCM_SMOB_DATA (cs))[k];
- }
- return cs1;
-#endif
}
#undef FUNC_NAME
-SCM_DEFINE (scm_char_set_diff_plus_intersection_x, "char-set-diff+intersection!", 2, 0, 1,
- (SCM cs1, SCM cs2, SCM rest),
- "Return the difference and the intersection of all argument\n"
- "character sets.")
+SCM_DEFINE (scm_char_set_diff_plus_intersection_x,
+ "char-set-diff+intersection!", 2, 0, 1, (SCM cs1, SCM cs2,
+ SCM rest),
+ "Return the difference and the intersection of all argument\n"
+ "character sets.")
#define FUNC_NAME s_scm_char_set_diff_plus_intersection_x
{
- int c = 3;
- long * p, * q;
- int k;
+ SCM diff, intersect;
- SCM_VALIDATE_SMOB (1, cs1, charset);
- SCM_VALIDATE_SMOB (2, cs2, charset);
- SCM_VALIDATE_REST_ARGUMENT (rest);
-
- p = (long *) SCM_SMOB_DATA (cs1);
- q = (long *) SCM_SMOB_DATA (cs2);
- if (p == q)
- {
- /* (char-set-diff+intersection! a a ...): can't share storage,
- but we know the answer without checking for further
- arguments. */
- return scm_values (scm_list_2 (make_char_set (FUNC_NAME), cs1));
- }
- for (k = 0; k < LONGS_PER_CHARSET; k++)
- {
- long t = p[k];
-
- p[k] &= ~q[k];
- q[k] = t & q[k];
- }
- while (!scm_is_null (rest))
- {
- SCM cs = SCM_CAR (rest);
- long *r;
-
- SCM_VALIDATE_SMOB (c, cs, charset);
- c++;
- r = (long *) SCM_SMOB_DATA (cs);
-
- for (k = 0; k < LONGS_PER_CHARSET; k++)
- {
- q[k] |= p[k] & r[k];
- p[k] &= ~r[k];
- }
- rest = SCM_CDR (rest);
- }
+ diff = scm_char_set_difference (cs1, scm_cons (cs2, rest));
+ intersect =
+ scm_char_set_intersection (scm_cons (cs1, scm_cons (cs2, rest)));
+ cs1 = diff;
+ cs2 = intersect;
return scm_values (scm_list_2 (cs1, cs2));
}
#undef FUNC_NAME
+
/* Standard character sets. */
SCM scm_char_set_lower_case;
@@ -1419,146 +1867,77 @@ SCM scm_char_set_full;
/* Create an empty character set and return it after binding it to NAME. */
static inline SCM
-define_charset (const char *name)
+define_charset (const char *name, const scm_t_char_set *p)
{
- SCM cs = make_char_set (NULL);
+ SCM cs;
+
+ SCM_NEWSMOB (cs, scm_tc16_charset, p);
scm_c_define (name, cs);
return scm_permanent_object (cs);
}
-/* Membership predicates for the various char sets.
-
- XXX: The `punctuation' and `symbol' char sets have no direct equivalent in
- <ctype.h>. Thus, the predicates below yield correct results for ASCII,
- but they do not provide the result described by the SRFI for Latin-1. The
- correct Latin-1 result could only be obtained by hard-coding the
- characters listed by the SRFI, but the problem would remain for other
- 8-bit charsets.
-
- Similarly, character 0xA0 in Latin-1 (unbreakable space, `#\0240') should
- be part of `char-set:blank'. However, glibc's current (2006/09) Latin-1
- locales (which use the ISO 14652 "i18n" FDCC-set) do not consider it
- `blank' so it ends up in `char-set:punctuation'. */
-#ifdef HAVE_ISBLANK
-# define CSET_BLANK_PRED(c) (isblank (c))
-#else
-# define CSET_BLANK_PRED(c) \
- (((c) == ' ') || ((c) == '\t'))
-#endif
-
-#define CSET_SYMBOL_PRED(c) \
- (((c) != '\0') && (strchr ("$+<=>^`|~", (c)) != NULL))
-#define CSET_PUNCT_PRED(c) \
- ((ispunct (c)) && (!CSET_SYMBOL_PRED (c)))
-
-#define CSET_LOWER_PRED(c) (islower (c))
-#define CSET_UPPER_PRED(c) (isupper (c))
-#define CSET_LETTER_PRED(c) (isalpha (c))
-#define CSET_DIGIT_PRED(c) (isdigit (c))
-#define CSET_WHITESPACE_PRED(c) (isspace (c))
-#define CSET_CONTROL_PRED(c) (iscntrl (c))
-#define CSET_HEX_DIGIT_PRED(c) (isxdigit (c))
-#define CSET_ASCII_PRED(c) (isascii (c))
-
-/* Some char sets are explicitly defined by the SRFI as a union of other char
- sets so we try to follow this closely. */
-
-#define CSET_LETTER_AND_DIGIT_PRED(c) \
- (CSET_LETTER_PRED (c) || CSET_DIGIT_PRED (c))
-
-#define CSET_GRAPHIC_PRED(c) \
- (CSET_LETTER_PRED (c) || CSET_DIGIT_PRED (c) \
- || CSET_PUNCT_PRED (c) || CSET_SYMBOL_PRED (c))
-
-#define CSET_PRINTING_PRED(c) \
- (CSET_GRAPHIC_PRED (c) || CSET_WHITESPACE_PRED (c))
-
-/* False and true predicates. */
-#define CSET_TRUE_PRED(c) (1)
-#define CSET_FALSE_PRED(c) (0)
-
-
-/* Compute the contents of all the standard character sets. Computation may
- need to be re-done at `setlocale'-time because some char sets (e.g.,
- `char-set:letter') need to reflect the character set supported by Guile.
-
- For instance, at startup time, the "C" locale is used, thus Guile supports
- only ASCII; therefore, `char-set:letter' only contains English letters.
- The user can change this by invoking `setlocale' and specifying a locale
- with an 8-bit charset, thereby augmenting some of the SRFI-14 standard
- character sets.
-
- This works because some of the predicates used below to construct
- character sets (e.g., `isalpha(3)') are locale-dependent (so
- charset-dependent, though generally not language-dependent). For details,
- please see the `guile-devel' mailing list archive of September 2006. */
-void
-scm_srfi_14_compute_char_sets (void)
+#ifdef SCM_CHARSET_DEBUG
+SCM_DEFINE (scm_debug_char_set, "debug-char-set", 1, 0, 0,
+ (SCM charset),
+ "Print out the internal C structure of @var{charset}.\n")
+#define FUNC_NAME s_scm_debug_char_set
{
-#define UPDATE_CSET(c, cset, pred) \
- do \
- { \
- if (pred (c)) \
- SCM_CHARSET_SET ((cset), (c)); \
- else \
- SCM_CHARSET_UNSET ((cset), (c)); \
- } \
- while (0)
-
- register int ch;
-
- for (ch = 0; ch < 256; ch++)
+ int i;
+ scm_t_char_set *cs = SCM_CHARSET_DATA (charset);
+ fprintf (stderr, "cs %p\n", cs);
+ fprintf (stderr, "len %d\n", cs->len);
+ fprintf (stderr, "arr %p\n", cs->ranges);
+ for (i = 0; i < cs->len; i++)
{
- UPDATE_CSET (ch, scm_char_set_upper_case, CSET_UPPER_PRED);
- UPDATE_CSET (ch, scm_char_set_lower_case, CSET_LOWER_PRED);
- UPDATE_CSET (ch, scm_char_set_title_case, CSET_FALSE_PRED);
- UPDATE_CSET (ch, scm_char_set_letter, CSET_LETTER_PRED);
- UPDATE_CSET (ch, scm_char_set_digit, CSET_DIGIT_PRED);
- UPDATE_CSET (ch, scm_char_set_letter_and_digit,
- CSET_LETTER_AND_DIGIT_PRED);
- UPDATE_CSET (ch, scm_char_set_graphic, CSET_GRAPHIC_PRED);
- UPDATE_CSET (ch, scm_char_set_printing, CSET_PRINTING_PRED);
- UPDATE_CSET (ch, scm_char_set_whitespace, CSET_WHITESPACE_PRED);
- UPDATE_CSET (ch, scm_char_set_iso_control, CSET_CONTROL_PRED);
- UPDATE_CSET (ch, scm_char_set_punctuation, CSET_PUNCT_PRED);
- UPDATE_CSET (ch, scm_char_set_symbol, CSET_SYMBOL_PRED);
- UPDATE_CSET (ch, scm_char_set_hex_digit, CSET_HEX_DIGIT_PRED);
- UPDATE_CSET (ch, scm_char_set_blank, CSET_BLANK_PRED);
- UPDATE_CSET (ch, scm_char_set_ascii, CSET_ASCII_PRED);
- UPDATE_CSET (ch, scm_char_set_empty, CSET_FALSE_PRED);
- UPDATE_CSET (ch, scm_char_set_full, CSET_TRUE_PRED);
+ if (cs->ranges[i].lo == cs->ranges[i].hi)
+ fprintf (stderr, "%04x\n", cs->ranges[i].lo);
+ else
+ fprintf (stderr, "%04x..%04x\t[%d]\n",
+ cs->ranges[i].lo,
+ cs->ranges[i].hi, cs->ranges[i].hi - cs->ranges[i].lo + 1);
}
-
-#undef UPDATE_CSET
+ printf ("\n");
+ return SCM_UNSPECIFIED;
}
-
+#undef FUNC_NAME
+#endif /* SCM_CHARSET_DEBUG */
+
+
void
scm_init_srfi_14 (void)
{
- scm_tc16_charset = scm_make_smob_type ("character-set",
- BYTES_PER_CHARSET);
+ scm_tc16_charset = scm_make_smob_type ("character-set", 0);
scm_set_smob_print (scm_tc16_charset, charset_print);
- scm_char_set_upper_case = define_charset ("char-set:upper-case");
- scm_char_set_lower_case = define_charset ("char-set:lower-case");
- scm_char_set_title_case = define_charset ("char-set:title-case");
- scm_char_set_letter = define_charset ("char-set:letter");
- scm_char_set_digit = define_charset ("char-set:digit");
- scm_char_set_letter_and_digit = define_charset ("char-set:letter+digit");
- scm_char_set_graphic = define_charset ("char-set:graphic");
- scm_char_set_printing = define_charset ("char-set:printing");
- scm_char_set_whitespace = define_charset ("char-set:whitespace");
- scm_char_set_iso_control = define_charset ("char-set:iso-control");
- scm_char_set_punctuation = define_charset ("char-set:punctuation");
- scm_char_set_symbol = define_charset ("char-set:symbol");
- scm_char_set_hex_digit = define_charset ("char-set:hex-digit");
- scm_char_set_blank = define_charset ("char-set:blank");
- scm_char_set_ascii = define_charset ("char-set:ascii");
- scm_char_set_empty = define_charset ("char-set:empty");
- scm_char_set_full = define_charset ("char-set:full");
-
- scm_srfi_14_compute_char_sets ();
+ scm_tc16_charset_cursor = scm_make_smob_type ("char-set-cursor", 0);
+ scm_set_smob_print (scm_tc16_charset_cursor, charset_cursor_print);
+
+ scm_char_set_upper_case =
+ define_charset ("char-set:upper-case", &cs_upper_case);
+ scm_char_set_lower_case =
+ define_charset ("char-set:lower-case", &cs_lower_case);
+ scm_char_set_title_case =
+ define_charset ("char-set:title-case", &cs_title_case);
+ scm_char_set_letter = define_charset ("char-set:letter", &cs_letter);
+ scm_char_set_digit = define_charset ("char-set:digit", &cs_digit);
+ scm_char_set_letter_and_digit =
+ define_charset ("char-set:letter+digit", &cs_letter_plus_digit);
+ scm_char_set_graphic = define_charset ("char-set:graphic", &cs_graphic);
+ scm_char_set_printing = define_charset ("char-set:printing", &cs_printing);
+ scm_char_set_whitespace =
+ define_charset ("char-set:whitespace", &cs_whitespace);
+ scm_char_set_iso_control =
+ define_charset ("char-set:iso-control", &cs_iso_control);
+ scm_char_set_punctuation =
+ define_charset ("char-set:punctuation", &cs_punctuation);
+ scm_char_set_symbol = define_charset ("char-set:symbol", &cs_symbol);
+ scm_char_set_hex_digit =
+ define_charset ("char-set:hex-digit", &cs_hex_digit);
+ scm_char_set_blank = define_charset ("char-set:blank", &cs_blank);
+ scm_char_set_ascii = define_charset ("char-set:ascii", &cs_ascii);
+ scm_char_set_empty = define_charset ("char-set:empty", &cs_empty);
+ scm_char_set_full = define_charset ("char-set:full", &cs_full);
#include "libguile/srfi-14.x"
}