diff --git a/syndicate/mc/preserve.rkt b/syndicate/mc/preserve.rkt index a085d2b..12df8b0 100644 --- a/syndicate/mc/preserve.rkt +++ b/syndicate/mc/preserve.rkt @@ -1,17 +1,31 @@ #lang racket/base ;; Preserve, as in Fruit Preserve, as in a remarkably weak pun on pickling/dehydration etc -(provide encode +(provide (struct-out stream-of) + (struct-out record) + short-form-labels + encode decode wire-value) +(require racket/bytes) +(require racket/dict) +(require racket/generator) (require racket/match) +(require racket/set) (require bitsyntax) (require syndicate/support/struct) (require imperative-syndicate/assertions) (require imperative-syndicate/pattern) +(struct stream-of (kind generator) #:transparent) + +(struct record (label fields) #:transparent) + +(define short-form-labels + (make-parameter (vector 'discard 'capture 'observe))) + (define version 1) (define (encode v) @@ -32,32 +46,6 @@ [(_ #t input ks kf) (decode-wire-length input ks kf)] [(_ #f v) (encode-wire-length v)])) -;; MM NN LLLL -;; -;; 00 00 0000 discard -;; 00 01 0001 capture -;; 00 10 0001 observe -;; 00 11 nnnn any other struct -;; -;; 01 00 nnnn list -;; 01 01 nnnn vector -;; -;; 10 00 nnnn signed integer, bigendian -;; 10 01 nnnn string -;; 10 10 nnnn bytes -;; 10 11 nnnn symbol -;; -;; 11 00 0000 #f -;; 11 00 0001 #t -;; 11 00 0010 (32 bits) single -;; 11 00 0011 (64 bits) double -;; -;; When nnnn = 1111, following bytes are real length -;; -;; The following bytes are a chain of big-endian, high-bit-continuation-bit chunks - -;;--------------------------------------------------------------------------- - (define (encode-wire-length v) (when (negative? v) (error 'encode-wire-length "Cannot encode negative wire-length ~v" v)) (if (< v #b1111) @@ -76,40 +64,75 @@ ((length fields) :: (wire-length)) ((apply bit-string-append (map encode-value fields)) :: binary))) -(define (encode-binary-like minor bs) - (bit-string (#b10 :: bits 2) +(define (encode-binary-like major minor bs) + (bit-string (major :: bits 2) (minor :: bits 2) ((bytes-length bs) :: (wire-length)) (bs :: binary))) +(define (encode-start-byte major minor) + (bit-string (#b0010 :: bits 4) (major :: bits 2) (minor :: bits 2))) + +(define (encode-end-byte major minor) + (bit-string (#b0011 :: bits 4) (major :: bits 2) (minor :: bits 2))) + +(define (encode-stream major minor chunk-ok? generator) + (bit-string-append (encode-start-byte major minor) + (let loop () + (match (generator) + [(? void?) #""] + [(? chunk-ok? v) (bit-string-append (encode-value v) (loop))] + [bad (error 'encode-stream "Cannot encode chunk: ~v" bad)])) + (encode-end-byte major minor))) + +(define (dict-keys-and-values d) + (reverse (for/fold [(acc '())] [((k v) (in-dict d))] (cons k (cons v acc))))) + +(define (short-form-for-label key) + (let ((labels (short-form-labels))) + (let loop ((i 0)) + (cond [(= i 3) #f] + [(equal? (vector-ref labels i) key) i] + [else (loop (+ i 1))])))) + +(define (encode-record key fields) + (define short (short-form-for-label key)) + (if short + (encode-array-like 2 short fields) + (encode-array-like 2 3 (cons key fields)))) + (define (encode-value v) (match v - [(discard) (encode-array-like 0 0 '())] - [(capture s) (encode-array-like 0 1 (list s))] - [(observe s) (encode-array-like 0 2 (list s))] - [(? non-object-struct?) - (define key (prefab-struct-key v)) - (when (not key) (error 'encode-value "Cannot encode non-prefab struct ~v" v)) - (define fields (cdr (vector->list (struct->vector v)))) - (encode-array-like 0 3 (cons key fields))] + [#f (bytes #b00000000)] + [#t (bytes #b00000001)] + [(? single-flonum?) (bit-string #b00000010 (v :: float bits 32))] + [(? double-flonum?) (bit-string #b00000011 (v :: float bits 64))] + [(? integer? x) #:when (<= -3 x 12) (bit-string (#b0001 :: bits 4) (x :: bits 4))] + [(stream-of 'string p) (encode-stream 1 1 bytes? p)] + [(stream-of 'byte-string p) (encode-stream 1 2 bytes? p)] + [(stream-of 'symbol p) (encode-stream 1 3 bytes? p)] + [(stream-of 'sequence p) (encode-stream 3 0 (lambda (x) #t) p)] + [(stream-of 'set p) (encode-stream 3 1 (lambda (x) #t) p)] + [(stream-of 'dictionary p) (encode-stream 3 2 (lambda (x) #t) p)] - [(? list?) (encode-array-like 1 0 v)] - [(? vector?) (encode-array-like 1 1 (vector->list v))] - - [(? single-flonum?) (bit-string #b11000010 (v :: float bits 32))] - [(? double-flonum?) (bit-string #b11000011 (v :: float bits 64))] - - [0 (bytes #b10000000)] + ;; [0 (bytes #b10000000)] [(? integer?) (define raw-bit-count (+ (integer-length v) 1)) ;; at least one sign bit (define byte-count (quotient (+ raw-bit-count 7) 8)) - (bit-string (#b1000 :: bits 4) (byte-count :: (wire-length)) (v :: integer bytes byte-count))] - [(? string?) (encode-binary-like 1 (string->bytes/utf-8 v))] - [(? bytes?) (encode-binary-like 2 v)] - [(? symbol?) (encode-binary-like 3 (string->bytes/utf-8 (symbol->string v)))] + (bit-string (#b0100 :: bits 4) (byte-count :: (wire-length)) (v :: integer bytes byte-count))] + [(? string?) (encode-binary-like 1 1 (string->bytes/utf-8 v))] + [(? bytes?) (encode-binary-like 1 2 v)] + [(? symbol?) (encode-binary-like 1 3 (string->bytes/utf-8 (symbol->string v)))] - [#f (bytes #b11000000)] - [#t (bytes #b11000001)] + [(record label fields) (encode-record label fields)] + [(? non-object-struct?) + (define key (prefab-struct-key v)) + (when (not key) (error 'encode-value "Cannot encode non-prefab struct ~v" v)) + (encode-record key (cdr (vector->list (struct->vector v))))] + + [(? list?) (encode-array-like 3 0 v)] + [(? set?) (encode-array-like 3 1 (set->list v))] + [(? dict?) (encode-array-like 3 2 (dict-keys-and-values v))] [_ (error 'encode-value "Cannot encode value ~v" v)])) @@ -144,52 +167,88 @@ (decode-values (- n 1) (cons v acc-rev) rest ks kf)) (else (kf))))) +(define (decode-binary minor bs rest ks kf) + (match minor + [0 (if (positive? (bit-string-length bs)) + (ks (bit-string->signed-integer bs #t) rest) + (ks 0 rest))] + [2 (ks bs rest)] + [(or 1 3) + ((with-handlers [(exn:fail:contract? (lambda (e) kf))] + (define s (bytes->string/utf-8 bs)) + (lambda () (ks (if (= minor 3) (string->symbol s) s) rest))))])) + +(define (decode-record minor fields rest ks kf) + (define (build key fs) + (ks (with-handlers [(exn:fail:contract? (lambda (e) (record key fs)))] + (apply make-prefab-struct key fs)) + rest)) + (match* (minor fields) + [(3 (list* key fs)) (build key fs)] + [(3 '()) (kf)] + [(n fs) (build (vector-ref (short-form-labels) n) fs)])) + +(define (decode-collection minor vs rest ks kf) + (match minor + [0 (ks vs rest)] + [1 (ks (list->set vs) rest)] + [2 (if (even? (length vs)) + (ks (apply hash vs) rest) + (kf))] + [_ (kf)])) + +(define (decode-stream major minor chunk-ok? join-chunks decode rest ks kf) + (let loop ((acc-rev '()) (rest rest)) + (bit-string-case rest + ([ (= #b0011 :: bits 4) (emajor :: bits 2) (eminor :: bits 2) (rest :: binary) ] + (if (and (= major emajor) (= minor eminor)) + (decode minor (join-chunks (reverse acc-rev)) rest ks kf) + (kf))) + (else + (decode-value rest + (lambda (chunk rest) + (if (chunk-ok? chunk) + (loop (cons chunk acc-rev) rest) + (kf))) + kf))))) + (define (decode-value bs ks kf) (bit-string-case bs - ([ (= #b00 :: bits 2) (minor :: bits 2) (field-count :: (wire-length)) (rest :: binary) ] - (decode-values field-count '() rest - (lambda (vs bs) - (match* (minor vs) - [(0 '()) (ks (discard) bs)] - [(1 (list s)) (ks (capture s) bs)] - [(2 (list s)) (ks (observe s) bs)] - [(3 (list* key fs)) (ks (apply make-prefab-struct key fs) bs)] - [(_ _) (kf)])) - kf)) - ([ (= #b01 :: bits 2) (minor :: bits 2) (count :: (wire-length)) (rest :: binary) ] - (decode-values count '() rest - (lambda (vs bs) - (match minor - [0 (ks vs bs)] - [1 (ks (list->vector vs) bs)] - [_ (kf)])) - kf)) - ([ (= #b10000000 :: bits 8) (rest :: binary) ] - (ks 0 rest)) ;; because a signed 0-bit integer == -1 ! - ([ (= #b1000 :: bits 4) (byte-count :: (wire-length)) - (v :: integer signed bytes byte-count) - (rest :: binary) ] - (ks v rest)) - ([ (= #b10 :: bits 2) (minor :: bits 2) (byte-count :: (wire-length)) + ([ (= #b00000000 :: bits 8) (rest :: binary) ] (ks #f rest)) + ([ (= #b00000001 :: bits 8) (rest :: binary) ] (ks #t rest)) + ([ (= #b00000010 :: bits 8) (v :: float bits 32) (rest :: binary) ] (ks (real->single-flonum v) rest)) + ([ (= #b00000011 :: bits 8) (v :: float bits 64) (rest :: binary) ] (ks v rest)) + ([ (= #b0001 :: bits 4) (x :: bits 4) (rest :: binary) ] (ks (if (> x 12) (- x 16) x) rest)) + + ([ (= #b001001 :: bits 6) (minor :: bits 2) (rest :: binary) ] + (decode-stream 1 minor bytes? bytes-append* decode-binary rest ks kf)) + ([ (= #b001010 :: bits 6) (minor :: bits 2) (rest :: binary) ] + (decode-stream 2 minor (lambda (x) #t) values decode-record rest ks kf)) + ([ (= #b001011 :: bits 6) (minor :: bits 2) (rest :: binary) ] + (decode-stream 3 minor (lambda (x) #t) values decode-collection rest ks kf)) + + ([ (= #b01 :: bits 2) (minor :: bits 2) (byte-count :: (wire-length)) (bits :: binary bytes byte-count) (rest :: binary) ] - (define bs (bit-string->bytes bits)) - (match minor - [2 (ks bs rest)] - [(or 1 3) - ((with-handlers [(exn:fail:contract? (lambda (e) kf))] - (define s (bytes->string/utf-8 bs)) - (lambda () (ks (if (= minor 3) (string->symbol s) s) rest))))])) - ([ (= #b11000000 :: bits 8) (rest :: binary) ] (ks #f rest)) - ([ (= #b11000001 :: bits 8) (rest :: binary) ] (ks #t rest)) - ([ (= #b11000010 :: bits 8) (v :: float bits 32) (rest :: binary) ] (ks v rest)) - ([ (= #b11000011 :: bits 8) (v :: float bits 64) (rest :: binary) ] (ks v rest)) + (decode-binary minor (bit-string->bytes bits) rest ks kf)) + + ([ (= #b10 :: bits 2) (minor :: bits 2) (field-count :: (wire-length)) (rest :: binary) ] + (decode-values field-count '() rest + (lambda (fields rest) (decode-record minor fields rest ks kf)) + kf)) + + ([ (= #b11 :: bits 2) (minor :: bits 2) (count :: (wire-length)) (rest :: binary) ] + (decode-values count '() rest + (lambda (vs rest) (decode-collection minor vs rest ks kf)) + kf)) + (else (kf)))) ;;--------------------------------------------------------------------------- (module+ test (require rackunit) + (require (for-syntax racket syntax/srcloc)) (check-equal? (bit-string->bytes (encode-varint 0)) (bytes 0)) (check-equal? (bit-string->bytes (encode-varint 1)) (bytes 1)) @@ -240,109 +299,126 @@ (struct speak (who what) #:prefab) - (check-equal? (encode (capture (discard))) (bytes version 17 0)) - (check-equal? (encode (observe (speak (discard) (capture (discard))))) - (bytes version 33 51 181 115 112 101 97 107 0 17 0)) - (check-equal? (encode '(1 2 3 4)) (bytes version 68 129 1 129 2 129 3 129 4)) - (check-equal? (encode '#(-2 -1 0 1)) (bytes version 84 129 254 129 255 128 129 1)) - (check-equal? (encode '("hello" there #"world" () #() #t #f)) - (bit-string->bytes - (bit-string 1 - 71 - #b10010101 (#"hello" :: binary) - #b10110101 (#"there" :: binary) - #b10100101 (#"world" :: binary) - 64 - 80 - #b11000001 - #b11000000))) - (check-equal? (encode -257) (bytes version 130 254 255)) - (check-equal? (encode -256) (bytes version 130 255 0)) - (check-equal? (encode -255) (bytes version 130 255 1)) - (check-equal? (encode -254) (bytes version 130 255 2)) - (check-equal? (encode -129) (bytes version 130 255 127)) - (check-equal? (encode -128) (bytes version 129 128)) - (check-equal? (encode -127) (bytes version 129 129)) - (check-equal? (encode -2) (bytes version 129 254)) - (check-equal? (encode -1) (bytes version 129 255)) - (check-equal? (encode 0) (bytes version 128)) - (check-equal? (encode 1) (bytes version 129 1)) - (check-equal? (encode 127) (bytes version 129 127)) - (check-equal? (encode 128) (bytes version 130 0 128)) - (check-equal? (encode 255) (bytes version 130 0 255)) - (check-equal? (encode 256) (bytes version 130 1 0)) - (check-equal? (encode 32767) (bytes version 130 127 255)) - (check-equal? (encode 32768) (bytes version 131 0 128 0)) - (check-equal? (encode 65535) (bytes version 131 0 255 255)) - (check-equal? (encode 65536) (bytes version 131 1 0 0)) - (check-equal? (encode 131072) (bytes version 131 2 0 0)) - (check-equal? (encode 1.0f0) (bytes version #b11000010 #b00111111 #b10000000 0 0)) - (check-equal? (encode 1.0) (bytes version #b11000011 #b00111111 #b11110000 0 0 0 0 0 0)) + (define (expected . pieces) + (bit-string->bytes + (apply bit-string-append + (map (match-lambda + [(? byte? b) (bytes b)] + [(? bytes? bs) bs] + [(? string? s) (string->bytes/utf-8 s)]) + pieces)))) (define (d bs) (decode bs void)) - (check-equal? (d (bytes version 17 0)) (capture (discard))) - (check-equal? (d (bytes (+ version 1) 17 0)) (void)) + (define-syntax (check-both-directions stx) + (syntax-case stx () + ((_ v (b ...)) + #'(let ((val v)) (check-both-directions v v (b ...)))) + ((_ forward back (b ...)) + #`(let ((loc #,(source-location->string #'forward))) + (check-equal? (d (encode forward)) back loc) + (check-equal? (d (encode back)) back loc) + (check-equal? (d (expected version b ...)) back loc) + (check-equal? (encode forward) (expected version b ...) loc) + )))) + + (check-both-directions (capture (discard)) (#x91 #x80)) + (check-both-directions (observe (speak (discard) (capture (discard)))) + (#xA1 #xB3 #x75 "speak" #x80 #x91 #x80)) + (check-both-directions '(1 2 3 4) (#xC4 #x11 #x12 #x13 #x14)) + (check-both-directions (stream-of 'sequence (sequence->generator '(1 2 3 4))) + '(1 2 3 4) + (#x2C #x11 #x12 #x13 #x14 #x3C)) + (check-both-directions '(-2 -1 0 1) (#xC4 #x1E #x1F #x10 #x11)) + (check-both-directions "hello" (#x55 "hello")) + (check-both-directions (stream-of 'string (sequence->generator '(#"he" #"llo"))) + "hello" + (#x25 #x62 "he" #x63 "llo" #x35)) + (check-both-directions (stream-of 'string (sequence->generator '(#"he" #"ll" #"" #"" #"o"))) + "hello" + (#x25 #x62 "he" #x62 "ll" #x60 #x60 #x61 "o" #x35)) + (check-both-directions (stream-of 'byte-string (sequence->generator '(#"he" #"ll" #"" #"" #"o"))) + #"hello" + (#x26 #x62 "he" #x62 "ll" #x60 #x60 #x61 "o" #x36)) + (check-both-directions (stream-of 'symbol (sequence->generator '(#"he" #"ll" #"" #"" #"o"))) + 'hello + (#x27 #x62 "he" #x62 "ll" #x60 #x60 #x61 "o" #x37)) + (check-both-directions `("hello" there #"world" () ,(set) #t #f) + (#xC7 #x55 "hello" #x75 "there" #x65 "world" #xC0 #xD0 #x01 #x00)) + + (check-both-directions -257 (#x42 #xFE #xFF)) + (check-both-directions -256 (#x42 #xFF #x00)) + (check-both-directions -255 (#x42 #xFF #x01)) + (check-both-directions -254 (#x42 #xFF #x02)) + (check-both-directions -129 (#x42 #xFF #x7F)) + (check-both-directions -128 (#x41 #x80)) + (check-both-directions -127 (#x41 #x81)) + (check-both-directions -4 (#x41 #xFC)) + (check-both-directions -3 (#x1D)) + (check-both-directions -2 (#x1E)) + (check-both-directions -1 (#x1F)) + (check-both-directions 0 (#x10)) + (check-both-directions 1 (#x11)) + (check-both-directions 12 (#x1C)) + (check-both-directions 13 (#x41 #x0D)) + (check-both-directions 127 (#x41 #x7F)) + (check-both-directions 128 (#x42 #x00 #x80)) + (check-both-directions 255 (#x42 #x00 #xFF)) + (check-both-directions 256 (#x42 #x01 #x00)) + (check-both-directions 32767 (#x42 #x7F #xFF)) + (check-both-directions 32768 (#x43 #x00 #x80 #x00)) + (check-both-directions 65535 (#x43 #x00 #xFF #xFF)) + (check-both-directions 65536 (#x43 #x01 #x00 #x00)) + (check-both-directions 131072 (#x43 #x02 #x00 #x00)) + + (check-both-directions 1.0f0 (#b00000010 #b00111111 #b10000000 0 0)) + (check-both-directions 1.0 (#b00000011 #b00111111 #b11110000 0 0 0 0 0 0)) + (check-both-directions -1.202e300 (#x03 #xFE #x3C #xB7 #xB7 #x59 #xBF #x04 #x26)) + + (check-equal? (d (bytes (+ version 1) #x91 #x80)) (void)) + (check-equal? (d (expected version #x25 #x51 "a" #x35)) (void)) ;; Bad chunk type: must be bytes + (check-equal? (d (expected version #x25 #x71 "a" #x35)) (void)) ;; Bad chunk type: must be bytes + (check-equal? (d (expected version #x26 #x51 "a" #x36)) (void)) ;; Bad chunk type: must be bytes + (check-equal? (d (expected version #x26 #x71 "a" #x36)) (void)) ;; Bad chunk type: must be bytes + (check-equal? (d (expected version #x27 #x51 "a" #x37)) (void)) ;; Bad chunk type: must be bytes + (check-equal? (d (expected version #x27 #x71 "a" #x37)) (void)) ;; Bad chunk type: must be bytes + (check-equal? (d (expected version #x25 #x61 "a" #x35)) "a") + (check-equal? (d (expected version #x26 #x61 "a" #x36)) #"a") + (check-equal? (d (expected version #x27 #x61 "a" #x37)) 'a) - (check-equal? (d (bytes version 68 129 1 129 2 129 3 129 4)) '(1 2 3 4)) - (check-equal? (d (bytes version 84 129 254 129 255 128 129 1)) '#(-2 -1 0 1)) - (check-equal? (d (bit-string->bytes - (bit-string 1 - 71 - #b10010101 (#"hello" :: binary) - #b10110101 (#"there" :: binary) - #b10100101 (#"world" :: binary) - 64 - 80 - #b11000001 - #b11000000))) - '("hello" there #"world" () #() #t #f)) - (check-equal? (d (bytes version 33 51 181 115 112 101 97 107 0 17 0)) - (observe (speak (discard) (capture (discard))))) - (check-equal? (d (bytes version 130 254 255)) -257) - (check-equal? (d (bytes version 130 255 0)) -256) - (check-equal? (d (bytes version 130 255 1)) -255) - (check-equal? (d (bytes version 130 255 2)) -254) - (check-equal? (d (bytes version 130 255 127)) -129) - (check-equal? (d (bytes version 129 128)) -128) - (check-equal? (d (bytes version 129 129)) -127) - (check-equal? (d (bytes version 129 254)) -2) - (check-equal? (d (bytes version 129 255)) -1) - (check-equal? (d (bytes version 128)) 0) - (check-equal? (d (bytes version 129 1)) 1) - (check-equal? (d (bytes version 129 127)) 127) - (check-equal? (d (bytes version 130 0 128)) 128) - (check-equal? (d (bytes version 130 0 255)) 255) - (check-equal? (d (bytes version 130 1 0)) 256) - (check-equal? (d (bytes version 130 127 255)) 32767) - (check-equal? (d (bytes version 131 0 128 0)) 32768) - (check-equal? (d (bytes version 131 0 255 255)) 65535) - (check-equal? (d (bytes version 131 1 0 0)) 65536) - (check-equal? (d (bytes version 131 2 0 0)) 131072) - (check-equal? (d (bytes version #b11000010 #b00111111 #b10000000 0 0)) 1.0) - (check-equal? (d (bytes version #b11000011 #b00111111 #b11110000 0 0 0 0 0 0)) 1.0) (struct date (year month day) #:prefab) (struct thing (id) #:prefab) (struct person thing (name date-of-birth) #:prefab) (struct titled person (title) #:prefab) - (check-equal? (encode (titled 101 "Blackwell" (date 1821 2 3) "Dr")) - (bytes version - #x35 ;; struct, generic, 4+1 - #x45 ;; list, 5 - #xb6 #x74 #x69 #x74 #x6c #x65 #x64 ;; symbol, "titled" - #xb6 #x70 #x65 #x72 #x73 #x6f #x6e ;; symbol, "person" - #x81 #x02 ;; integer, "2" - #xb5 #x74 #x68 #x69 #x6e #x67 ;; symbol, "thing" - #x81 #x01 ;; integer, "1" - #x81 #x65 ;; integer, "101" - #x99 #x42 #x6c #x61 #x63 #x6b #x77 #x65 #x6c #x6c ;; string, "Blackwell" - #x34 ;; struct, generic, 3+1 - #xb4 #x64 #x61 #x74 #x65 ;; symbol, "date" - #x82 #x07 #x1d ;; integer, "1821" - #x81 #x02 ;; integer, "2" - #x81 #x03 ;; integer, "3" - #x92 #x44 #x72 ;; string, "Dr" - )) + (check-both-directions + (titled 101 "Blackwell" (date 1821 2 3) "Dr") + (#xB5 ;; Record, generic, 4+1 + #xC5 ;; Sequence, 5 + #x76 #x74 #x69 #x74 #x6C #x65 #x64 ;; Symbol, "titled" + #x76 #x70 #x65 #x72 #x73 #x6F #x6E ;; Symbol, "person" + #x12 ;; SignedInteger, "2" + #x75 #x74 #x68 #x69 #x6E #x67 ;; Symbol, "thing" + #x11 ;; SignedInteger, "1" + #x41 #x65 ;; SignedInteger, "101" + #x59 #x42 #x6C #x61 #x63 #x6B #x77 #x65 #x6C #x6C ;; String, "Blackwell" + #xB4 ;; Record, generic, 3+1 + #x74 #x64 #x61 #x74 #x65 ;; Symbol, "date" + #x42 #x07 #x1D ;; SignedInteger, "1821" + #x12 ;; SignedInteger, "2" + #x13 ;; SignedInteger, "3" + #x52 #x44 #x72 ;; String, "Dr" + )) + + (check-both-directions (record 'discard '()) (discard) (#x80)) + (check-both-directions (record 'discard '(surprise)) '#s(discard surprise) (#x81 #x78 "surprise")) + (check-both-directions (record 'capture '(x)) (capture 'x) (#x91 #x71 "x")) + (check-both-directions (record 'observe '(x)) (observe 'x) (#xA1 #x71 "x")) + (check-both-directions (record 'observe '(x y)) '#s(observe x y) (#xA2 #x71 "x" #x71 "y")) + (check-both-directions (record 'other '(x y)) + '#s(other x y) + (#xB3 #x75 "other" #x71 "x" #x71 "y")) + (check-both-directions (record "aString" '(3 4)) (#xB3 #x57 "aString" #x13 #x14)) + (check-both-directions (record (discard) '(3 4)) (#xB3 #x80 #x13 #x14)) )