lassik
/
upscheme
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

char read/print improvement 

adding char.upcase and char.downcase
This commit is contained in:
JeffBezanson 2009-03-24 21:27:38 +00:00
parent a9b0f7879b
commit b63a23eb1a
3 changed files with 25 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
femtolisp/print.c
View File

@ -475,11 +475,8 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
if (!princ) outsn("#\\", f, 2); if (!princ) outsn("#\\", f, 2);
outs(seq, f); outs(seq, f);
} }
else if (weak) {
HPOS+=ios_printf(f, "%d", (int)wc);
}
else { else {
HPOS+=ios_printf(f, "#%s(%d)", symbol_name(type), (int)wc); HPOS+=ios_printf(f, "#\\x%04x", (int)wc);
} }
} }
else if (type == int64sym else if (type == int64sym

5
femtolisp/read.c
View File

@ -206,9 +206,10 @@ static u_int32_t peek()
uint32_t cval; uint32_t cval;
if (ios_getutf8(F, &cval) == IOS_EOF) if (ios_getutf8(F, &cval) == IOS_EOF)
lerror(ParseError, "read: end of input in character constant"); lerror(ParseError, "read: end of input in character constant");
if (cval == (uint32_t)'u' || cval == (uint32_t)'U') { if (cval == (uint32_t)'u' || cval == (uint32_t)'U' ||
cval == (uint32_t)'x') {
read_token('u', 0); read_token('u', 0);
if (buf[1] != '\0') { // not a solitary 'u' or 'U' if (buf[1] != '\0') { // not a solitary 'u','U','x'
if (!read_numtok(&buf[1], &tokval, 16)) if (!read_numtok(&buf[1], &tokval, 16))
lerror(ParseError, lerror(ParseError,
"read: invalid hex character constant"); "read: invalid hex character constant");

21
femtolisp/string.c
View File

@ -8,6 +8,7 @@
#include <stdarg.h> #include <stdarg.h>
#include <assert.h> #include <assert.h>
#include <ctype.h> #include <ctype.h>
#include <wctype.h>
#include <sys/types.h> #include <sys/types.h>
#include <sys/time.h> #include <sys/time.h>
#include <errno.h> #include <errno.h>
@ -193,6 +194,23 @@ value_t fl_string_char(value_t *args, u_int32_t nargs)
return mk_wchar(u8_nextchar(s, &i)); return mk_wchar(u8_nextchar(s, &i));
} }
value_t fl_char_upcase(value_t *args, u_int32_t nargs)
{
argcount("char.upcase", nargs, 1);
cprim_t *cp = (cprim_t*)ptr(args[0]);
if (!iscprim(args[0]) || cp_class(cp) != wchartype)
type_error("char.upcase", "wchar", args[0]);
return mk_wchar(towupper(*(int32_t*)cp_data(cp)));
}
value_t fl_char_downcase(value_t *args, u_int32_t nargs)
{
argcount("char.downcase", nargs, 1);
cprim_t *cp = (cprim_t*)ptr(args[0]);
if (!iscprim(args[0]) || cp_class(cp) != wchartype)
type_error("char.downcase", "wchar", args[0]);
return mk_wchar(towlower(*(int32_t*)cp_data(cp)));
}
static value_t mem_find_byte(char *s, char c, size_t start, size_t len) static value_t mem_find_byte(char *s, char c, size_t start, size_t len)
{ {
char *p = memchr(s+start, c, len-start); char *p = memchr(s+start, c, len-start);
@ -351,6 +369,9 @@ static builtinspec_t stringfunc_info[] = {
{ "string.encode", fl_string_encode }, { "string.encode", fl_string_encode },
{ "string.decode", fl_string_decode }, { "string.decode", fl_string_decode },
{ "char.upcase", fl_char_upcase },
{ "char.downcase", fl_char_downcase },
{ "number->string", fl_numbertostring }, { "number->string", fl_numbertostring },
{ "string->number", fl_stringtonumber }, { "string->number", fl_stringtonumber },