cl-rw

commit 317831950795c10fa8ac2242bea21b4c3e726b54
parent aabe60928a8070ea42435e7202090c05e90424d9
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sat, 20 Sep 2014 13:38:07 +0200

writers added

Diffstat:
M
rw.lisp
 | 
21
++++++++++++++++++---

1 file changed, 18 insertions(+), 3 deletions(-)
diff --git a/rw.lisp b/rw.lisp
@@ -46,10 +46,12 @@
            :slurp
            :till
            :wrap-reader
+           :wrap-writer
            :write-octets
            :write-u16
            :write-u32
-           :write-u8))
+           :write-u8
+           :writer))
 
 (in-package :rw)
 
@@ -267,6 +269,15 @@
 ;; TODO next-u64|128
 ;; TODO next-s8|16|32|64|128
 
+(defun writer (x)
+  (etypecase x
+    ;;(list (lambda () (pop x)))
+    (vector
+     (if (adjustable-array-p x)
+         (lambda (v) (vector-push-extend v x))
+         (let ((i -1))
+           (lambda (v) (setf (aref x (incf i)) v)))))))
+
 (defun char-writer (stream)
   (lambda (x)
     (write-char x stream)))
@@ -291,8 +302,8 @@
 
 (defun copy (reader writer)
   (do (x)
-      ((not (setq x (next-u8 reader))))
-    (write-u8 writer x)))
+      ((not (setq x (funcall reader))))
+    (funcall writer x)))
 
 (defun write-octets (writer x)
   (etypecase x
@@ -349,3 +360,7 @@
     (let ((z (rw:next reader)))
       (when z
         (funcall fn z)))))
+
+(defun wrap-writer (writer fn)
+  (lambda (x)
+    (funcall writer (funcall fn x))))