allowing (copy x) and other byte stream functions only on plain-old-data types
adding plain-old-data? predicate adding string.join
This commit is contained in:
parent
2ed581e62d
commit
aa62ae9e96
|
@ -583,27 +583,32 @@ size_t ctype_sizeof(value_t type, int *palign)
|
|||
return 0;
|
||||
}
|
||||
|
||||
extern fltype_t *iostreamtype;
|
||||
|
||||
// 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)) {
|
||||
if (iscvalue(v)) {
|
||||
cvalue_t *pcv = (cvalue_t*)ptr(v);
|
||||
*pdata = cv_data(pcv);
|
||||
*psz = cv_len(pcv);
|
||||
ios_t *x = value2c(ios_t*,v);
|
||||
if (cv_class(pcv) == iostreamtype && (x->bm == bm_mem)) {
|
||||
*pdata = x->buf;
|
||||
*psz = x->size;
|
||||
return;
|
||||
}
|
||||
else if (cv_isPOD(pcv)) {
|
||||
*pdata = cv_data(pcv);
|
||||
*psz = cv_len(pcv);
|
||||
return;
|
||||
}
|
||||
}
|
||||
else if (iscprim(v)) {
|
||||
cprim_t *pcp = (cprim_t*)ptr(v);
|
||||
*pdata = cp_data(pcp);
|
||||
*psz = cp_class(pcp)->size;
|
||||
return;
|
||||
}
|
||||
else {
|
||||
type_error(fname, "bytes", v);
|
||||
}
|
||||
type_error(fname, "plain-old-data", v);
|
||||
}
|
||||
|
||||
value_t cvalue_sizeof(value_t *args, u_int32_t nargs)
|
||||
|
@ -691,9 +696,19 @@ value_t fl_copy(value_t *args, u_int32_t nargs)
|
|||
lerror(ArgError, "copy: argument must be a leaf atom");
|
||||
if (!iscvalue(args[0]))
|
||||
return args[0];
|
||||
if (!cv_isPOD((cvalue_t*)ptr(args[0])))
|
||||
lerror(ArgError, "copy: argument must be a plain-old-data type");
|
||||
return cvalue_copy(args[0]);
|
||||
}
|
||||
|
||||
value_t fl_podp(value_t *args, u_int32_t nargs)
|
||||
{
|
||||
argcount("plain-old-data?", nargs, 1);
|
||||
return (iscprim(args[0]) ||
|
||||
(iscvalue(args[0]) && cv_isPOD((cvalue_t*)ptr(args[0])))) ?
|
||||
FL_T : FL_F;
|
||||
}
|
||||
|
||||
value_t fl_cv_pin(value_t *args, u_int32_t nargs)
|
||||
{
|
||||
argcount("cvalue.pin", nargs, 1);
|
||||
|
@ -908,6 +923,7 @@ static builtinspec_t cvalues_builtin_info[] = {
|
|||
{ "builtin", fl_builtin },
|
||||
{ "copy", fl_copy },
|
||||
{ "cvalue.pin", fl_cv_pin },
|
||||
{ "plain-old-data?", fl_podp },
|
||||
|
||||
{ "logand", fl_logand },
|
||||
{ "logior", fl_logior },
|
||||
|
|
|
@ -236,6 +236,7 @@ typedef struct {
|
|||
#define cv_type(cv) (cv_class(cv)->type)
|
||||
#define cv_data(cv) ((cv)->data)
|
||||
#define cv_isstr(cv) (cv_class(cv)->eltype == bytetype)
|
||||
#define cv_isPOD(cv) (cv_class(cv)->init != NULL)
|
||||
|
||||
#define cvalue_data(v) cv_data((cvalue_t*)ptr(v))
|
||||
#define value2c(type, v) ((type)cv_data((cvalue_t*)ptr(v)))
|
||||
|
|
|
@ -9,7 +9,7 @@
|
|||
|
||||
static value_t iostreamsym, rdsym, wrsym, apsym, crsym, truncsym;
|
||||
static value_t instrsym, outstrsym;
|
||||
static fltype_t *iostreamtype;
|
||||
fltype_t *iostreamtype;
|
||||
|
||||
void print_iostream(value_t v, ios_t *f, int princ)
|
||||
{
|
||||
|
|
|
@ -598,6 +598,15 @@
|
|||
(io.print b v)
|
||||
(io.tostring! b)))
|
||||
|
||||
(define (string.join strlist sep)
|
||||
(if (null? strlist) ""
|
||||
(let ((b (buffer)))
|
||||
(io.write b (car strlist))
|
||||
(for-each (lambda (s) (begin (io.write b sep)
|
||||
(io.write b s)))
|
||||
(cdr strlist))
|
||||
(io.tostring! b))))
|
||||
|
||||
; toplevel --------------------------------------------------------------------
|
||||
|
||||
(define (macrocall? e) (and (symbol? (car e))
|
||||
|
|
Loading…
Reference in New Issue