Add tests and documentation for define-binary-record-type.

Makefile

@@ -46,9 +46,10 @@ COMPILED_LIBS = $(CHIBI_COMPILED_LIBS) $(CHIBI_IO_COMPILED_LIBS) \
 BASE_INCLUDES = include/chibi/sexp.h include/chibi/features.h include/chibi/install.h include/chibi/bignum.h
 INCLUDES = $(BASE_INCLUDES) include/chibi/eval.h include/chibi/gc_heap.h
 
-MODULE_DOCS := app assert ast base64 bytevector config crypto/md5 crypto/rsa \
-	crypto/sha2 diff disasm doc edit-distance equiv filesystem generic \
-	heap-stats io iset/base iset/constructors iset/iterators json loop \
+MODULE_DOCS := app assert ast base64 binary-record bytevector config \
+	crypto/md5 crypto/rsa crypto/sha2 diff disasm doc edit-distance \
+	equiv filesystem generic heap-stats io \
+	iset/base iset/constructors iset/iterators json loop \
 	match math/prime memoize mime modules net net/http-server net/servlet \
 	optional parse pathname process repl scribble string stty sxml system \
 	temp-file test time trace type-inference uri weak monad/environment \

lib/chibi/binary-record-test.sld

@@ -0,0 +1,31 @@
+
+(define-library (chibi binary-record-test)
+  (export run-tests)
+  (import (scheme base) (chibi binary-record) (chibi test))
+  (begin
+    (define-binary-record-type gif-header
+      (make: make-gif-header)
+      (pred: gif-header?)
+      (read: read-gif-header)
+      (write: write-gif-header)
+      (block:
+       "GIF89a"
+       (width (u16/le) gif-header-width)
+       (height (u16/le) gif-header-height)
+       (gct (u8) gif-header-gct)
+       (bgcolor (u8) gif-header-gbcolor)
+       (aspect-ratio (u8) gif-header-aspect-ratio)
+       ))
+    (define (gif->bytevector gif)
+      (let ((out (open-output-bytevector)))
+        (write-gif-header gif out)
+        (get-output-bytevector out)))
+    (define (bytevector->gif bv)
+      (read-gif-header (open-input-bytevector bv)))
+    (define (run-tests)
+      (test-begin "(chibi binary-record)")
+      (let ((gif (make-gif-header 4096 2160 #xF7 1 2)))
+        (test #u8(#x47 #x49 #x46 #x38 #x39 #x61 0 #x10 #x70 #x08 #xF7 #x01 #x02)
+          (gif->bytevector gif))
+        (test gif (bytevector->gif (gif->bytevector gif))))
+      (test-end))))

lib/chibi/binary-record.scm

@@ -1,6 +1,80 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; binary records
+;; Binary Records
+
+;;> \macro{(define-binary-record-type <name> [<bindings> ...] (block: <fields> ...))}
+;;>
+;;> Defines a new record type that supports serializing to and from
+;;> binary ports.  The generated procedures accept keyword-style
+;;> arguments:
+;;>
+;;> \itemlist[
+;;> \item{\scheme{(make: <constructor-name>)}}
+;;> \item{\scheme{(pred: <predicate-name>)}}
+;;> \item{\scheme{(read: <reader-name>)}}
+;;> \item{\scheme{(write: <writer-name>)}}
+;;> \item{\scheme{(block: <fields> ...)}}
+;;> ]
+;;>
+;;> The fields are also similar to \scheme{define-record-type} but
+;;> with an additional type:
+;;>
+;;> \scheme{(field (type args ...) getter setter)}
+;;>
+;;> Built-in types include:
+;;>
+;;> \itemlist[
+;;> \item{\scheme{(u8)} - a single byte in [0, 255]}
+;;> \item{\scheme{(u16/le)} - a little-endian short integer}
+;;> \item{\scheme{(u16/be)} - a big-endian short integer}
+;;> \item{\scheme{(fixed-string <length>)} - a fixed-length utf-8 string}
+;;> \item{\scheme{(padded-string <length> (pad <pad-char>))} - a utf-8 string padded to a given length}
+;;> \item{\scheme{(octal <length>)} - an integer in octal string format}
+;;> \item{\scheme{(decimal <length>)} - an integer in decimal string format}
+;;> \item{\scheme{(hexadecimal <length>)} - an integer in hexadecimal string format}
+;;> ]
+;;>
+;;> In addition, the field can be a literal (char, string or
+;;> bytevector), for instance as a file magic sequence or fixed
+;;> separator.  The fields (and any constants) are serialized in the
+;;> order they appear in the block.  For example, the header of a GIF
+;;> file could be defined as:
+;;>
+;;> \example{
+;;>  (define-binary-record-type gif-header
+;;>    (make: make-gif-header)
+;;>    (pred: gif-header?)
+;;>    (read: read-gif-header)
+;;>    (write: write-gif-header)
+;;>    (block:
+;;>     "GIF89a"
+;;>     (width (u16/le) gif-header-width)
+;;>     (height (u16/le) gif-header-height)
+;;>     (gct (u8) gif-header-gct)
+;;>     (bgcolor (u8) gif-header-gbcolor)
+;;>     (aspect-ratio (u8) gif-header-aspect-ratio)
+;;>     ))
+;;> }
+;;>
+;;> For a more complex example see the \scheme{(chibi tar)}
+;;> implementation.
+;;>
+;;> The binary type itself is a macro used to expand to a predicate
+;;> and reader/writer procedures, which can be defined with
+;;> \scheme{define-binary-type}.  For example,
+;;>
+;;> \example{
+;;>  (define-binary-type (u8)
+;;>    (lambda (x) (and (exact-integer? x) (<= 0 x 255)))
+;;>    read-u8
+;;>    write-u8)
+;;> }
+
+(define-syntax define-binary-record-type
+  (syntax-rules ()
+    ((define-binary-record-type name x ...)
+     (defrec (x ...) name hidden-make hidden-pred hidden-read hidden-write
+       () () ()))))
 
 (define-syntax defrec
   (syntax-rules (make: pred: read: write: block:)
@@ -84,9 +158,3 @@
     ((defrec ((block:) . rest) n m p r w b f s)
      (defrec rest n m p r w b f s))
     ))
-
-(define-syntax define-binary-record-type
-  (syntax-rules ()
-    ((define-binary-record-type name x ...)
-     (defrec (x ...) name hidden-make hidden-pred hidden-read hidden-write
-       () () ()))))

lib/chibi/binary-record.sld

@@ -8,6 +8,26 @@
   (cond-expand
    ((library (srfi 130)) (import (srfi 130)))
    (else (import (srfi 13))))
+  (cond-expand
+   ;; ((library (auto))
+   ;;  (import (only (auto) make: pred: read: write: block:)))
+   (else
+    ;; indirect exports for chicken
+    (export defrec define-auxiliary-syntax syntax-let-optionals*)
+    (begin
+      (define-syntax define-auxiliary-syntax
+        (syntax-rules ()
+          ((define-auxiliary-syntax name)
+           (define-syntax name
+             (syntax-rules ()
+               ((name . x)
+                (syntax-error "invalid use of auxiliary syntax"
+                              (name . x))))))))
+      (define-auxiliary-syntax make:)
+      (define-auxiliary-syntax pred:)
+      (define-auxiliary-syntax read:)
+      (define-auxiliary-syntax write:)
+      (define-auxiliary-syntax block:))))
   (export
    ;; interface
    define-binary-record-type
@@ -16,9 +36,8 @@
    octal decimal hexadecimal
    ;; auxiliary syntax
    make: pred: read: write: block:
-   ;; indirect exports
-   define-binary-type defrec define-auxiliary-syntax
-   syntax-let-optionals*)
+   ;; new types
+   define-binary-type)
   (include "binary-types.scm")
   (cond-expand
    (chicken

lib/chibi/binary-types.scm

@@ -85,20 +85,6 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; syntax
 
-(define-syntax define-auxiliary-syntax
-  (syntax-rules ()
-    ((define-auxiliary-syntax name)
-     (define-syntax name
-       (syntax-rules ()
-         ((name . x)
-          (syntax-error "invalid use of auxiliary syntax" (name . x))))))))
-
-(define-auxiliary-syntax make:)
-(define-auxiliary-syntax pred:)
-(define-auxiliary-syntax read:)
-(define-auxiliary-syntax write:)
-(define-auxiliary-syntax block:)
-
 (define-syntax syntax-let-optionals*
   (syntax-rules ()
     ((syntax-let-optionals* () type-args expr)