From 3558c0f4a61c9f148aa15a8057c8a6fa05fe0a76 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Thu, 30 May 2024 19:08:09 +0900 Subject: [PATCH] Add tests and documentation for define-binary-record-type. --- Makefile | 7 +-- lib/chibi/binary-record-test.sld | 31 ++++++++++++ lib/chibi/binary-record.scm | 82 +++++++++++++++++++++++++++++--- lib/chibi/binary-record.sld | 25 ++++++++-- lib/chibi/binary-types.scm | 14 ------ 5 files changed, 132 insertions(+), 27 deletions(-) create mode 100644 lib/chibi/binary-record-test.sld diff --git a/Makefile b/Makefile index f0a551be..e078d519 100644 --- a/Makefile +++ b/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 \ diff --git a/lib/chibi/binary-record-test.sld b/lib/chibi/binary-record-test.sld new file mode 100644 index 00000000..5f082afa --- /dev/null +++ b/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)))) diff --git a/lib/chibi/binary-record.scm b/lib/chibi/binary-record.scm index 085b3c73..bf87e133 100644 --- a/lib/chibi/binary-record.scm +++ b/lib/chibi/binary-record.scm @@ -1,6 +1,80 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; binary records +;; Binary Records + +;;> \macro{(define-binary-record-type [ ...] (block: ...))} +;;> +;;> Defines a new record type that supports serializing to and from +;;> binary ports. The generated procedures accept keyword-style +;;> arguments: +;;> +;;> \itemlist[ +;;> \item{\scheme{(make: )}} +;;> \item{\scheme{(pred: )}} +;;> \item{\scheme{(read: )}} +;;> \item{\scheme{(write: )}} +;;> \item{\scheme{(block: ...)}} +;;> ] +;;> +;;> 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 )} - a fixed-length utf-8 string} +;;> \item{\scheme{(padded-string (pad ))} - a utf-8 string padded to a given length} +;;> \item{\scheme{(octal )} - an integer in octal string format} +;;> \item{\scheme{(decimal )} - an integer in decimal string format} +;;> \item{\scheme{(hexadecimal )} - 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 - () () ())))) diff --git a/lib/chibi/binary-record.sld b/lib/chibi/binary-record.sld index 6aca4cc5..405eee03 100644 --- a/lib/chibi/binary-record.sld +++ b/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 diff --git a/lib/chibi/binary-types.scm b/lib/chibi/binary-types.scm index 69a55e41..24ed5ca0 100644 --- a/lib/chibi/binary-types.scm +++ b/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)