allowing (copy x) and other byte stream functions only on plain-old-data types

adding plain-old-data? predicate
adding string.join

femtolisp/cvalues.c

@@ -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)) {
+    if (iscvalue(v)) {
+        cvalue_t *pcv = (cvalue_t*)ptr(v);
         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 (iscvalue(v)) {
+        else if (cv_isPOD(pcv)) {
-        cvalue_t *pcv = (cvalue_t*)ptr(v);
             *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, "plain-old-data", v);
-        type_error(fname, "bytes", 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 },

femtolisp/flisp.h

@@ -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)))

femtolisp/iostream.c

@@ -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)
 {

femtolisp/system.lsp

@@ -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))