Add "stateful" setters.

dns/internal/bv.scm

@@ -11,7 +11,10 @@
   :use-module (dns internal state-monad)
   :use-module (rnrs bytevectors)
   :use-module (srfi srfi-88)
-  :export (u8 u16 u32 bv-get uint-get)
+  :export (bv-copy!
+           u8! u16! u32!
+           u8 u16 u32 bv-get uint-get
+              )
   )
 
 
@@ -48,3 +51,51 @@
 (define (uint-get bv len)
   (do vec <- (bv-get bv len)
       (return (bytevector-uint-ref vec 0 (endianness big) len))))
+
+(define (double-bv bv)
+  (define new-bv (make-bytevector (* 2 (max 1 (bytevector-length bv)))))
+  (bytevector-copy! bv 0 new-bv 0 (bytevector-length bv))
+  new-bv)
+
+(define (with-resizing-bv bv proc)
+  (catch 'out-of-range
+    (lambda () (proc bv) bv)
+    (lambda (err err-proc msg arg data)
+      ;; Call ourselves recursivly, if index is way out of bounds
+      (with-resizing-bv (double-bv bv) proc))))
+
+(define (bytevector-u8-set-safe! bv ptr item)
+  (with-resizing-bv bv (lambda (bv) (bytevector-u8-set! bv ptr item))))
+
+(define* (bytevector-u16-set-safe! bv ptr item optional: (e (endianness big)))
+  (with-resizing-bv bv (lambda (bv) (bytevector-u16-set! bv ptr item e))))
+
+(define* (bytevector-u32-set-safe! bv ptr item optional: (e (endianness big)))
+  (with-resizing-bv bv (lambda (bv) (bytevector-u32-set! bv ptr item e))))
+
+(define (bytevector-copy-safe! source source-start target target-start len)
+  (with-resizing-bv target (lambda (target) (bytevector-copy! source source-start target target-start len))))
+
+(define ((u8! item) bv ptr)
+  (values #f
+          (bytevector-u8-set-safe! bv ptr item)
+          (+ ptr 1)))
+
+(define* ((u16! item optional: (e (endianness big))) bv ptr)
+  (values #f
+          (bytevector-u16-set-safe! bv ptr item e)
+          (+ ptr 2)))
+
+(define* ((u32! item optional: (e (endianness big))) bv ptr)
+  (values #f
+          (bytevector-u32-set-safe! bv ptr item e)
+          (+ ptr 4)))
+
+(define* ((bv-copy! source
+                    optional:
+                    (start 0)
+                    (length (- (bytevector-length source) start)))
+          bv ptr)
+  (values #f
+          (bytevector-copy-safe! source start bv ptr length)
+          (+ ptr length)))