Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 14:19:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Adding R7RS extended char names.

Browse source
This commit is contained in:
Alex Shinn 2012-03-07 21:19:58 +09:00
parent bbe56ad069
commit 4cf1e72625
2 changed files with 59 additions and 35 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
include/chibi/features.h
View file

@ -166,6 +166,9 @@
/* non-immediate symbols in a single list. */
/* #define SEXP_USE_HASH_SYMS 0 */
/* uncomment this to disable extended char names as defined in R7RS */
/* #define SEXP_USE_EXTENDED_CHAR_NAMES 0 */
/* uncomment this to disable UTF-8 string support */
/* The default settings store strings in memory as UTF-8, */
/* and assumes strings passed to/from the C FFI are UTF-8. */
@ -500,6 +503,10 @@
#define SEXP_USE_PROFILE_VM 0
#endif
#ifndef SEXP_USE_EXTENDED_CHAR_NAMES
#define SEXP_USE_EXTENDED_CHAR_NAMES ! SEXP_USE_NO_FEATURES
#endif
#ifndef SEXP_USE_UTF8_STRINGS
#define SEXP_USE_UTF8_STRINGS ! SEXP_USE_NO_FEATURES
#endif

59
sexp.c
View file

@ -1456,6 +1456,22 @@ sexp sexp_set_port_fold_case (sexp ctx, sexp self, sexp_sint_t n, sexp in, sexp
#define NUMBUF_LEN 32
static struct {const char* name; char ch;} sexp_char_names[] = {
{"newline", '\n'},
{"return", '\r'},
{"space", ' '},
{"tab", '\t'},
#if SEXP_USE_EXTENDED_CHAR_NAMES
{"alarm", '\a'},
{"backspace", '\b'},
{"delete", 127},
{"escape", '\e'},
{"null", 0},
#endif
};
#define sexp_num_char_names (sizeof(sexp_char_names)/sizeof(sexp_char_names[0]))
sexp sexp_apply_writer(sexp ctx, sexp writer, sexp obj, sexp out) {
sexp res;
sexp_gc_var1(args);
@ -1665,20 +1681,19 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) {
sexp_write_string(ctx, numbuf, out);
#endif
} else if (sexp_charp(obj)) {
if (obj == sexp_make_character(' '))
sexp_write_string(ctx, "#\\space", out);
else if (obj == sexp_make_character('\n'))
sexp_write_string(ctx, "#\\newline", out);
else if (obj == sexp_make_character('\r'))
sexp_write_string(ctx, "#\\return", out);
else if (obj == sexp_make_character('\t'))
sexp_write_string(ctx, "#\\tab", out);
else if ((33 <= sexp_unbox_character(obj))
&& (sexp_unbox_character(obj) < 127)) {
sexp_write_string(ctx, "#\\", out);
for (i=0; i < sexp_num_char_names; i++) {
if (sexp_unbox_character(obj) == sexp_char_names[i].ch) {
sexp_write_string(ctx, sexp_char_names[i].name, out);
break;
}
}
if (i >= sexp_num_char_names) {
if ((33 <= sexp_unbox_character(obj))
&& (sexp_unbox_character(obj) < 127)) {
sexp_write_char(ctx, sexp_unbox_character(obj), out);
} else {
sexp_write_string(ctx, "#\\x", out);
sexp_write_string(ctx, "x", out);
c = sexp_unbox_character(obj);
if (c >= 0x100) {
if (c >= 0x10000) {
@ -1691,6 +1706,7 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) {
sexp_write_char(ctx, hex_digit((c>>4)&0x0F), out);
sexp_write_char(ctx, hex_digit(c&0x0F), out);
}
}
} else if (sexp_symbolp(obj)) {
#if SEXP_USE_HUFF_SYMS
@ -2462,19 +2478,20 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
res = sexp_make_character(16 * digit_value(str[1])
+ digit_value(str[2]));
} else {
if (strcasecmp(str, "space") == 0)
res = sexp_make_character(' ');
else if (strcasecmp(str, "newline") == 0)
res = sexp_make_character('\n');
else if (strcasecmp(str, "return") == 0)
res = sexp_make_character('\r');
else if (strcasecmp(str, "tab") == 0)
res = sexp_make_character('\t');
res = 0;
for (c2=0; c2 < sexp_num_char_names; c2++) {
if (strcasecmp(str, sexp_char_names[c2].name) == 0) {
res = sexp_make_character(sexp_char_names[c2].ch);
break;
}
}
if (!res) {
#if SEXP_USE_UTF8_STRINGS
else if ((c1=sexp_decode_utf8_char((unsigned char*)str)) > 0)
if ((c1=sexp_decode_utf8_char((unsigned char*)str)) > 0) {
res = sexp_make_character(c1);
break;
}
#endif
else {
tmp = sexp_c_string(ctx, str, -1);
res = sexp_read_error(ctx, "unknown character name", tmp, in);
}