1
/* srfi-14.c --- SRFI-14 procedures for Guile
3
* Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc.
5
* This library is free software; you can redistribute it and/or
6
* modify it under the terms of the GNU Lesser General Public
7
* License as published by the Free Software Foundation; either
8
* version 2.1 of the License, or (at your option) any later version.
10
* This library is distributed in the hope that it will be useful,
11
* but WITHOUT ANY WARRANTY; without even the implied warranty of
12
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13
* Lesser General Public License for more details.
15
* You should have received a copy of the GNU Lesser General Public
16
* License along with this library; if not, write to the Free Software
17
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
25
#define _GNU_SOURCE /* Ask for `isblank ()'. */
31
#include "libguile/srfi-14.h"
34
#define SCM_CHARSET_SET(cs, idx) \
35
(((long *) SCM_SMOB_DATA (cs))[(idx) / SCM_BITS_PER_LONG] |= \
36
(1L << ((idx) % SCM_BITS_PER_LONG)))
38
#define SCM_CHARSET_UNSET(cs, idx) \
39
(((long *) SCM_SMOB_DATA (cs))[(idx) / SCM_BITS_PER_LONG] &= \
40
(~(1L << ((idx) % SCM_BITS_PER_LONG))))
42
#define BYTES_PER_CHARSET (SCM_CHARSET_SIZE / 8)
43
#define LONGS_PER_CHARSET (SCM_CHARSET_SIZE / SCM_BITS_PER_LONG)
46
/* Smob type code for character sets. */
47
int scm_tc16_charset = 0;
50
/* Smob print hook for character sets. */
52
charset_print (SCM charset, SCM port, scm_print_state *pstate SCM_UNUSED)
57
scm_puts ("#<charset {", port);
58
for (i = 0; i < SCM_CHARSET_SIZE; i++)
59
if (SCM_CHARSET_GET (charset, i))
65
scm_write (SCM_MAKE_CHAR (i), port);
67
scm_puts ("}>", port);
72
/* Smob free hook for character sets. */
74
charset_free (SCM charset)
76
return scm_smob_free (charset);
80
/* Create a new, empty character set. */
82
make_char_set (const char * func_name)
86
p = scm_gc_malloc (BYTES_PER_CHARSET, "character-set");
87
memset (p, 0, BYTES_PER_CHARSET);
88
SCM_RETURN_NEWSMOB (scm_tc16_charset, p);
92
SCM_DEFINE (scm_char_set_p, "char-set?", 1, 0, 0,
94
"Return @code{#t} if @var{obj} is a character set, @code{#f}\n"
96
#define FUNC_NAME s_scm_char_set_p
98
return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_charset, obj));
103
SCM_DEFINE (scm_char_set_eq, "char-set=", 0, 0, 1,
105
"Return @code{#t} if all given character sets are equal.")
106
#define FUNC_NAME s_scm_char_set_eq
109
long *cs1_data = NULL;
111
SCM_VALIDATE_REST_ARGUMENT (char_sets);
113
while (!scm_is_null (char_sets))
115
SCM csi = SCM_CAR (char_sets);
118
SCM_VALIDATE_SMOB (argnum, csi, charset);
120
csi_data = (long *) SCM_SMOB_DATA (csi);
121
if (cs1_data == NULL)
123
else if (memcmp (cs1_data, csi_data, BYTES_PER_CHARSET) != 0)
125
char_sets = SCM_CDR (char_sets);
132
SCM_DEFINE (scm_char_set_leq, "char-set<=", 0, 0, 1,
134
"Return @code{#t} if every character set @var{cs}i is a subset\n"
135
"of character set @var{cs}i+1.")
136
#define FUNC_NAME s_scm_char_set_leq
139
long *prev_data = NULL;
141
SCM_VALIDATE_REST_ARGUMENT (char_sets);
143
while (!scm_is_null (char_sets))
145
SCM csi = SCM_CAR (char_sets);
148
SCM_VALIDATE_SMOB (argnum, csi, charset);
150
csi_data = (long *) SCM_SMOB_DATA (csi);
155
for (k = 0; k < LONGS_PER_CHARSET; k++)
157
if ((prev_data[k] & csi_data[k]) != prev_data[k])
161
prev_data = csi_data;
162
char_sets = SCM_CDR (char_sets);
169
SCM_DEFINE (scm_char_set_hash, "char-set-hash", 1, 1, 0,
171
"Compute a hash value for the character set @var{cs}. If\n"
172
"@var{bound} is given and non-zero, it restricts the\n"
173
"returned value to the range 0 @dots{} @var{bound - 1}.")
174
#define FUNC_NAME s_scm_char_set_hash
176
const unsigned long default_bnd = 871;
179
unsigned long val = 0;
182
SCM_VALIDATE_SMOB (1, cs, charset);
184
if (SCM_UNBNDP (bound))
188
bnd = scm_to_ulong (bound);
193
p = (long *) SCM_SMOB_DATA (cs);
194
for (k = 0; k < LONGS_PER_CHARSET; k++)
197
val = p[k] + (val << 1);
199
return scm_from_ulong (val % bnd);
204
SCM_DEFINE (scm_char_set_cursor, "char-set-cursor", 1, 0, 0,
206
"Return a cursor into the character set @var{cs}.")
207
#define FUNC_NAME s_scm_char_set_cursor
211
SCM_VALIDATE_SMOB (1, cs, charset);
212
for (idx = 0; idx < SCM_CHARSET_SIZE; idx++)
214
if (SCM_CHARSET_GET (cs, idx))
217
return SCM_I_MAKINUM (idx);
222
SCM_DEFINE (scm_char_set_ref, "char-set-ref", 2, 0, 0,
223
(SCM cs, SCM cursor),
224
"Return the character at the current cursor position\n"
225
"@var{cursor} in the character set @var{cs}. It is an error to\n"
226
"pass a cursor for which @code{end-of-char-set?} returns true.")
227
#define FUNC_NAME s_scm_char_set_ref
229
size_t ccursor = scm_to_size_t (cursor);
230
SCM_VALIDATE_SMOB (1, cs, charset);
232
if (ccursor >= SCM_CHARSET_SIZE || !SCM_CHARSET_GET (cs, ccursor))
233
SCM_MISC_ERROR ("invalid character set cursor: ~A", scm_list_1 (cursor));
234
return SCM_MAKE_CHAR (ccursor);
239
SCM_DEFINE (scm_char_set_cursor_next, "char-set-cursor-next", 2, 0, 0,
240
(SCM cs, SCM cursor),
241
"Advance the character set cursor @var{cursor} to the next\n"
242
"character in the character set @var{cs}. It is an error if the\n"
243
"cursor given satisfies @code{end-of-char-set?}.")
244
#define FUNC_NAME s_scm_char_set_cursor_next
246
size_t ccursor = scm_to_size_t (cursor);
247
SCM_VALIDATE_SMOB (1, cs, charset);
249
if (ccursor >= SCM_CHARSET_SIZE || !SCM_CHARSET_GET (cs, ccursor))
250
SCM_MISC_ERROR ("invalid character set cursor: ~A", scm_list_1 (cursor));
251
for (ccursor++; ccursor < SCM_CHARSET_SIZE; ccursor++)
253
if (SCM_CHARSET_GET (cs, ccursor))
256
return SCM_I_MAKINUM (ccursor);
261
SCM_DEFINE (scm_end_of_char_set_p, "end-of-char-set?", 1, 0, 0,
263
"Return @code{#t} if @var{cursor} has reached the end of a\n"
264
"character set, @code{#f} otherwise.")
265
#define FUNC_NAME s_scm_end_of_char_set_p
267
size_t ccursor = scm_to_size_t (cursor);
268
return scm_from_bool (ccursor >= SCM_CHARSET_SIZE);
273
SCM_DEFINE (scm_char_set_fold, "char-set-fold", 3, 0, 0,
274
(SCM kons, SCM knil, SCM cs),
275
"Fold the procedure @var{kons} over the character set @var{cs},\n"
276
"initializing it with @var{knil}.")
277
#define FUNC_NAME s_scm_char_set_fold
281
SCM_VALIDATE_PROC (1, kons);
282
SCM_VALIDATE_SMOB (3, cs, charset);
284
for (k = 0; k < SCM_CHARSET_SIZE; k++)
285
if (SCM_CHARSET_GET (cs, k))
287
knil = scm_call_2 (kons, SCM_MAKE_CHAR (k), knil);
294
SCM_DEFINE (scm_char_set_unfold, "char-set-unfold", 4, 1, 0,
295
(SCM p, SCM f, SCM g, SCM seed, SCM base_cs),
296
"This is a fundamental constructor for character sets.\n"
298
"@item @var{g} is used to generate a series of ``seed'' values\n"
299
"from the initial seed: @var{seed}, (@var{g} @var{seed}),\n"
300
"(@var{g}^2 @var{seed}), (@var{g}^3 @var{seed}), @dots{}\n"
301
"@item @var{p} tells us when to stop -- when it returns true\n"
302
"when applied to one of the seed values.\n"
303
"@item @var{f} maps each seed value to a character. These\n"
304
"characters are added to the base character set @var{base_cs} to\n"
305
"form the result; @var{base_cs} defaults to the empty set.\n"
307
#define FUNC_NAME s_scm_char_set_unfold
311
SCM_VALIDATE_PROC (1, p);
312
SCM_VALIDATE_PROC (2, f);
313
SCM_VALIDATE_PROC (3, g);
314
if (!SCM_UNBNDP (base_cs))
316
SCM_VALIDATE_SMOB (5, base_cs, charset);
317
result = scm_char_set_copy (base_cs);
320
result = make_char_set (FUNC_NAME);
322
tmp = scm_call_1 (p, seed);
323
while (scm_is_false (tmp))
325
SCM ch = scm_call_1 (f, seed);
327
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f));
328
SCM_CHARSET_SET (result, SCM_CHAR (ch));
330
seed = scm_call_1 (g, seed);
331
tmp = scm_call_1 (p, seed);
338
SCM_DEFINE (scm_char_set_unfold_x, "char-set-unfold!", 5, 0, 0,
339
(SCM p, SCM f, SCM g, SCM seed, SCM base_cs),
340
"This is a fundamental constructor for character sets.\n"
342
"@item @var{g} is used to generate a series of ``seed'' values\n"
343
"from the initial seed: @var{seed}, (@var{g} @var{seed}),\n"
344
"(@var{g}^2 @var{seed}), (@var{g}^3 @var{seed}), @dots{}\n"
345
"@item @var{p} tells us when to stop -- when it returns true\n"
346
"when applied to one of the seed values.\n"
347
"@item @var{f} maps each seed value to a character. These\n"
348
"characters are added to the base character set @var{base_cs} to\n"
349
"form the result; @var{base_cs} defaults to the empty set.\n"
351
#define FUNC_NAME s_scm_char_set_unfold_x
355
SCM_VALIDATE_PROC (1, p);
356
SCM_VALIDATE_PROC (2, f);
357
SCM_VALIDATE_PROC (3, g);
358
SCM_VALIDATE_SMOB (5, base_cs, charset);
360
tmp = scm_call_1 (p, seed);
361
while (scm_is_false (tmp))
363
SCM ch = scm_call_1 (f, seed);
365
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (f));
366
SCM_CHARSET_SET (base_cs, SCM_CHAR (ch));
368
seed = scm_call_1 (g, seed);
369
tmp = scm_call_1 (p, seed);
376
SCM_DEFINE (scm_char_set_for_each, "char-set-for-each", 2, 0, 0,
378
"Apply @var{proc} to every character in the character set\n"
379
"@var{cs}. The return value is not specified.")
380
#define FUNC_NAME s_scm_char_set_for_each
384
SCM_VALIDATE_PROC (1, proc);
385
SCM_VALIDATE_SMOB (2, cs, charset);
387
for (k = 0; k < SCM_CHARSET_SIZE; k++)
388
if (SCM_CHARSET_GET (cs, k))
389
scm_call_1 (proc, SCM_MAKE_CHAR (k));
390
return SCM_UNSPECIFIED;
395
SCM_DEFINE (scm_char_set_map, "char-set-map", 2, 0, 0,
397
"Map the procedure @var{proc} over every character in @var{cs}.\n"
398
"@var{proc} must be a character -> character procedure.")
399
#define FUNC_NAME s_scm_char_set_map
404
SCM_VALIDATE_PROC (1, proc);
405
SCM_VALIDATE_SMOB (2, cs, charset);
407
result = make_char_set (FUNC_NAME);
408
for (k = 0; k < SCM_CHARSET_SIZE; k++)
409
if (SCM_CHARSET_GET (cs, k))
411
SCM ch = scm_call_1 (proc, SCM_MAKE_CHAR (k));
413
SCM_MISC_ERROR ("procedure ~S returned non-char", scm_list_1 (proc));
414
SCM_CHARSET_SET (result, SCM_CHAR (ch));
421
SCM_DEFINE (scm_char_set_copy, "char-set-copy", 1, 0, 0,
423
"Return a newly allocated character set containing all\n"
424
"characters in @var{cs}.")
425
#define FUNC_NAME s_scm_char_set_copy
431
SCM_VALIDATE_SMOB (1, cs, charset);
432
ret = make_char_set (FUNC_NAME);
433
p1 = (long *) SCM_SMOB_DATA (cs);
434
p2 = (long *) SCM_SMOB_DATA (ret);
435
for (k = 0; k < LONGS_PER_CHARSET; k++)
442
SCM_DEFINE (scm_char_set, "char-set", 0, 0, 1,
444
"Return a character set containing all given characters.")
445
#define FUNC_NAME s_scm_char_set
451
SCM_VALIDATE_REST_ARGUMENT (rest);
452
cs = make_char_set (FUNC_NAME);
453
p = (long *) SCM_SMOB_DATA (cs);
454
while (!scm_is_null (rest))
458
SCM_VALIDATE_CHAR_COPY (argnum, SCM_CAR (rest), c);
460
rest = SCM_CDR (rest);
461
p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
468
SCM_DEFINE (scm_list_to_char_set, "list->char-set", 1, 1, 0,
469
(SCM list, SCM base_cs),
470
"Convert the character list @var{list} to a character set. If\n"
471
"the character set @var{base_cs} is given, the character in this\n"
472
"set are also included in the result.")
473
#define FUNC_NAME s_scm_list_to_char_set
478
SCM_VALIDATE_LIST (1, list);
479
if (SCM_UNBNDP (base_cs))
480
cs = make_char_set (FUNC_NAME);
483
SCM_VALIDATE_SMOB (2, base_cs, charset);
484
cs = scm_char_set_copy (base_cs);
486
p = (long *) SCM_SMOB_DATA (cs);
487
while (!scm_is_null (list))
489
SCM chr = SCM_CAR (list);
492
SCM_VALIDATE_CHAR_COPY (0, chr, c);
493
list = SCM_CDR (list);
495
p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
502
SCM_DEFINE (scm_list_to_char_set_x, "list->char-set!", 2, 0, 0,
503
(SCM list, SCM base_cs),
504
"Convert the character list @var{list} to a character set. The\n"
505
"characters are added to @var{base_cs} and @var{base_cs} is\n"
507
#define FUNC_NAME s_scm_list_to_char_set_x
511
SCM_VALIDATE_LIST (1, list);
512
SCM_VALIDATE_SMOB (2, base_cs, charset);
513
p = (long *) SCM_SMOB_DATA (base_cs);
514
while (!scm_is_null (list))
516
SCM chr = SCM_CAR (list);
519
SCM_VALIDATE_CHAR_COPY (0, chr, c);
520
list = SCM_CDR (list);
522
p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
529
SCM_DEFINE (scm_string_to_char_set, "string->char-set", 1, 1, 0,
530
(SCM str, SCM base_cs),
531
"Convert the string @var{str} to a character set. If the\n"
532
"character set @var{base_cs} is given, the characters in this\n"
533
"set are also included in the result.")
534
#define FUNC_NAME s_scm_string_to_char_set
541
SCM_VALIDATE_STRING (1, str);
542
if (SCM_UNBNDP (base_cs))
543
cs = make_char_set (FUNC_NAME);
546
SCM_VALIDATE_SMOB (2, base_cs, charset);
547
cs = scm_char_set_copy (base_cs);
549
p = (long *) SCM_SMOB_DATA (cs);
550
s = scm_i_string_chars (str);
551
len = scm_i_string_length (str);
555
p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
557
scm_remember_upto_here_1 (str);
563
SCM_DEFINE (scm_string_to_char_set_x, "string->char-set!", 2, 0, 0,
564
(SCM str, SCM base_cs),
565
"Convert the string @var{str} to a character set. The\n"
566
"characters from the string are added to @var{base_cs}, and\n"
567
"@var{base_cs} is returned.")
568
#define FUNC_NAME s_scm_string_to_char_set_x
574
SCM_VALIDATE_STRING (1, str);
575
SCM_VALIDATE_SMOB (2, base_cs, charset);
576
p = (long *) SCM_SMOB_DATA (base_cs);
577
s = scm_i_string_chars (str);
578
len = scm_i_string_length (str);
582
p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
584
scm_remember_upto_here_1 (str);
590
SCM_DEFINE (scm_char_set_filter, "char-set-filter", 2, 1, 0,
591
(SCM pred, SCM cs, SCM base_cs),
592
"Return a character set containing every character from @var{cs}\n"
593
"so that it satisfies @var{pred}. If provided, the characters\n"
594
"from @var{base_cs} are added to the result.")
595
#define FUNC_NAME s_scm_char_set_filter
601
SCM_VALIDATE_PROC (1, pred);
602
SCM_VALIDATE_SMOB (2, cs, charset);
603
if (!SCM_UNBNDP (base_cs))
605
SCM_VALIDATE_SMOB (3, base_cs, charset);
606
ret = scm_char_set_copy (base_cs);
609
ret = make_char_set (FUNC_NAME);
610
p = (long *) SCM_SMOB_DATA (ret);
611
for (k = 0; k < SCM_CHARSET_SIZE; k++)
613
if (SCM_CHARSET_GET (cs, k))
615
SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
617
if (scm_is_true (res))
618
p[k / SCM_BITS_PER_LONG] |= 1L << (k % SCM_BITS_PER_LONG);
626
SCM_DEFINE (scm_char_set_filter_x, "char-set-filter!", 3, 0, 0,
627
(SCM pred, SCM cs, SCM base_cs),
628
"Return a character set containing every character from @var{cs}\n"
629
"so that it satisfies @var{pred}. The characters are added to\n"
630
"@var{base_cs} and @var{base_cs} is returned.")
631
#define FUNC_NAME s_scm_char_set_filter_x
636
SCM_VALIDATE_PROC (1, pred);
637
SCM_VALIDATE_SMOB (2, cs, charset);
638
SCM_VALIDATE_SMOB (3, base_cs, charset);
639
p = (long *) SCM_SMOB_DATA (base_cs);
640
for (k = 0; k < SCM_CHARSET_SIZE; k++)
642
if (SCM_CHARSET_GET (cs, k))
644
SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
646
if (scm_is_true (res))
647
p[k / SCM_BITS_PER_LONG] |= 1L << (k % SCM_BITS_PER_LONG);
655
SCM_DEFINE (scm_ucs_range_to_char_set, "ucs-range->char-set", 2, 2, 0,
656
(SCM lower, SCM upper, SCM error, SCM base_cs),
657
"Return a character set containing all characters whose\n"
658
"character codes lie in the half-open range\n"
659
"[@var{lower},@var{upper}).\n"
661
"If @var{error} is a true value, an error is signalled if the\n"
662
"specified range contains characters which are not contained in\n"
663
"the implemented character range. If @var{error} is @code{#f},\n"
664
"these characters are silently left out of the resultung\n"
667
"The characters in @var{base_cs} are added to the result, if\n"
669
#define FUNC_NAME s_scm_ucs_range_to_char_set
672
size_t clower, cupper;
675
clower = scm_to_size_t (lower);
676
cupper = scm_to_size_t (upper);
677
SCM_ASSERT_RANGE (2, upper, cupper >= clower);
678
if (!SCM_UNBNDP (error))
680
if (scm_is_true (error))
682
SCM_ASSERT_RANGE (1, lower, clower <= SCM_CHARSET_SIZE);
683
SCM_ASSERT_RANGE (2, upper, cupper <= SCM_CHARSET_SIZE);
686
if (clower > SCM_CHARSET_SIZE)
687
clower = SCM_CHARSET_SIZE;
688
if (cupper > SCM_CHARSET_SIZE)
689
cupper = SCM_CHARSET_SIZE;
690
if (SCM_UNBNDP (base_cs))
691
cs = make_char_set (FUNC_NAME);
694
SCM_VALIDATE_SMOB (4, base_cs, charset);
695
cs = scm_char_set_copy (base_cs);
697
p = (long *) SCM_SMOB_DATA (cs);
698
while (clower < cupper)
700
p[clower / SCM_BITS_PER_LONG] |= 1L << (clower % SCM_BITS_PER_LONG);
708
SCM_DEFINE (scm_ucs_range_to_char_set_x, "ucs-range->char-set!", 4, 0, 0,
709
(SCM lower, SCM upper, SCM error, SCM base_cs),
710
"Return a character set containing all characters whose\n"
711
"character codes lie in the half-open range\n"
712
"[@var{lower},@var{upper}).\n"
714
"If @var{error} is a true value, an error is signalled if the\n"
715
"specified range contains characters which are not contained in\n"
716
"the implemented character range. If @var{error} is @code{#f},\n"
717
"these characters are silently left out of the resultung\n"
720
"The characters are added to @var{base_cs} and @var{base_cs} is\n"
722
#define FUNC_NAME s_scm_ucs_range_to_char_set_x
724
size_t clower, cupper;
727
clower = scm_to_size_t (lower);
728
cupper = scm_to_size_t (upper);
729
SCM_ASSERT_RANGE (2, upper, cupper >= clower);
730
if (scm_is_true (error))
732
SCM_ASSERT_RANGE (1, lower, clower <= SCM_CHARSET_SIZE);
733
SCM_ASSERT_RANGE (2, upper, cupper <= SCM_CHARSET_SIZE);
735
if (clower > SCM_CHARSET_SIZE)
736
clower = SCM_CHARSET_SIZE;
737
if (cupper > SCM_CHARSET_SIZE)
738
cupper = SCM_CHARSET_SIZE;
739
p = (long *) SCM_SMOB_DATA (base_cs);
740
while (clower < cupper)
742
p[clower / SCM_BITS_PER_LONG] |= 1L << (clower % SCM_BITS_PER_LONG);
749
SCM_DEFINE (scm_to_char_set, "->char-set", 1, 0, 0,
751
"Coerces x into a char-set. @var{x} may be a string, character or char-set. A string is converted to the set of its constituent characters; a character is converted to a singleton set; a char-set is returned as-is.")
752
#define FUNC_NAME s_scm_to_char_set
754
if (scm_is_string (x))
755
return scm_string_to_char_set (x, SCM_UNDEFINED);
756
else if (SCM_CHARP (x))
757
return scm_char_set (scm_list_1 (x));
758
else if (SCM_SMOB_PREDICATE (scm_tc16_charset, x))
761
scm_wrong_type_arg (NULL, 0, x);
765
SCM_DEFINE (scm_char_set_size, "char-set-size", 1, 0, 0,
767
"Return the number of elements in character set @var{cs}.")
768
#define FUNC_NAME s_scm_char_set_size
772
SCM_VALIDATE_SMOB (1, cs, charset);
773
for (k = 0; k < SCM_CHARSET_SIZE; k++)
774
if (SCM_CHARSET_GET (cs, k))
776
return SCM_I_MAKINUM (count);
781
SCM_DEFINE (scm_char_set_count, "char-set-count", 2, 0, 0,
783
"Return the number of the elements int the character set\n"
784
"@var{cs} which satisfy the predicate @var{pred}.")
785
#define FUNC_NAME s_scm_char_set_count
789
SCM_VALIDATE_PROC (1, pred);
790
SCM_VALIDATE_SMOB (2, cs, charset);
792
for (k = 0; k < SCM_CHARSET_SIZE; k++)
793
if (SCM_CHARSET_GET (cs, k))
795
SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
796
if (scm_is_true (res))
799
return SCM_I_MAKINUM (count);
804
SCM_DEFINE (scm_char_set_to_list, "char-set->list", 1, 0, 0,
806
"Return a list containing the elements of the character set\n"
808
#define FUNC_NAME s_scm_char_set_to_list
811
SCM result = SCM_EOL;
813
SCM_VALIDATE_SMOB (1, cs, charset);
814
for (k = SCM_CHARSET_SIZE; k > 0; k--)
815
if (SCM_CHARSET_GET (cs, k - 1))
816
result = scm_cons (SCM_MAKE_CHAR (k - 1), result);
822
SCM_DEFINE (scm_char_set_to_string, "char-set->string", 1, 0, 0,
824
"Return a string containing the elements of the character set\n"
825
"@var{cs}. The order in which the characters are placed in the\n"
826
"string is not defined.")
827
#define FUNC_NAME s_scm_char_set_to_string
835
SCM_VALIDATE_SMOB (1, cs, charset);
836
for (k = 0; k < SCM_CHARSET_SIZE; k++)
837
if (SCM_CHARSET_GET (cs, k))
839
result = scm_i_make_string (count, &p);
840
for (k = 0; k < SCM_CHARSET_SIZE; k++)
841
if (SCM_CHARSET_GET (cs, k))
848
SCM_DEFINE (scm_char_set_contains_p, "char-set-contains?", 2, 0, 0,
850
"Return @code{#t} iff the character @var{ch} is contained in the\n"
851
"character set @var{cs}.")
852
#define FUNC_NAME s_scm_char_set_contains_p
854
SCM_VALIDATE_SMOB (1, cs, charset);
855
SCM_VALIDATE_CHAR (2, ch);
856
return scm_from_bool (SCM_CHARSET_GET (cs, SCM_CHAR (ch)));
861
SCM_DEFINE (scm_char_set_every, "char-set-every", 2, 0, 0,
863
"Return a true value if every character in the character set\n"
864
"@var{cs} satisfies the predicate @var{pred}.")
865
#define FUNC_NAME s_scm_char_set_every
868
SCM res = SCM_BOOL_T;
870
SCM_VALIDATE_PROC (1, pred);
871
SCM_VALIDATE_SMOB (2, cs, charset);
873
for (k = 0; k < SCM_CHARSET_SIZE; k++)
874
if (SCM_CHARSET_GET (cs, k))
876
res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
877
if (scm_is_false (res))
885
SCM_DEFINE (scm_char_set_any, "char-set-any", 2, 0, 0,
887
"Return a true value if any character in the character set\n"
888
"@var{cs} satisfies the predicate @var{pred}.")
889
#define FUNC_NAME s_scm_char_set_any
893
SCM_VALIDATE_PROC (1, pred);
894
SCM_VALIDATE_SMOB (2, cs, charset);
896
for (k = 0; k < SCM_CHARSET_SIZE; k++)
897
if (SCM_CHARSET_GET (cs, k))
899
SCM res = scm_call_1 (pred, SCM_MAKE_CHAR (k));
900
if (scm_is_true (res))
908
SCM_DEFINE (scm_char_set_adjoin, "char-set-adjoin", 1, 0, 1,
910
"Add all character arguments to the first argument, which must\n"
911
"be a character set.")
912
#define FUNC_NAME s_scm_char_set_adjoin
916
SCM_VALIDATE_SMOB (1, cs, charset);
917
SCM_VALIDATE_REST_ARGUMENT (rest);
918
cs = scm_char_set_copy (cs);
920
p = (long *) SCM_SMOB_DATA (cs);
921
while (!scm_is_null (rest))
923
SCM chr = SCM_CAR (rest);
926
SCM_VALIDATE_CHAR_COPY (1, chr, c);
927
rest = SCM_CDR (rest);
929
p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
936
SCM_DEFINE (scm_char_set_delete, "char-set-delete", 1, 0, 1,
938
"Delete all character arguments from the first argument, which\n"
939
"must be a character set.")
940
#define FUNC_NAME s_scm_char_set_delete
944
SCM_VALIDATE_SMOB (1, cs, charset);
945
SCM_VALIDATE_REST_ARGUMENT (rest);
946
cs = scm_char_set_copy (cs);
948
p = (long *) SCM_SMOB_DATA (cs);
949
while (!scm_is_null (rest))
951
SCM chr = SCM_CAR (rest);
954
SCM_VALIDATE_CHAR_COPY (1, chr, c);
955
rest = SCM_CDR (rest);
957
p[c / SCM_BITS_PER_LONG] &= ~(1L << (c % SCM_BITS_PER_LONG));
964
SCM_DEFINE (scm_char_set_adjoin_x, "char-set-adjoin!", 1, 0, 1,
966
"Add all character arguments to the first argument, which must\n"
967
"be a character set.")
968
#define FUNC_NAME s_scm_char_set_adjoin_x
972
SCM_VALIDATE_SMOB (1, cs, charset);
973
SCM_VALIDATE_REST_ARGUMENT (rest);
975
p = (long *) SCM_SMOB_DATA (cs);
976
while (!scm_is_null (rest))
978
SCM chr = SCM_CAR (rest);
981
SCM_VALIDATE_CHAR_COPY (1, chr, c);
982
rest = SCM_CDR (rest);
984
p[c / SCM_BITS_PER_LONG] |= 1L << (c % SCM_BITS_PER_LONG);
991
SCM_DEFINE (scm_char_set_delete_x, "char-set-delete!", 1, 0, 1,
993
"Delete all character arguments from the first argument, which\n"
994
"must be a character set.")
995
#define FUNC_NAME s_scm_char_set_delete_x
999
SCM_VALIDATE_SMOB (1, cs, charset);
1000
SCM_VALIDATE_REST_ARGUMENT (rest);
1002
p = (long *) SCM_SMOB_DATA (cs);
1003
while (!scm_is_null (rest))
1005
SCM chr = SCM_CAR (rest);
1008
SCM_VALIDATE_CHAR_COPY (1, chr, c);
1009
rest = SCM_CDR (rest);
1011
p[c / SCM_BITS_PER_LONG] &= ~(1L << (c % SCM_BITS_PER_LONG));
1018
SCM_DEFINE (scm_char_set_complement, "char-set-complement", 1, 0, 0,
1020
"Return the complement of the character set @var{cs}.")
1021
#define FUNC_NAME s_scm_char_set_complement
1027
SCM_VALIDATE_SMOB (1, cs, charset);
1029
res = make_char_set (FUNC_NAME);
1030
p = (long *) SCM_SMOB_DATA (res);
1031
q = (long *) SCM_SMOB_DATA (cs);
1032
for (k = 0; k < LONGS_PER_CHARSET; k++)
1039
SCM_DEFINE (scm_char_set_union, "char-set-union", 0, 0, 1,
1041
"Return the union of all argument character sets.")
1042
#define FUNC_NAME s_scm_char_set_union
1048
SCM_VALIDATE_REST_ARGUMENT (rest);
1050
res = make_char_set (FUNC_NAME);
1051
p = (long *) SCM_SMOB_DATA (res);
1052
while (!scm_is_null (rest))
1055
SCM cs = SCM_CAR (rest);
1056
SCM_VALIDATE_SMOB (c, cs, charset);
1058
rest = SCM_CDR (rest);
1060
for (k = 0; k < LONGS_PER_CHARSET; k++)
1061
p[k] |= ((long *) SCM_SMOB_DATA (cs))[k];
1068
SCM_DEFINE (scm_char_set_intersection, "char-set-intersection", 0, 0, 1,
1070
"Return the intersection of all argument character sets.")
1071
#define FUNC_NAME s_scm_char_set_intersection
1075
SCM_VALIDATE_REST_ARGUMENT (rest);
1077
if (scm_is_null (rest))
1078
res = make_char_set (FUNC_NAME);
1084
res = scm_char_set_copy (SCM_CAR (rest));
1085
p = (long *) SCM_SMOB_DATA (res);
1086
rest = SCM_CDR (rest);
1088
while (scm_is_pair (rest))
1091
SCM cs = SCM_CAR (rest);
1094
SCM_VALIDATE_SMOB (argnum, cs, charset);
1096
cs_data = (long *) SCM_SMOB_DATA (cs);
1097
rest = SCM_CDR (rest);
1098
for (k = 0; k < LONGS_PER_CHARSET; k++)
1108
SCM_DEFINE (scm_char_set_difference, "char-set-difference", 1, 0, 1,
1109
(SCM cs1, SCM rest),
1110
"Return the difference of all argument character sets.")
1111
#define FUNC_NAME s_scm_char_set_difference
1117
SCM_VALIDATE_SMOB (1, cs1, charset);
1118
SCM_VALIDATE_REST_ARGUMENT (rest);
1120
res = scm_char_set_copy (cs1);
1121
p = (long *) SCM_SMOB_DATA (res);
1122
while (!scm_is_null (rest))
1125
SCM cs = SCM_CAR (rest);
1126
SCM_VALIDATE_SMOB (c, cs, charset);
1128
rest = SCM_CDR (rest);
1130
for (k = 0; k < LONGS_PER_CHARSET; k++)
1131
p[k] &= ~((long *) SCM_SMOB_DATA (cs))[k];
1138
SCM_DEFINE (scm_char_set_xor, "char-set-xor", 0, 0, 1,
1140
"Return the exclusive-or of all argument character sets.")
1141
#define FUNC_NAME s_scm_char_set_xor
1145
SCM_VALIDATE_REST_ARGUMENT (rest);
1147
if (scm_is_null (rest))
1148
res = make_char_set (FUNC_NAME);
1154
res = scm_char_set_copy (SCM_CAR (rest));
1155
p = (long *) SCM_SMOB_DATA (res);
1156
rest = SCM_CDR (rest);
1158
while (scm_is_pair (rest))
1160
SCM cs = SCM_CAR (rest);
1164
SCM_VALIDATE_SMOB (argnum, cs, charset);
1166
cs_data = (long *) SCM_SMOB_DATA (cs);
1167
rest = SCM_CDR (rest);
1169
for (k = 0; k < LONGS_PER_CHARSET; k++)
1178
SCM_DEFINE (scm_char_set_diff_plus_intersection, "char-set-diff+intersection", 1, 0, 1,
1179
(SCM cs1, SCM rest),
1180
"Return the difference and the intersection of all argument\n"
1182
#define FUNC_NAME s_scm_char_set_diff_plus_intersection
1188
SCM_VALIDATE_SMOB (1, cs1, charset);
1189
SCM_VALIDATE_REST_ARGUMENT (rest);
1191
res1 = scm_char_set_copy (cs1);
1192
res2 = make_char_set (FUNC_NAME);
1193
p = (long *) SCM_SMOB_DATA (res1);
1194
q = (long *) SCM_SMOB_DATA (res2);
1195
while (!scm_is_null (rest))
1198
SCM cs = SCM_CAR (rest);
1201
SCM_VALIDATE_SMOB (c, cs, charset);
1203
r = (long *) SCM_SMOB_DATA (cs);
1205
for (k = 0; k < LONGS_PER_CHARSET; k++)
1207
q[k] |= p[k] & r[k];
1210
rest = SCM_CDR (rest);
1212
return scm_values (scm_list_2 (res1, res2));
1217
SCM_DEFINE (scm_char_set_complement_x, "char-set-complement!", 1, 0, 0,
1219
"Return the complement of the character set @var{cs}.")
1220
#define FUNC_NAME s_scm_char_set_complement_x
1225
SCM_VALIDATE_SMOB (1, cs, charset);
1226
p = (long *) SCM_SMOB_DATA (cs);
1227
for (k = 0; k < LONGS_PER_CHARSET; k++)
1234
SCM_DEFINE (scm_char_set_union_x, "char-set-union!", 1, 0, 1,
1235
(SCM cs1, SCM rest),
1236
"Return the union of all argument character sets.")
1237
#define FUNC_NAME s_scm_char_set_union_x
1242
SCM_VALIDATE_SMOB (1, cs1, charset);
1243
SCM_VALIDATE_REST_ARGUMENT (rest);
1245
p = (long *) SCM_SMOB_DATA (cs1);
1246
while (!scm_is_null (rest))
1249
SCM cs = SCM_CAR (rest);
1250
SCM_VALIDATE_SMOB (c, cs, charset);
1252
rest = SCM_CDR (rest);
1254
for (k = 0; k < LONGS_PER_CHARSET; k++)
1255
p[k] |= ((long *) SCM_SMOB_DATA (cs))[k];
1262
SCM_DEFINE (scm_char_set_intersection_x, "char-set-intersection!", 1, 0, 1,
1263
(SCM cs1, SCM rest),
1264
"Return the intersection of all argument character sets.")
1265
#define FUNC_NAME s_scm_char_set_intersection_x
1270
SCM_VALIDATE_SMOB (1, cs1, charset);
1271
SCM_VALIDATE_REST_ARGUMENT (rest);
1273
p = (long *) SCM_SMOB_DATA (cs1);
1274
while (!scm_is_null (rest))
1277
SCM cs = SCM_CAR (rest);
1278
SCM_VALIDATE_SMOB (c, cs, charset);
1280
rest = SCM_CDR (rest);
1282
for (k = 0; k < LONGS_PER_CHARSET; k++)
1283
p[k] &= ((long *) SCM_SMOB_DATA (cs))[k];
1290
SCM_DEFINE (scm_char_set_difference_x, "char-set-difference!", 1, 0, 1,
1291
(SCM cs1, SCM rest),
1292
"Return the difference of all argument character sets.")
1293
#define FUNC_NAME s_scm_char_set_difference_x
1298
SCM_VALIDATE_SMOB (1, cs1, charset);
1299
SCM_VALIDATE_REST_ARGUMENT (rest);
1301
p = (long *) SCM_SMOB_DATA (cs1);
1302
while (!scm_is_null (rest))
1305
SCM cs = SCM_CAR (rest);
1306
SCM_VALIDATE_SMOB (c, cs, charset);
1308
rest = SCM_CDR (rest);
1310
for (k = 0; k < LONGS_PER_CHARSET; k++)
1311
p[k] &= ~((long *) SCM_SMOB_DATA (cs))[k];
1318
SCM_DEFINE (scm_char_set_xor_x, "char-set-xor!", 1, 0, 1,
1319
(SCM cs1, SCM rest),
1320
"Return the exclusive-or of all argument character sets.")
1321
#define FUNC_NAME s_scm_char_set_xor_x
1323
/* a side-effecting variant should presumably give consistent results:
1324
(define a (char-set #\a))
1325
(char-set-xor a a a) -> char set #\a
1326
(char-set-xor! a a a) -> char set #\a
1328
return scm_char_set_xor (scm_cons (cs1, rest));
1331
/* this would give (char-set-xor! a a a) -> empty char set. */
1335
SCM_VALIDATE_SMOB (1, cs1, charset);
1336
SCM_VALIDATE_REST_ARGUMENT (rest);
1338
p = (long *) SCM_SMOB_DATA (cs1);
1339
while (!scm_is_null (rest))
1342
SCM cs = SCM_CAR (rest);
1343
SCM_VALIDATE_SMOB (c, cs, charset);
1345
rest = SCM_CDR (rest);
1347
for (k = 0; k < LONGS_PER_CHARSET; k++)
1348
p[k] ^= ((long *) SCM_SMOB_DATA (cs))[k];
1356
SCM_DEFINE (scm_char_set_diff_plus_intersection_x, "char-set-diff+intersection!", 2, 0, 1,
1357
(SCM cs1, SCM cs2, SCM rest),
1358
"Return the difference and the intersection of all argument\n"
1360
#define FUNC_NAME s_scm_char_set_diff_plus_intersection_x
1366
SCM_VALIDATE_SMOB (1, cs1, charset);
1367
SCM_VALIDATE_SMOB (2, cs2, charset);
1368
SCM_VALIDATE_REST_ARGUMENT (rest);
1370
p = (long *) SCM_SMOB_DATA (cs1);
1371
q = (long *) SCM_SMOB_DATA (cs2);
1374
/* (char-set-diff+intersection! a a ...): can't share storage,
1375
but we know the answer without checking for further
1377
return scm_values (scm_list_2 (make_char_set (FUNC_NAME), cs1));
1379
for (k = 0; k < LONGS_PER_CHARSET; k++)
1386
while (!scm_is_null (rest))
1388
SCM cs = SCM_CAR (rest);
1391
SCM_VALIDATE_SMOB (c, cs, charset);
1393
r = (long *) SCM_SMOB_DATA (cs);
1395
for (k = 0; k < LONGS_PER_CHARSET; k++)
1397
q[k] |= p[k] & r[k];
1400
rest = SCM_CDR (rest);
1402
return scm_values (scm_list_2 (cs1, cs2));
1407
/* Standard character sets. */
1409
SCM scm_char_set_lower_case;
1410
SCM scm_char_set_upper_case;
1411
SCM scm_char_set_title_case;
1412
SCM scm_char_set_letter;
1413
SCM scm_char_set_digit;
1414
SCM scm_char_set_letter_and_digit;
1415
SCM scm_char_set_graphic;
1416
SCM scm_char_set_printing;
1417
SCM scm_char_set_whitespace;
1418
SCM scm_char_set_iso_control;
1419
SCM scm_char_set_punctuation;
1420
SCM scm_char_set_symbol;
1421
SCM scm_char_set_hex_digit;
1422
SCM scm_char_set_blank;
1423
SCM scm_char_set_ascii;
1424
SCM scm_char_set_empty;
1425
SCM scm_char_set_full;
1428
/* Create an empty character set and return it after binding it to NAME. */
1430
define_charset (const char *name)
1432
SCM cs = make_char_set (NULL);
1433
scm_c_define (name, cs);
1434
return scm_permanent_object (cs);
1437
/* Membership predicates for the various char sets.
1439
XXX: The `punctuation' and `symbol' char sets have no direct equivalent in
1440
<ctype.h>. Thus, the predicates below yield correct results for ASCII,
1441
but they do not provide the result described by the SRFI for Latin-1. The
1442
correct Latin-1 result could only be obtained by hard-coding the
1443
characters listed by the SRFI, but the problem would remain for other
1446
Similarly, character 0xA0 in Latin-1 (unbreakable space, `#\0240') should
1447
be part of `char-set:blank'. However, glibc's current (2006/09) Latin-1
1448
locales (which use the ISO 14652 "i18n" FDCC-set) do not consider it
1449
`blank' so it ends up in `char-set:punctuation'. */
1451
# define CSET_BLANK_PRED(c) (isblank (c))
1453
# define CSET_BLANK_PRED(c) \
1454
(((c) == ' ') || ((c) == '\t'))
1457
#define CSET_SYMBOL_PRED(c) \
1458
(((c) != '\0') && (strchr ("$+<=>^`|~", (c)) != NULL))
1459
#define CSET_PUNCT_PRED(c) \
1460
((ispunct (c)) && (!CSET_SYMBOL_PRED (c)))
1462
#define CSET_LOWER_PRED(c) (islower (c))
1463
#define CSET_UPPER_PRED(c) (isupper (c))
1464
#define CSET_LETTER_PRED(c) (isalpha (c))
1465
#define CSET_DIGIT_PRED(c) (isdigit (c))
1466
#define CSET_WHITESPACE_PRED(c) (isspace (c))
1467
#define CSET_CONTROL_PRED(c) (iscntrl (c))
1468
#define CSET_HEX_DIGIT_PRED(c) (isxdigit (c))
1469
#define CSET_ASCII_PRED(c) (isascii (c))
1471
/* Some char sets are explicitly defined by the SRFI as a union of other char
1472
sets so we try to follow this closely. */
1474
#define CSET_LETTER_AND_DIGIT_PRED(c) \
1475
(CSET_LETTER_PRED (c) || CSET_DIGIT_PRED (c))
1477
#define CSET_GRAPHIC_PRED(c) \
1478
(CSET_LETTER_PRED (c) || CSET_DIGIT_PRED (c) \
1479
|| CSET_PUNCT_PRED (c) || CSET_SYMBOL_PRED (c))
1481
#define CSET_PRINTING_PRED(c) \
1482
(CSET_GRAPHIC_PRED (c) || CSET_WHITESPACE_PRED (c))
1484
/* False and true predicates. */
1485
#define CSET_TRUE_PRED(c) (1)
1486
#define CSET_FALSE_PRED(c) (0)
1489
/* Compute the contents of all the standard character sets. Computation may
1490
need to be re-done at `setlocale'-time because some char sets (e.g.,
1491
`char-set:letter') need to reflect the character set supported by Guile.
1493
For instance, at startup time, the "C" locale is used, thus Guile supports
1494
only ASCII; therefore, `char-set:letter' only contains English letters.
1495
The user can change this by invoking `setlocale' and specifying a locale
1496
with an 8-bit charset, thereby augmenting some of the SRFI-14 standard
1499
This works because some of the predicates used below to construct
1500
character sets (e.g., `isalpha(3)') are locale-dependent (so
1501
charset-dependent, though generally not language-dependent). For details,
1502
please see the `guile-devel' mailing list archive of September 2006. */
1504
scm_srfi_14_compute_char_sets (void)
1506
#define UPDATE_CSET(c, cset, pred) \
1510
SCM_CHARSET_SET ((cset), (c)); \
1512
SCM_CHARSET_UNSET ((cset), (c)); \
1518
for (ch = 0; ch < 256; ch++)
1520
UPDATE_CSET (ch, scm_char_set_upper_case, CSET_UPPER_PRED);
1521
UPDATE_CSET (ch, scm_char_set_lower_case, CSET_LOWER_PRED);
1522
UPDATE_CSET (ch, scm_char_set_title_case, CSET_FALSE_PRED);
1523
UPDATE_CSET (ch, scm_char_set_letter, CSET_LETTER_PRED);
1524
UPDATE_CSET (ch, scm_char_set_digit, CSET_DIGIT_PRED);
1525
UPDATE_CSET (ch, scm_char_set_letter_and_digit,
1526
CSET_LETTER_AND_DIGIT_PRED);
1527
UPDATE_CSET (ch, scm_char_set_graphic, CSET_GRAPHIC_PRED);
1528
UPDATE_CSET (ch, scm_char_set_printing, CSET_PRINTING_PRED);
1529
UPDATE_CSET (ch, scm_char_set_whitespace, CSET_WHITESPACE_PRED);
1530
UPDATE_CSET (ch, scm_char_set_iso_control, CSET_CONTROL_PRED);
1531
UPDATE_CSET (ch, scm_char_set_punctuation, CSET_PUNCT_PRED);
1532
UPDATE_CSET (ch, scm_char_set_symbol, CSET_SYMBOL_PRED);
1533
UPDATE_CSET (ch, scm_char_set_hex_digit, CSET_HEX_DIGIT_PRED);
1534
UPDATE_CSET (ch, scm_char_set_blank, CSET_BLANK_PRED);
1535
UPDATE_CSET (ch, scm_char_set_ascii, CSET_ASCII_PRED);
1536
UPDATE_CSET (ch, scm_char_set_empty, CSET_FALSE_PRED);
1537
UPDATE_CSET (ch, scm_char_set_full, CSET_TRUE_PRED);
1545
scm_init_srfi_14 (void)
1547
scm_tc16_charset = scm_make_smob_type ("character-set",
1549
scm_set_smob_free (scm_tc16_charset, charset_free);
1550
scm_set_smob_print (scm_tc16_charset, charset_print);
1552
scm_char_set_upper_case = define_charset ("char-set:upper-case");
1553
scm_char_set_lower_case = define_charset ("char-set:lower-case");
1554
scm_char_set_title_case = define_charset ("char-set:title-case");
1555
scm_char_set_letter = define_charset ("char-set:letter");
1556
scm_char_set_digit = define_charset ("char-set:digit");
1557
scm_char_set_letter_and_digit = define_charset ("char-set:letter+digit");
1558
scm_char_set_graphic = define_charset ("char-set:graphic");
1559
scm_char_set_printing = define_charset ("char-set:printing");
1560
scm_char_set_whitespace = define_charset ("char-set:whitespace");
1561
scm_char_set_iso_control = define_charset ("char-set:iso-control");
1562
scm_char_set_punctuation = define_charset ("char-set:punctuation");
1563
scm_char_set_symbol = define_charset ("char-set:symbol");
1564
scm_char_set_hex_digit = define_charset ("char-set:hex-digit");
1565
scm_char_set_blank = define_charset ("char-set:blank");
1566
scm_char_set_ascii = define_charset ("char-set:ascii");
1567
scm_char_set_empty = define_charset ("char-set:empty");
1568
scm_char_set_full = define_charset ("char-set:full");
1570
scm_srfi_14_compute_char_sets ();
1572
#include "libguile/srfi-14.x"
1575
/* End of srfi-14.c. */