adding io.putc, io.tostring!, string.map, print-to-string
fixing bug in ios, not initializing readonly flag updating string and sizeof to use new strstream functions removing some redundant numeric type init functions
This commit is contained in:
JeffBezanson
parent
40cff81550
commit
fdfaacfbe5
|
|
@ -205,14 +205,14 @@
|
|||
|
||||
(define (β-reduce- form)
|
||||
; ((lambda (f) (f arg)) X) => (X arg)
|
||||
(cond ((and (= (length form) 2)
|
||||
(cond ((and (length= form 2)
|
||||
(pair? (car form))
|
||||
(eq (caar form) 'lambda)
|
||||
(let ((args (cadr (car form)))
|
||||
(body (caddr (car form))))
|
||||
(and (pair? body) (pair? args)
|
||||
(= (length body) 2)
|
||||
(= (length args) 1)
|
||||
(length= body 2)
|
||||
(length= args 1)
|
||||
(eq (car body) (car args))
|
||||
(not (eq (cadr body) (car args)))
|
||||
(symbol? (cadr body)))))
|
||||
|
|
@ -227,14 +227,14 @@
|
|||
; ((lambda (p1) ((lambda (args...) body) exprs...)) s) =>
|
||||
; ((lambda (p1 args...) body) s exprs...)
|
||||
; where exprs... doesn't contain p1
|
||||
((and (= (length form) 2)
|
||||
((and (length= form 2)
|
||||
(pair? (car form))
|
||||
(eq (caar form) 'lambda)
|
||||
(or (atom? (cadr form)) (constant? (cadr form)))
|
||||
(let ((args (cadr (car form)))
|
||||
(s (cadr form))
|
||||
(body (caddr (car form))))
|
||||
(and (pair? args) (= (length args) 1)
|
||||
(and (pair? args) (length= args 1)
|
||||
(pair? body)
|
||||
(pair? (car body))
|
||||
(eq (caar body) 'lambda)
|
||||
|
|
|
|||
|
|
@ -206,14 +206,18 @@ value_t cvalue_static_cstring(char *str)
|
|||
return cvalue_from_ref(stringtype, str, strlen(str), NIL);
|
||||
}
|
||||
|
||||
value_t string_from_cstr(char *str)
|
||||
value_t string_from_cstrn(char *str, size_t n)
|
||||
{
|
||||
size_t n = strlen(str);
|
||||
value_t v = cvalue_string(n);
|
||||
memcpy(cvalue_data(v), str, n);
|
||||
return v;
|
||||
}
|
||||
|
||||
value_t string_from_cstr(char *str)
|
||||
{
|
||||
return string_from_cstrn(str, strlen(str));
|
||||
}
|
||||
|
||||
int isstring(value_t v)
|
||||
{
|
||||
return (iscvalue(v) && cv_isstr((cvalue_t*)ptr(v)));
|
||||
|
|
@ -241,31 +245,45 @@ static void cv_pin(cvalue_t *cv)
|
|||
}
|
||||
*/
|
||||
|
||||
#define num_ctor(typenam, ctype, cnvt, tag) \
|
||||
static void cvalue_##typenam##_init(fltype_t *type, value_t arg, \
|
||||
void *dest) \
|
||||
{ \
|
||||
ctype##_t n=0; \
|
||||
(void)type; \
|
||||
if (isfixnum(arg)) { \
|
||||
n = numval(arg); \
|
||||
} \
|
||||
else if (iscprim(arg)) { \
|
||||
cprim_t *cp = (cprim_t*)ptr(arg); \
|
||||
void *p = cp_data(cp); \
|
||||
n = (ctype##_t)conv_to_##cnvt(p, cp_numtype(cp)); \
|
||||
} \
|
||||
else { \
|
||||
type_error(#typenam, "number", arg); \
|
||||
} \
|
||||
*((ctype##_t*)dest) = n; \
|
||||
} \
|
||||
#define num_init(ctype, cnvt, tag) \
|
||||
static int cvalue_##ctype##_init(fltype_t *type, value_t arg, \
|
||||
void *dest) \
|
||||
{ \
|
||||
ctype##_t n=0; \
|
||||
(void)type; \
|
||||
if (isfixnum(arg)) { \
|
||||
n = numval(arg); \
|
||||
} \
|
||||
else if (iscprim(arg)) { \
|
||||
cprim_t *cp = (cprim_t*)ptr(arg); \
|
||||
void *p = cp_data(cp); \
|
||||
n = (ctype##_t)conv_to_##cnvt(p, cp_numtype(cp)); \
|
||||
} \
|
||||
else { \
|
||||
return 1; \
|
||||
} \
|
||||
*((ctype##_t*)dest) = n; \
|
||||
return 0; \
|
||||
}
|
||||
num_init(int8, int32, T_INT8)
|
||||
num_init(uint8, uint32, T_UINT8)
|
||||
num_init(int16, int32, T_INT16)
|
||||
num_init(uint16, uint32, T_UINT16)
|
||||
num_init(int32, int32, T_INT32)
|
||||
num_init(uint32, uint32, T_UINT32)
|
||||
num_init(int64, int64, T_INT64)
|
||||
num_init(uint64, uint64, T_UINT64)
|
||||
num_init(float, double, T_FLOAT)
|
||||
num_init(double, double, T_DOUBLE)
|
||||
|
||||
#define num_ctor(typenam, ctype, tag) \
|
||||
value_t cvalue_##typenam(value_t *args, u_int32_t nargs) \
|
||||
{ \
|
||||
if (nargs==0) { PUSH(fixnum(0)); args = &Stack[SP-1]; } \
|
||||
value_t cp = cprim(typenam##type, sizeof(ctype##_t)); \
|
||||
cvalue_##typenam##_init(typenam##type, \
|
||||
args[0], cp_data((cprim_t*)ptr(cp))); \
|
||||
if (cvalue_##ctype##_init(typenam##type, \
|
||||
args[0], cp_data((cprim_t*)ptr(cp)))) \
|
||||
type_error(#typenam, "number", args[0]); \
|
||||
return cp; \
|
||||
} \
|
||||
value_t mk_##typenam(ctype##_t n) \
|
||||
|
|
@ -275,25 +293,25 @@ value_t mk_##typenam(ctype##_t n) \
|
|||
return cp; \
|
||||
}
|
||||
|
||||
num_ctor(int8, int8, int32, T_INT8)
|
||||
num_ctor(uint8, uint8, uint32, T_UINT8)
|
||||
num_ctor(int16, int16, int32, T_INT16)
|
||||
num_ctor(uint16, uint16, uint32, T_UINT16)
|
||||
num_ctor(int32, int32, int32, T_INT32)
|
||||
num_ctor(uint32, uint32, uint32, T_UINT32)
|
||||
num_ctor(int64, int64, int64, T_INT64)
|
||||
num_ctor(uint64, uint64, uint64, T_UINT64)
|
||||
num_ctor(byte, uint8, uint32, T_UINT8)
|
||||
num_ctor(wchar, int32, int32, T_INT32)
|
||||
num_ctor(int8, int8, T_INT8)
|
||||
num_ctor(uint8, uint8, T_UINT8)
|
||||
num_ctor(int16, int16, T_INT16)
|
||||
num_ctor(uint16, uint16, T_UINT16)
|
||||
num_ctor(int32, int32, T_INT32)
|
||||
num_ctor(uint32, uint32, T_UINT32)
|
||||
num_ctor(int64, int64, T_INT64)
|
||||
num_ctor(uint64, uint64, T_UINT64)
|
||||
num_ctor(byte, uint8, T_UINT8)
|
||||
num_ctor(wchar, int32, T_INT32)
|
||||
#ifdef BITS64
|
||||
num_ctor(long, long, int64, T_INT64)
|
||||
num_ctor(ulong, ulong, uint64, T_UINT64)
|
||||
num_ctor(long, int64, T_INT64)
|
||||
num_ctor(ulong, uint64, T_UINT64)
|
||||
#else
|
||||
num_ctor(long, long, int32, T_INT32)
|
||||
num_ctor(ulong, ulong, uint32, T_UINT32)
|
||||
num_ctor(long, int32, T_INT32)
|
||||
num_ctor(ulong, uint32, T_UINT32)
|
||||
#endif
|
||||
num_ctor(float, float, double, T_FLOAT)
|
||||
num_ctor(double, double, double, T_DOUBLE)
|
||||
num_ctor(float, float, T_FLOAT)
|
||||
num_ctor(double, double, T_DOUBLE)
|
||||
|
||||
value_t size_wrap(size_t sz)
|
||||
{
|
||||
|
|
@ -315,7 +333,7 @@ size_t toulong(value_t n, char *fname)
|
|||
return 0;
|
||||
}
|
||||
|
||||
static void cvalue_enum_init(fltype_t *ft, value_t arg, void *dest)
|
||||
static int cvalue_enum_init(fltype_t *ft, value_t arg, void *dest)
|
||||
{
|
||||
int n=0;
|
||||
value_t syms;
|
||||
|
|
@ -328,7 +346,7 @@ static void cvalue_enum_init(fltype_t *ft, value_t arg, void *dest)
|
|||
while (iscons(syms)) {
|
||||
if (car_(syms) == arg) {
|
||||
*(int*)dest = n;
|
||||
return;
|
||||
return 0;
|
||||
}
|
||||
n++;
|
||||
syms = cdr_(syms);
|
||||
|
|
@ -348,6 +366,7 @@ static void cvalue_enum_init(fltype_t *ft, value_t arg, void *dest)
|
|||
if ((unsigned)n >= llength(syms))
|
||||
lerror(ArgError, "enum: value out of range");
|
||||
*(int*)dest = n;
|
||||
return 0;
|
||||
}
|
||||
|
||||
value_t cvalue_enum(value_t *args, u_int32_t nargs)
|
||||
|
|
@ -388,7 +407,7 @@ static size_t predict_arraylen(value_t arg)
|
|||
return 1;
|
||||
}
|
||||
|
||||
static void cvalue_array_init(fltype_t *ft, value_t arg, void *dest)
|
||||
static int cvalue_array_init(fltype_t *ft, value_t arg, void *dest)
|
||||
{
|
||||
value_t type = ft->type;
|
||||
size_t elsize, i, cnt, sz;
|
||||
|
|
@ -408,7 +427,7 @@ static void cvalue_array_init(fltype_t *ft, value_t arg, void *dest)
|
|||
if (isvector(arg)) {
|
||||
array_init_fromargs((char*)dest, &vector_elt(arg,0), cnt,
|
||||
eltype, elsize);
|
||||
return;
|
||||
return 0;
|
||||
}
|
||||
else if (iscons(arg) || arg==NIL) {
|
||||
i = 0;
|
||||
|
|
@ -423,7 +442,7 @@ static void cvalue_array_init(fltype_t *ft, value_t arg, void *dest)
|
|||
lerror(ArgError, "array: size mismatch");
|
||||
array_init_fromargs((char*)dest, &Stack[SP-i], i, eltype, elsize);
|
||||
POPN(i);
|
||||
return;
|
||||
return 0;
|
||||
}
|
||||
else if (iscvalue(arg)) {
|
||||
cvalue_t *cv = (cvalue_t*)ptr(arg);
|
||||
|
|
@ -434,7 +453,7 @@ static void cvalue_array_init(fltype_t *ft, value_t arg, void *dest)
|
|||
memcpy(dest, cv_data(cv), sz);
|
||||
else
|
||||
lerror(ArgError, "array: size mismatch");
|
||||
return;
|
||||
return 0;
|
||||
}
|
||||
else {
|
||||
// TODO: initialize array from different type elements
|
||||
|
|
@ -446,6 +465,7 @@ static void cvalue_array_init(fltype_t *ft, value_t arg, void *dest)
|
|||
cvalue_init(eltype, arg, dest);
|
||||
else
|
||||
type_error("array", "sequence", arg);
|
||||
return 0;
|
||||
}
|
||||
|
||||
value_t cvalue_array(value_t *args, u_int32_t nargs)
|
||||
|
|
@ -593,19 +613,39 @@ size_t ctype_sizeof(value_t type, int *palign)
|
|||
return 0;
|
||||
}
|
||||
|
||||
// get pointer and size for any plain-old-data value
|
||||
void to_sized_ptr(value_t v, char *fname, char **pdata, size_t *psz)
|
||||
{
|
||||
if (isiostream(v) && (value2c(ios_t*,v)->bm == bm_mem)) {
|
||||
ios_t *x = value2c(ios_t*,v);
|
||||
*pdata = x->buf;
|
||||
*psz = x->size;
|
||||
}
|
||||
else if (iscvalue(v)) {
|
||||
cvalue_t *pcv = (cvalue_t*)ptr(v);
|
||||
*pdata = cv_data(pcv);
|
||||
*psz = cv_len(pcv);
|
||||
}
|
||||
else if (iscprim(v)) {
|
||||
cprim_t *pcp = (cprim_t*)ptr(v);
|
||||
*pdata = cp_data(pcp);
|
||||
*psz = cp_class(pcp)->size;
|
||||
}
|
||||
else {
|
||||
type_error(fname, "bytes", v);
|
||||
}
|
||||
}
|
||||
|
||||
value_t cvalue_sizeof(value_t *args, u_int32_t nargs)
|
||||
{
|
||||
argcount("sizeof", nargs, 1);
|
||||
if (iscvalue(args[0])) {
|
||||
cvalue_t *cv = (cvalue_t*)ptr(args[0]);
|
||||
return size_wrap(cv_len(cv));
|
||||
if (issymbol(args[0]) || iscons(args[0])) {
|
||||
int a;
|
||||
return size_wrap(ctype_sizeof(args[0], &a));
|
||||
}
|
||||
else if (iscprim(args[0])) {
|
||||
cprim_t *cp = (cprim_t*)ptr(args[0]);
|
||||
return fixnum(cp_class(cp)->size);
|
||||
}
|
||||
int a;
|
||||
return size_wrap(ctype_sizeof(args[0], &a));
|
||||
size_t n; char *data;
|
||||
to_sized_ptr(args[0], "sizeof", &data, &n);
|
||||
return size_wrap(n);
|
||||
}
|
||||
|
||||
value_t cvalue_typeof(value_t *args, u_int32_t nargs)
|
||||
|
|
@ -861,6 +901,9 @@ static builtinspec_t cvalues_builtin_info[] = {
|
|||
#define mk_primtype(name) \
|
||||
name##type=get_type(name##sym);name##type->init = &cvalue_##name##_init
|
||||
|
||||
#define mk_primtype_(name,ctype) \
|
||||
name##type=get_type(name##sym);name##type->init = &cvalue_##ctype##_init
|
||||
|
||||
void cvalues_init()
|
||||
{
|
||||
htable_new(&TypeTable, 256);
|
||||
|
|
@ -915,10 +958,15 @@ void cvalues_init()
|
|||
mk_primtype(uint32);
|
||||
mk_primtype(int64);
|
||||
mk_primtype(uint64);
|
||||
mk_primtype(long);
|
||||
mk_primtype(ulong);
|
||||
mk_primtype(byte);
|
||||
mk_primtype(wchar);
|
||||
#ifdef BITS64
|
||||
mk_primtype_(long,int64);
|
||||
mk_primtype_(ulong,uint64);
|
||||
#else
|
||||
mk_primtype_(long,int32);
|
||||
mk_primtype_(ulong,uint32);
|
||||
#endif
|
||||
mk_primtype_(byte,uint8);
|
||||
mk_primtype_(wchar,int32);
|
||||
mk_primtype(float);
|
||||
mk_primtype(double);
|
||||
|
||||
|
|
|
|||
|
|
@ -174,7 +174,7 @@ void fl_print_chr(char c, ios_t *f);
|
|||
void fl_print_str(char *s, ios_t *f);
|
||||
void fl_print_child(ios_t *f, value_t v, int princ);
|
||||
|
||||
typedef void (*cvinitfunc_t)(struct _fltype_t*, value_t, void*);
|
||||
typedef int (*cvinitfunc_t)(struct _fltype_t*, value_t, void*);
|
||||
|
||||
typedef struct _fltype_t {
|
||||
value_t type;
|
||||
|
|
@ -268,10 +268,14 @@ size_t toulong(value_t n, char *fname);
|
|||
value_t cvalue_string(size_t sz);
|
||||
value_t cvalue_static_cstring(char *str);
|
||||
value_t string_from_cstr(char *str);
|
||||
value_t string_from_cstrn(char *str, size_t n);
|
||||
int isstring(value_t v);
|
||||
int isnumber(value_t v);
|
||||
int isiostream(value_t v);
|
||||
value_t cvalue_compare(value_t a, value_t b);
|
||||
|
||||
void to_sized_ptr(value_t v, char *fname, char **pdata, size_t *psz);
|
||||
|
||||
fltype_t *get_type(value_t t);
|
||||
fltype_t *get_array_type(value_t eltype);
|
||||
fltype_t *define_opaque_type(value_t sym, size_t sz, cvtable_t *vtab,
|
||||
|
|
|
|||
|
|
@ -79,14 +79,14 @@ value_t fl_file(value_t *args, uint32_t nargs)
|
|||
return f;
|
||||
}
|
||||
|
||||
value_t fl_memstream(value_t *args, u_int32_t nargs)
|
||||
value_t fl_buffer(value_t *args, u_int32_t nargs)
|
||||
{
|
||||
argcount("memstream", nargs, 0);
|
||||
argcount("buffer", nargs, 0);
|
||||
(void)args;
|
||||
value_t f = cvalue(iostreamtype, sizeof(ios_t));
|
||||
ios_t *s = value2c(ios_t*, f);
|
||||
if (ios_mem(s, 0) == NULL)
|
||||
lerror(MemoryError, "memstream: could not allocate stream");
|
||||
lerror(MemoryError, "buffer: could not allocate stream");
|
||||
return f;
|
||||
}
|
||||
|
||||
|
|
@ -113,6 +113,17 @@ value_t fl_iogetc(value_t *args, u_int32_t nargs)
|
|||
return mk_wchar(wc);
|
||||
}
|
||||
|
||||
value_t fl_ioputc(value_t *args, u_int32_t nargs)
|
||||
{
|
||||
argcount("io.putc", nargs, 2);
|
||||
ios_t *s = toiostream(args[0], "io.putc");
|
||||
uint32_t wc;
|
||||
if (!iscprim(args[1]) || ((cprim_t*)ptr(args[1]))->type != wchartype)
|
||||
type_error("io.putc", "wchar", args[1]);
|
||||
wc = *(uint32_t*)cp_data((cprim_t*)ptr(args[1]));
|
||||
return fixnum(ios_pututf8(s, wc));
|
||||
}
|
||||
|
||||
value_t fl_ioflush(value_t *args, u_int32_t nargs)
|
||||
{
|
||||
argcount("io.flush", nargs, 1);
|
||||
|
|
@ -194,29 +205,6 @@ value_t fl_ioread(value_t *args, u_int32_t nargs)
|
|||
return cv;
|
||||
}
|
||||
|
||||
// get pointer and size for any plain-old-data value
|
||||
static void to_sized_ptr(value_t v, char *fname, char **pdata, size_t *psz)
|
||||
{
|
||||
if (isiostream(v) && (value2c(ios_t*,v)->bm == bm_mem)) {
|
||||
ios_t *x = value2c(ios_t*,v);
|
||||
*pdata = x->buf;
|
||||
*psz = x->size;
|
||||
}
|
||||
else if (iscvalue(v)) {
|
||||
cvalue_t *pcv = (cvalue_t*)ptr(v);
|
||||
*pdata = cv_data(pcv);
|
||||
*psz = cv_len(pcv);
|
||||
}
|
||||
else if (iscprim(v)) {
|
||||
cprim_t *pcp = (cprim_t*)ptr(v);
|
||||
*pdata = cp_data(pcp);
|
||||
*psz = cp_class(pcp)->size;
|
||||
}
|
||||
else {
|
||||
type_error(fname, "byte stream", v);
|
||||
}
|
||||
}
|
||||
|
||||
value_t fl_iowrite(value_t *args, u_int32_t nargs)
|
||||
{
|
||||
argcount("io.write", nargs, 2);
|
||||
|
|
@ -263,11 +251,39 @@ value_t fl_ioreaduntil(value_t *args, u_int32_t nargs)
|
|||
return str;
|
||||
}
|
||||
|
||||
value_t stream_to_string(value_t *ps)
|
||||
{
|
||||
value_t str;
|
||||
size_t n;
|
||||
ios_t *st = value2c(ios_t*,*ps);
|
||||
if (st->buf == &st->local[0]) {
|
||||
n = st->size;
|
||||
str = cvalue_string(n);
|
||||
memcpy(cvalue_data(str), value2c(ios_t*,*ps)->buf, n);
|
||||
}
|
||||
else {
|
||||
char *b = ios_takebuf(st, &n); n--;
|
||||
b[n] = '\0';
|
||||
str = cvalue_from_ref(stringtype, b, n, NIL);
|
||||
cv_autorelease((cvalue_t*)ptr(str));
|
||||
}
|
||||
return str;
|
||||
}
|
||||
|
||||
value_t fl_iotostring(value_t *args, u_int32_t nargs)
|
||||
{
|
||||
argcount("io.tostring!", nargs, 1);
|
||||
ios_t *src = toiostream(args[0], "io.tostring!");
|
||||
if (src->bm != bm_mem)
|
||||
lerror(ArgError, "io.tostring!: requires memory stream");
|
||||
return stream_to_string(&args[0]);
|
||||
}
|
||||
|
||||
static builtinspec_t iostreamfunc_info[] = {
|
||||
{ "iostream?", fl_iostreamp },
|
||||
{ "dump", fl_dump },
|
||||
{ "file", fl_file },
|
||||
{ "memstream", fl_memstream },
|
||||
{ "buffer", fl_buffer },
|
||||
{ "read", fl_read },
|
||||
{ "io.print", fl_ioprint },
|
||||
{ "io.princ", fl_ioprinc },
|
||||
|
|
@ -275,10 +291,12 @@ static builtinspec_t iostreamfunc_info[] = {
|
|||
{ "io.close", fl_ioclose },
|
||||
{ "io.eof?" , fl_ioeof },
|
||||
{ "io.getc" , fl_iogetc },
|
||||
{ "io.putc" , fl_ioputc },
|
||||
{ "io.discardbuffer", fl_iopurge },
|
||||
{ "io.read", fl_ioread },
|
||||
{ "io.write", fl_iowrite },
|
||||
{ "io.readuntil", fl_ioreaduntil },
|
||||
{ "io.tostring!", fl_iotostring },
|
||||
{ NULL, NULL }
|
||||
};
|
||||
|
||||
|
|
|
|||
|
|
@ -580,7 +580,7 @@ static value_t do_read_sexpr(value_t label)
|
|||
case TOK_DOUBLEQUOTE:
|
||||
return read_string();
|
||||
}
|
||||
return NIL;
|
||||
return FL_F;
|
||||
}
|
||||
|
||||
value_t read_sexpr(value_t f)
|
||||
|
|
|
|||
|
|
@ -14,24 +14,17 @@
|
|||
#include "llt.h"
|
||||
#include "flisp.h"
|
||||
|
||||
extern value_t fl_buffer(value_t *args, u_int32_t nargs);
|
||||
extern value_t stream_to_string(value_t *ps);
|
||||
static value_t print_to_string(value_t v, int princ)
|
||||
{
|
||||
ios_t str;
|
||||
ios_mem(&str, 0);
|
||||
print(&str, v, princ);
|
||||
value_t outp;
|
||||
if (str.size < MAX_INL_SIZE) {
|
||||
outp = cvalue_string(str.size);
|
||||
memcpy(cv_data((cvalue_t*)ptr(outp)), str.buf, str.size);
|
||||
}
|
||||
else {
|
||||
size_t sz;
|
||||
char *buf = ios_takebuf(&str, &sz);
|
||||
buf[sz] = '\0';
|
||||
outp = cvalue_from_ref(stringtype, buf, sz-1, NIL);
|
||||
cv_autorelease((cvalue_t*)ptr(outp));
|
||||
}
|
||||
ios_close(&str);
|
||||
PUSH(v);
|
||||
value_t buf = fl_buffer(NULL, 0);
|
||||
ios_t *s = value2c(ios_t*,buf);
|
||||
print(s, Stack[SP-1], princ);
|
||||
Stack[SP-1] = buf;
|
||||
value_t outp = stream_to_string(&Stack[SP-1]);
|
||||
(void)POP();
|
||||
return outp;
|
||||
}
|
||||
|
||||
|
|
@ -93,7 +86,7 @@ value_t fl_string_encode(value_t *args, u_int32_t nargs)
|
|||
return str;
|
||||
}
|
||||
}
|
||||
type_error("string.encode", "wide character array", args[0]);
|
||||
type_error("string.encode", "wchar array", args[0]);
|
||||
}
|
||||
|
||||
value_t fl_string_decode(value_t *args, u_int32_t nargs)
|
||||
|
|
@ -153,7 +146,7 @@ value_t fl_string(value_t *args, u_int32_t nargs)
|
|||
sz += cv_len((cvalue_t*)ptr(cv));
|
||||
continue;
|
||||
}
|
||||
args[i] = print_to_string(args[i], 0);
|
||||
args[i] = print_to_string(args[i], iscprim(args[i]));
|
||||
if (nargs == 1) // convert single value to string
|
||||
return args[i];
|
||||
sz += cv_len((cvalue_t*)ptr(args[i]));
|
||||
|
|
|
|||
|
|
@ -239,6 +239,15 @@
|
|||
(define (list-ref lst n)
|
||||
(car (nthcdr lst n)))
|
||||
|
||||
; bounded length test
|
||||
; use this instead of (= (length lst) n), since it avoids unnecessary
|
||||
; work and always terminates.
|
||||
(define (length= lst n)
|
||||
(cond ((< n 0) #f)
|
||||
((= n 0) (null? lst))
|
||||
((null? lst) (= n 0))
|
||||
(else (length= (cdr lst) (- n 1)))))
|
||||
|
||||
(define (list* . l)
|
||||
(if (atom? (cdr l))
|
||||
(car l)
|
||||
|
|
@ -408,6 +417,7 @@
|
|||
(define (vals->cond key v)
|
||||
(cond ((eq? v 'else) 'else)
|
||||
((null? v) #f)
|
||||
((atom? v) `(eqv? ,key ,v))
|
||||
((null? (cdr v)) `(eqv? ,key ,(quote-value (car v))))
|
||||
(else `(memv ,key ',v))))
|
||||
(let ((g (gensym)))
|
||||
|
|
@ -560,6 +570,20 @@
|
|||
(trim-start s at-start 0 L)
|
||||
(trim-end s at-end L))))
|
||||
|
||||
(define (string.map f s)
|
||||
(let ((b (buffer))
|
||||
(n (length s)))
|
||||
(let loop ((i 0))
|
||||
(if (< i n)
|
||||
(begin (io.putc b (f (string.char s i)))
|
||||
(loop (string.inc s i)))
|
||||
(io.tostring! b)))))
|
||||
|
||||
(define (print-to-string v)
|
||||
(let ((b (buffer)))
|
||||
(io.print b v)
|
||||
(io.tostring! b)))
|
||||
|
||||
(define (io.readline s) (io.readuntil s #byte(0xA)))
|
||||
|
||||
(define (repl)
|
||||
|
|
@ -584,12 +608,9 @@
|
|||
(define (print-exception e)
|
||||
(cond ((and (pair? e)
|
||||
(eq? (car e) 'type-error)
|
||||
(= (length e) 4))
|
||||
(io.princ *stderr* "type-error: ")
|
||||
(io.print *stderr* (cadr e))
|
||||
(io.princ *stderr* ": expected ")
|
||||
(io.print *stderr* (caddr e))
|
||||
(io.princ *stderr* ", got ")
|
||||
(length= e 4))
|
||||
(io.princ *stderr*
|
||||
"type-error: " (cadr e) ": expected " (caddr e) ", got ")
|
||||
(io.print *stderr* (cadddr e)))
|
||||
|
||||
((and (pair? e)
|
||||
|
|
@ -610,9 +631,12 @@
|
|||
(io.princ *stderr* "in file " (cadr e)))
|
||||
|
||||
((and (list? e)
|
||||
(= (length e) 2))
|
||||
(io.print *stderr* (car e))
|
||||
(io.princ *stderr* ": " (cadr e)))
|
||||
(length= e 2))
|
||||
(io.princ *stderr* (car e) ": ")
|
||||
(let ((msg (cadr e)))
|
||||
((if (or (string? msg) (symbol? msg))
|
||||
io.princ io.print)
|
||||
*stderr* msg)))
|
||||
|
||||
(else (io.princ *stderr* "*** Unhandled exception: ")
|
||||
(io.print *stderr* e)))
|
||||
|
|
|
|||
|
|
@ -838,7 +838,7 @@ String API
|
|||
*string.encode - to utf8
|
||||
*string.decode - from utf8 to UCS
|
||||
string.width - # columns
|
||||
string.map - (string.map f s)
|
||||
*string.map - (string.map f s)
|
||||
|
||||
|
||||
IOStream API
|
||||
|
|
@ -857,7 +857,8 @@ IOStream API
|
|||
*io.discardbuffer
|
||||
*io.write - (io.write s cvalue)
|
||||
*io.read - (io.read s ctype [len])
|
||||
io.getc - get utf8 character(s)
|
||||
*io.getc - get utf8 character
|
||||
*io.putc
|
||||
*io.readline
|
||||
*io.readuntil
|
||||
io.copy - (io.copy to from [nbytes])
|
||||
|
|
@ -867,6 +868,7 @@ IOStream API
|
|||
io.seekend - move to end of stream
|
||||
io.trunc
|
||||
io.read! - destructively take data
|
||||
*io.tostring!
|
||||
io.readlines
|
||||
io.readall
|
||||
print-to-string
|
||||
|
|
@ -955,6 +957,8 @@ consolidated todo list as of 8/30:
|
|||
- eliminate string copy in lerror() when possible
|
||||
* fix printing lists of short strings
|
||||
|
||||
- preallocate all byte,int8,uint8 values, and some wchars
|
||||
|
||||
- remaining c types
|
||||
- remaining cvalues functions
|
||||
- finish ios
|
||||
|
|
|
|||
|
|
@ -674,6 +674,7 @@ static void _ios_init(ios_t *s)
|
|||
s->ownfd = 0;
|
||||
s->_eof = 0;
|
||||
s->rereadable = 0;
|
||||
s->readonly = 0;
|
||||
}
|
||||
|
||||
/* stream object initializers. we do no allocation. */
|
||||
|
|
@ -828,6 +829,13 @@ int ios_getutf8(ios_t *s, uint32_t *pwc)
|
|||
return 1;
|
||||
}
|
||||
|
||||
int ios_pututf8(ios_t *s, uint32_t wc)
|
||||
{
|
||||
char buf[8];
|
||||
size_t n = u8_toutf8(buf, 8, &wc, 1);
|
||||
return ios_write(s, buf, n);
|
||||
}
|
||||
|
||||
void ios_purge(ios_t *s)
|
||||
{
|
||||
if (s->state == bst_rd) {
|
||||
|
|
|
|||
Loading…
Reference in New Issue