ehmry
/
preserves
forked from syndicate-lang/preserves
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Update Racket implementation

This commit is contained in:
Tony Garnock-Jones 2020-12-30 16:43:18 +01:00
parent 5d719c2c6f
commit 85fe7b3b07
18 changed files with 1596 additions and 1452 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
implementations/racket/preserves/info.rkt
View File

@ -1,6 +1,5 @@
#lang setup/infotab
(define collection 'multi)
(define deps '("base"
"bitsyntax"
"rackunit-lib"
"data-lib"))

72
implementations/racket/preserves/preserves/annotation.rkt Normal file
View File

@ -0,0 +1,72 @@
#lang racket/base
(provide (struct-out annotated)
annotate
strip-annotations
strip-annotations-proc
peel-annotations
peel-annotations-proc)
(require racket/match)
(require (for-syntax racket/base))
(require "record.rkt")
(require racket/dict)
(require racket/set)
;; Syntax properties and syntax objects would be almost perfect for
;; representing annotations, plus position/source tracking as
;; lagniappe, but unfortunately they don't play nicely with data much
;; outside of ordinary S-expressions as found in Racket source.
;;
;; So we do our own thing, for now.
;;
;; See also https://gitlab.com/preserves/preserves/-/issues/16,
;; 'Consider Racket "correlated objects" for annotations
;; representation'.
;;
(struct annotated (annotations srcloc item) #:transparent
#:methods gen:equal+hash
[(define (equal-proc a b =?) (=? (annotated-item a) (annotated-item b)))
(define (hash-proc a h) (h (annotated-item a)))
(define (hash2-proc a h) (h (annotated-item a)))])
(define (annotate v . as)
(match v
[(annotated annotations srcloc item)
(annotated (append as annotations) srcloc item)]
[item
(annotated as #f item)]))
(define (strip-annotations-proc v #:depth [depth +inf.0])
(let walk* ((v v) (depth depth))
(define next-depth (- depth 1))
(define (walk v) (walk* v next-depth))
(if (zero? depth)
v
(match v
[(annotated _ _ item)
(match item
[(record label fields) (record (walk* label depth) (map walk fields))]
[(? list?) (map walk item)]
[(? set?) (for/set [(i (in-set item))] (walk i))]
[(? dict?) (for/hash [((k v) (in-dict item))] (values (walk* k depth) (walk v)))]
[(? annotated?) (error 'strip-annotations "Improper annotation structure: ~v" v)]
[_ item])]
[_ v]))))
(define (peel-annotations-proc v)
(strip-annotations-proc v #:depth 1))
(define-match-expander strip-annotations
(syntax-rules () [(_ pat extra ...) (app (lambda (v) (strip-annotations-proc v extra ...)) pat)])
(lambda (stx)
(syntax-case stx ()
[(_ args ...) #'(strip-annotations-proc args ...)]
[_ #'strip-annotations-proc])))
(define-match-expander peel-annotations
(syntax-rules () [(_ pat extra ...) (app (lambda (v) (peel-annotations-proc v extra ...)) pat)])
(lambda (stx)
(syntax-case stx ()
[(_ args ...) #'(peel-annotations-proc args ...)]
[_ #'peel-annotations-proc])))

8
implementations/racket/preserves/preserves/float.rkt Normal file
View File

@ -0,0 +1,8 @@
#lang racket/base
;; Wrapper struct to mark a need for 32-bit IEEE floating-point
;; precision (de)serialization. In many circumstances, Racket lacks
;; 32-bit floating point support, and single-flonum? always yields #f.
(provide (struct-out float))
(struct float (value) #:transparent)

138
implementations/racket/preserves/preserves/jelly.rkt Normal file
View File

@ -0,0 +1,138 @@
#lang racket
;; Jelly, a very shaky implementation of Preserves - intended to
;; demonstrate a minimal implementation of Preserves binary I/O,
;; without error-checking or configurability etc.
(provide (all-defined-out))
;;---------------------------------------------------------------------------
;; Representing values
(struct record (label fields) #:transparent)
(struct float (value) #:transparent) ;; a marker for single-precision I/O
(struct annotated (annotations item) #:transparent)
;;---------------------------------------------------------------------------
;; Reader
(define (read-preserve/binary [in-port (current-input-port)])
(let/ec return
(define (next)
(match (next-byte)
[#x80 #f]
[#x81 #t]
[#x82 (float (floating-point-bytes->real (next-bytes 4) #t 0 4))]
[#x83 (floating-point-bytes->real (next-bytes 8) #t 0 8)]
[#x84 '#:end]
[#x85 (let ((a (next)))
(match (next)
[(annotated as i) (annotated (cons a as) i)]
[i (annotated (list a) i)]))]
[(? (between #x90 #x9C) v) (- v #x90)]
[(? (between #x9D #x9F) v) (- v #xA0)]
[(? (between #xA0 #xAF) v) (next-integer (- v #xA0 -1))]
[#xB0 (next-integer (next-varint))]
[#xB1 (bytes->string/utf-8 (next-bytes (next-varint)))]
[#xB2 (next-bytes (next-varint))]
[#xB3 (string->symbol (bytes->string/utf-8 (next-bytes (next-varint))))]
[#xB4 (apply (lambda (label . fields) (record label fields)) (next-items))]
[#xB5 (next-items)]
[#xB6 (list->set (next-items))]
[#xB7 (apply hash (next-items))]))
(define (next-items) (match (next) ['#:end '()] [v (cons v (next-items))]))
(define (eof-guard v) (if (eof-object? v) (return eof) v))
(define (next-byte) (eof-guard (read-byte in-port)))
(define (next-bytes n)
(define bs (eof-guard (read-bytes n in-port)))
(if (< (bytes-length bs) n) (return eof) bs))
(define (next-varint) (eof-guard (read-varint in-port)))
(define (next-integer n)
(define acc0 (next-byte))
(define acc (if (< acc0 128) acc0 (- acc0 256)))
(for/fold [(acc acc)] [(n (in-range (- n 1)))] (+ (* acc 256) (next-byte))))
(next)))
(define ((between lo hi) v) (<= lo v hi))
(define (read-varint in-port)
(let/ec return
(let loop ()
(define b (read-byte in-port))
(cond [(eof-object? b) (return b)]
[(< b 128) b]
[else (+ (* (loop) 128) (- b 128))]))))
;;---------------------------------------------------------------------------
;; Writer
(define (write-preserve/binary v [out-port (current-output-port)])
(define (output v)
(match v
[#f (write-byte #x80 out-port)]
[#t (write-byte #x81 out-port)]
[(float v) (write-byte #x82 out-port) (output-bytes (real->floating-point-bytes v 4 #t))]
[(? flonum?) (write-byte #x83 out-port) (output-bytes (real->floating-point-bytes v 8 #t))]
[(annotated as v)
(for [(a (in-list as))] (write-byte #x85 out-port) (output a))
(output v)]
[(? integer?)
(cond [(<= -3 v -1) (write-byte (+ v #xA0) out-port)]
[(<= 0 v 12) (write-byte (+ v #x90) out-port)]
[else (define raw-bit-count (+ (integer-length v) 1)) ;; at least one sign bit
(define byte-count (quotient (+ raw-bit-count 7) 8))
(if (<= byte-count 16)
(write-byte (+ byte-count #xA0 -1) out-port)
(begin (write-byte #xB0 out-port)
(write-varint byte-count out-port)))
(for [(shift (in-range (* byte-count 8) 0 -8))]
(write-byte (bitwise-bit-field v (- shift 8) shift) out-port))])]
[(? string?) (count-bytes 1 (string->bytes/utf-8 v))]
[(? bytes?) (count-bytes 2 v)]
[(? symbol?) (count-bytes 3 (string->bytes/utf-8 (symbol->string v)))]
[(record label fields) (with-seq 4 (output label) (for-each output fields))]
[(? list?) (with-seq 5 (for-each output v))]
[(? set?) (with-seq 6 (output-set v))]
[(? hash?) (with-seq 7 (output-hash v))]
[_ (error 'write-preserve/binary "Invalid value: ~v" v)]))
(define (output-bytes bs) (write-bytes bs out-port))
(define-syntax-rule (with-seq tag body ...)
(begin (write-byte (+ tag #xB0) out-port)
body ...
(write-byte #x84 out-port)))
(define (count-bytes tag bs)
(write-byte (+ tag #xB0) out-port)
(write-varint (bytes-length bs) out-port)
(output-bytes bs))
(define (encode v) (call-with-output-bytes (lambda (p) (write-preserve/binary v p))))
(define (output-set v)
(for-each output-bytes (sort (for/list [(e (in-set v))] (encode e)) bytes<?)))
(define (output-hash d)
(define encoded-entries (for/list [((k v) (in-hash d))] (cons (encode k) (encode v))))
(for-each output-bytes (flatten (sort encoded-entries bytes<? #:key car))))
(output v))
(define (write-varint v out-port)
(if (< v 128)
(write-byte v out-port)
(begin (write-byte (+ 128 (modulo v 128)) out-port)
(write-varint (quotient v 128) out-port))))

1203
implementations/racket/preserves/preserves/main.rkt
View File

File diff suppressed because it is too large Load Diff

98
implementations/racket/preserves/preserves/order.rkt Normal file
View File

@ -0,0 +1,98 @@
#lang racket/base
(provide preserve-order
preserve<?
sorted-set-elements
sorted-dict-entries
sorted-dict-keys-and-values
sorted-dict-keys)
(require racket/match)
(require (for-syntax racket/base))
(require "record.rkt")
(require "annotation.rkt")
(require racket/set)
(require racket/dict)
(require data/order)
(require (only-in racket/contract any/c))
;;---------------------------------------------------------------------------
;; Order
(define (typecode v)
(match v
[(? boolean?) 0]
[(? single-flonum?) 1]
[(? double-flonum?) 2]
[(? integer? x) 3]
[(? string?) 4]
[(? bytes?) 5]
[(? symbol?) 6]
[(record _ _) 7]
[(? list?) 8]
[(? set?) 9]
[(? dict?) 10]
[_ (error 'preserve-order "Cannot compare value ~v" v)]))
(define-syntax chain-order
(syntax-rules ()
[(_ o) o]
[(_ o more ...) (match o
['= (chain-order more ...)]
[other other])]))
(define (prepare-for-order v)
(match v
[(annotated _ _ item) (prepare-for-order item)]
[_ v]))
(define preserve-order
(order 'preserve-order
any/c
(lambda (a* b*)
(define a (prepare-for-order a*))
(define b (prepare-for-order b*))
(define ta (typecode a))
(define tb (typecode b))
(cond [(< ta tb) '<]
[(> ta tb) '>]
[else (match ta ;; == tb
[7 (chain-order
(preserve-order (record-label a) (record-label b))
(preserve-order (record-fields a)) (preserve-order (record-fields b)))]
[8 (match* (a b)
[('() '()) '=]
[('() _) '<]
[(_ '()) '>]
[((cons a0 a1) (cons b0 b1))
(chain-order (preserve-order a0 b0) (preserve-order a1 b1))])]
[9 (preserve-order (sorted-set-elements a) (sorted-set-elements b))]
[10 (preserve-order (sorted-dict-keys a) (sorted-dict-keys b))]
[_ (datum-order a b)])]))))
(define preserve<? (order-<? preserve-order))
;;---------------------------------------------------------------------------
;; Sorting & cached sorted items
(define set-cache (make-weak-hasheq))
(define dict-entry-cache (make-weak-hasheq))
(define dict-kv-cache (make-weak-hasheq))
(define dict-key-cache (make-weak-hasheq))
(define (sorted-set-elements v)
(hash-ref! set-cache v (lambda () (sort (set->list v) preserve<?))))
(define (sorted-dict-entries v)
(hash-ref! dict-entry-cache v (lambda () (sort (dict->list v) preserve<? #:key car))))
(define (sorted-dict-keys-and-values v)
(hash-ref! dict-kv-cache
v
(lambda () (let loop ((xs (sorted-dict-entries v)))
(match xs
['() '()]
[(cons (cons kk vv) rest) (cons kk (cons vv (loop rest)))])))))
(define (sorted-dict-keys v)
(hash-ref! dict-kv-cache v (lambda () (map car (sorted-dict-entries v)))))

120
implementations/racket/preserves/preserves/read-binary.rkt Normal file
View File

@ -0,0 +1,120 @@
#lang racket/base
(provide read-preserve/binary
bytes->preserve)
(require racket/match)
(require "record.rkt")
(require "float.rkt")
(require "annotation.rkt")
(require "varint.rkt")
(require racket/set)
(require (only-in racket/port call-with-input-bytes))
(define (default-on-short) (error 'read-preserve/binary "Short Preserves binary"))
(define (default-on-fail message . args) (error 'read-preserve/binary (apply format message args)))
(define (bytes->preserve bs
#:read-syntax? [read-syntax? #f]
#:read-annotations? [read-annotations? read-syntax?]
#:on-short [on-short default-on-short]
[on-fail default-on-fail])
(call-with-input-bytes
bs
(lambda (p)
(match (read-preserve/binary p
#:read-syntax? read-syntax?
#:read-annotations? read-annotations?
#:on-short on-short
on-fail)
[(? eof-object?) (on-short)]
[v v]))))
(define ((between lo hi) v) (<= lo v hi))
(define (read-preserve/binary [in-port (current-input-port)]
#:read-syntax? [read-syntax? #f]
#:read-annotations? [read-annotations? read-syntax?]
#:on-short [on-short default-on-short]
[on-fail default-on-fail])
(let/ec return
(define (next) (wrap (pos) (next* (next-byte))))
(define (next* lead-byte)
(match (next** lead-byte)
['#:end (return (on-fail "Unexpected sequence end marker"))]
[v v]))
(define pos
(if read-syntax?
(lambda ()
(define-values (_line _column position) (port-next-location in-port))
position)
(lambda () #f)))
(define wrap
(if read-syntax?
(lambda (pos0 v)
(if (annotated? v)
v
(annotated '() (srcloc #f #f #f pos0 (- (pos) pos0)) v)))
(lambda (pos0 v) v)))
(define (next** lead-byte)
(match lead-byte
[#x80 #f]
[#x81 #t]
[#x82 (float (floating-point-bytes->real (next-bytes 4) #t 0 4))]
[#x83 (floating-point-bytes->real (next-bytes 8) #t 0 8)]
[#x84 '#:end]
[#x85 (let ((a (next)))
(if read-annotations?
(annotate (next) a)
(next)))]
[(? (between #x90 #x9C) v) (- v #x90)]
[(? (between #x9D #x9F) v) (- v #xA0)]
[(? (between #xA0 #xAF) v) (next-integer (- v #xA0 -1))]
[#xB0 (next-integer (next-varint))]
[#xB1 (bytes->string/utf-8 (next-bytes (next-varint)))]
[#xB2 (next-bytes (next-varint))]
[#xB3 (string->symbol (bytes->string/utf-8 (next-bytes (next-varint))))]
[#xB4 (apply (lambda (label . fields) (record label fields)) (next-items))]
[#xB5 (next-items)]
[#xB6 (list->set (next-items))]
[#xB7 (build-dictionary (next-items))]
[_ (return (on-fail "Invalid Preserves binary tag: ~v" lead-byte))]))
(define (eof-guard v)
(if (eof-object? v)
(return (on-short))
v))
(define (next-byte) (eof-guard (read-byte in-port)))
(define (next-bytes n)
(define bs (eof-guard (read-bytes n in-port)))
(if (< (bytes-length bs) n) (return (on-short)) bs))
(define (next-varint) (eof-guard (read-varint in-port)))
(define (next-integer n)
(when (zero? n) (return (on-fail "Zero-length integer not permitted")))
(define acc0 (next-byte))
(define acc (if (< acc0 128) acc0 (- acc0 256)))
(for/fold [(acc acc)] [(n (in-range (- n 1)))] (+ (* acc 256) (next-byte))))
(define (next-items)
(define pos0 (pos))
(match (next** (next-byte))
['#:end '()]
[v (cons (wrap pos0 v) (next-items))]))
(define (build-dictionary items)
(when (not (even? (length items))) (return (on-fail "Odd number of items in dictionary")))
(apply hash items))
(let ((pos0 (pos)))
(match (read-byte in-port)
[(? eof-object?) eof]
[lead-byte (wrap pos0 (next* lead-byte))]))))

346
implementations/racket/preserves/preserves/read-text.rkt Normal file
View File

@ -0,0 +1,346 @@
#lang racket/base
(provide read-preserve/text
string->preserve)
(require racket/match)
(require racket/set)
(require "annotation.rkt")
(require "read-binary.rkt")
(require "record.rkt")
(require "float.rkt")
(require syntax/readerr)
(require (only-in file/sha1 hex-string->bytes))
(require (only-in net/base64 base64-decode))
(define PIPE #\|)
(define (parse-error* #:raise-proc [raise-proc raise-read-error] i source fmt . args)
(define-values [line column pos] (port-next-location i))
(raise-proc (format "read-preserve: ~a" (apply format fmt args))
source
line
column
pos
#f))
(define (string->preserve s
#:read-syntax? [read-syntax? #f]
#:read-annotations? [read-annotations? read-syntax?]
#:source [source "<string>"])
(define p (open-input-string s))
(when read-syntax? (port-count-lines! p))
(define v (read-preserve/text p
#:read-syntax? read-syntax?
#:read-annotations? read-annotations?
#:source source))
(when (eof-object? v)
(parse-error* #:raise-proc raise-read-eof-error p source "Unexpected end of input"))
(skip-whitespace* p)
(when (not (eof-object? (peek-char p)))
(parse-error* p source "Unexpected text following preserve"))
v)
(define (skip-whitespace* i)
(regexp-match? #px#"^(\\s|,)*" i)) ;; side effect: consumes matched portion of input
(define-match-expander px
(syntax-rules ()
[(_ re pat) (app (lambda (v) (regexp-try-match re v)) pat)]))
(define (read-preserve/text [in-port (current-input-port)]
#:read-syntax? [read-syntax? #f]
#:read-annotations? [read-annotations? read-syntax?]
#:source [source (object-name in-port)])
;;---------------------------------------------------------------------------
;; Core of parser
(define (next) (wrap (pos) (next*)))
(define (next*)
(skip-whitespace)
(match (next-char)
[#\- (read-intpart (list #\-) (next-char))]
[(and c (or #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)) (read-intpart '() c)]
[#\" (read-string #\")]
[(== PIPE) (string->symbol (read-string PIPE))]
[#\; (annotate-next-with (read-comment-line))]
[#\@ (annotate-next-with (next))]
[#\: (parse-error "Unexpected key/value separator between items")]
[#\# (match (next-char)
[#\f #f]
[#\t #t]
[#\{ (sequence-fold (set) set-add* values #\})]
[#\" (read-literal-binary)]
[#\x (if (eqv? (next-char) #\")
(read-hex-binary '())
(parse-error "Expected open-quote at start of hex ByteString"))]
[#\[ (read-base64-binary '())]
[#\= (define bs (read-preserve/text in-port #:read-syntax? #t #:source source))
(when (not (bytes? (annotated-item bs)))
(parse-error "ByteString must follow #="))
(when (not (null? (annotated-annotations bs)))
(parse-error "Annotations not permitted after #="))
(bytes->preserve
(annotated-item bs)
(lambda (message . args)
(apply parse-error (string-append "Embedded binary value: " message) args))
#:read-syntax? read-syntax?
#:read-annotations? read-annotations?
#:on-short (lambda () (parse-error "Incomplete embedded binary value")))]
[c (parse-error "Invalid # syntax: ~v" c)])]
[#\< (match (read-sequence #\>)
['() (parse-error "Missing record label")]
[(cons label fields) (record label fields)])]
[#\[ (read-sequence #\])]
[#\{ (read-dictionary)]
[#\> (parse-error "Unexpected >")]
[#\] (parse-error "Unexpected ]")]
[#\} (parse-error "Unexpected }")]
[c (read-raw-symbol (list c))]))
(define (set-add* s e)
(when (set-member? s e) (parse-error "Duplicate set element: ~v" e))
(set-add s e))
(define (annotate-next-with a)
(if read-annotations?
(annotate (next) a)
(next)))
;;---------------------------------------------------------------------------
;; Basic I/O
(define (parse-error fmt . args)
(apply parse-error* in-port source fmt args))
(define (eof-guard v)
(when (eof-object? v)
(parse-error* #:raise-proc raise-read-eof-error in-port source "Unexpected end of input"))
v)
(define (next-char) (eof-guard (read-char in-port)))
(define (skip-whitespace) (skip-whitespace* in-port))
;;---------------------------------------------------------------------------
;; Source location tracking
(define pos
(if read-syntax?
(lambda ()
(define-values (line column position) (port-next-location in-port))
(list line column position))
(lambda () #f)))
(define wrap
(if read-syntax?
(lambda (pos0 v)
(if (annotated? v)
v
(let ()
(match-define (list line0 column0 position0) pos0)
(match-define (list line1 column1 position1) (pos))
(define loc (and line0 column0 position0 position1
(srcloc source line0 column0 position0 (- position1 position0))))
(annotated '() loc v))))
(lambda (pos0 v) v)))
;;---------------------------------------------------------------------------
;; Numbers
(define (read-intpart acc-rev ch)
(match ch
[#\0 (read-fracexp (cons ch acc-rev))]
[_ (read-digit+ acc-rev read-fracexp ch)]))
(define (read-digit* acc-rev k)
(match (peek-char in-port)
[(? char? (? char-numeric?)) (read-digit* (cons (read-char in-port) acc-rev) k)]
[_ (k acc-rev)]))
(define (read-digit+ acc-rev k [ch (read-char in-port)])
(match ch
[(? char? (? char-numeric?)) (read-digit* (cons ch acc-rev) k)]
[_ (parse-error "Incomplete number")]))
(define (read-fracexp acc-rev)
(match (peek-char in-port)
[#\. (read-digit+ (cons (read-char in-port) acc-rev) read-exp)]
[_ (read-exp acc-rev)]))
(define (read-exp acc-rev)
(match (peek-char in-port)
[(or #\e #\E) (read-sign-and-exp (cons (read-char in-port) acc-rev))]
[_ (finish-number acc-rev)]))
(define (read-sign-and-exp acc-rev)
(match (peek-char in-port)
[(or #\+ #\-) (read-digit+ (cons (read-char in-port) acc-rev) finish-number)]
[_ (read-digit+ acc-rev finish-number)]))
(define (finish-number acc-rev)
(define s (list->string (reverse acc-rev)))
(define n (string->number s 10))
(when (not n) (parse-error "Invalid number: ~v" s))
(if (flonum? n)
(match (peek-char in-port)
[(or #\f #\F) (read-char in-port) (float n)]
[_ n])
n))
;;---------------------------------------------------------------------------
;; String-like things
(define (read-stringlike xform-item finish terminator-char hexescape-char hexescape-proc)
(let loop ((acc '()))
(match (next-char)
[(== terminator-char) (finish (reverse acc))]
[#\\ (match (next-char)
[(== hexescape-char) (loop (cons (hexescape-proc) acc))]
[(and c (or (== terminator-char) #\\ #\/)) (loop (cons (xform-item c) acc))]
[#\b (loop (cons (xform-item #\u08) acc))]
[#\f (loop (cons (xform-item #\u0C) acc))]
[#\n (loop (cons (xform-item #\u0A) acc))]
[#\r (loop (cons (xform-item #\u0D) acc))]
[#\t (loop (cons (xform-item #\u09) acc))]
[c (parse-error "Invalid escape code \\~a" c)])]
[c (loop (cons (xform-item c) acc))])))
(define (read-string terminator-char)
(read-stringlike values
list->string
terminator-char
#\u
(lambda ()
(integer->char
(match in-port
[(px #px#"^[a-fA-F0-9]{4}" (list hexdigits))
(define n1 (string->number (bytes->string/utf-8 hexdigits) 16))
(if (<= #xd800 n1 #xdfff) ;; surrogate pair first half
(match in-port
[(px #px#"^\\\\u([a-fA-F0-9]{4})" (list _ hexdigits2))
(define n2 (string->number (bytes->string/utf-8 hexdigits2) 16))
(if (<= #xdc00 n2 #xdfff)
(+ (arithmetic-shift (- n1 #xd800) 10)
(- n2 #xdc00)
#x10000)
(parse-error "Bad second half of surrogate pair"))]
[_ (parse-error "Missing second half of surrogate pair")])
n1)]
[_ (parse-error "Bad string \\u escape")])))))
(define (read-literal-binary)
(read-stringlike (lambda (c)
(define b (char->integer c))
(when (>= b 256)
(parse-error "Invalid code point ~a (~v) in literal binary" b c))
b)
list->bytes
#\"
#\x
(lambda ()
(match in-port
[(px #px#"^[a-fA-F0-9]{2}" (list hexdigits))
(string->number (bytes->string/utf-8 hexdigits) 16)]
[_ (parse-error "Bad binary \\x escape")]))))
;;---------------------------------------------------------------------------
;; Hex-encoded ByteStrings
(define (hexdigit? ch)
(or (and (char>=? ch #\A) (char<=? ch #\F))
(and (char>=? ch #\a) (char<=? ch #\f))
(and (char>=? ch #\0) (char<=? ch #\9))))
(define (read-hex-binary acc)
(skip-whitespace)
(define ch (next-char))
(cond [(eqv? ch #\")
(hex-string->bytes (list->string (reverse acc)))]
[(hexdigit? ch)
(define ch2 (next-char))
(when (not (hexdigit? ch2))
(parse-error "Hex-encoded binary digits must come in pairs"))
(read-hex-binary (cons ch2 (cons ch acc)))]
[else
(parse-error "Invalid hex character")]))
;;---------------------------------------------------------------------------
;; Base64-encoded ByteStrings
(define (read-base64-binary acc)
(skip-whitespace)
(define ch (next-char))
(cond [(eqv? ch #\])
(base64-decode (string->bytes/latin-1 (list->string (reverse acc))))]
[(or (and (char>=? ch #\A) (char<=? ch #\Z))
(and (char>=? ch #\a) (char<=? ch #\z))
(and (char>=? ch #\0) (char<=? ch #\9))
(memv ch '(#\+ #\/ #\- #\_ #\=)))
(read-base64-binary (cons ch acc))]
[else
(parse-error "Invalid base64 character")]))
;;---------------------------------------------------------------------------
;; Comments
(define (read-comment-line)
(define pos0 (pos))
(let loop ((acc '()))
(match (next-char)
[(or #\newline #\return)
(wrap pos0 (list->string (reverse acc)))]
[c (loop (cons c acc))])))
;;---------------------------------------------------------------------------
;; Collections
(define (sequence-fold acc accumulate-one finish terminator-char)
(let loop ((acc acc))
(skip-whitespace)
(match (eof-guard (peek-char in-port))
[(== terminator-char) (read-char in-port) (finish acc)]
[_ (loop (accumulate-one acc (next)))])))
(define (read-sequence terminator)
(sequence-fold '() (lambda (acc v) (cons v acc)) reverse terminator))
(define (read-dictionary)
(sequence-fold (hash)
(lambda (acc k)
(skip-whitespace)
(match (peek-char in-port)
[#\: (read-char in-port)
(when (hash-has-key? acc k) (parse-error "Duplicate key: ~v" k))
(hash-set acc k (next))]
[_ (parse-error "Missing expected key/value separator")]))
values
#\}))
;;---------------------------------------------------------------------------
;; "Raw" symbols
(define (read-raw-symbol acc)
(match (peek-char in-port)
[(or (? eof-object?)
(? char? (or #\( #\) #\{ #\} #\[ #\] #\< #\>
#\" #\; #\, #\@ #\# #\: (== PIPE)
(? char-whitespace?))))
(string->symbol (list->string (reverse acc)))]
[_ (read-raw-symbol (cons (read-char in-port) acc))]))
;;---------------------------------------------------------------------------
;; Main entry point to parser
(skip-whitespace)
(match (peek-char in-port)
[(? eof-object?) eof]
[_ (next)]))

5
implementations/racket/preserves/preserves/record.rkt
View File

@ -20,8 +20,9 @@
[(record label fields) (values #t label fields)]
[(? non-object-struct?)
(define key (prefab-struct-key r))
(when (not key) (error 'preserves "Cannot process non-prefab struct ~v" r))
(values #t key (cdr (vector->list (struct->vector r))))]
(if key
(values #t key (cdr (vector->list (struct->vector r))))
(values #f #f #f))]
[_ (values #f #f #f)]))
(define-match-expander record-expander

201
implementations/racket/preserves/preserves/tests/test-main.rkt Normal file
View File

@ -0,0 +1,201 @@
#lang racket/base
(require "../main.rkt")
(require racket/match)
(require racket/set)
(require rackunit)
(require racket/runtime-path)
(require syntax/srcloc)
(define (d bs #:allow-invalid-prefix? [allow-invalid-prefix? #f])
(for [(i (in-range 1 (- (bytes-length bs) 1)))]
(define result (bytes->preserve (subbytes bs 0 i) #:on-short (lambda () 'short) void))
(when (and (not (eq? result 'short))
(not (and allow-invalid-prefix? (void? result))))
(error 'd "~a-byte prefix of ~v does not read as short; result: ~v" i bs result)))
(bytes->preserve bs
#:read-syntax? #t
#:on-short (lambda () 'short)
void))
(define (d-strip bs) (strip-annotations (d bs)))
(struct discard () #:prefab)
(struct capture (detail) #:prefab)
(struct observe (specification) #:prefab)
(struct speak (who what) #:prefab)
(struct date (year month day) #:prefab)
(struct thing (id) #:prefab)
(struct person thing (name date-of-birth) #:prefab)
(struct titled person (title) #:prefab)
(struct asymmetric (forward back))
(define samples-txt-expected
(hash 'record1 (capture (discard))
'record2 (observe (speak (discard) (capture (discard))))
'list4a '(1 2 3 4)
'list5 '(-2 -1 0 1)
'string3 "hello"
'list6 `("hello" there #"world" () ,(set) #t #f)
'bytes2 #"hello"
'bytes3 #"ABC"
'bytes4 #"ABC"
'bytes5 #"AJN"
'bytes7 #"corymb"
'bytes8 #"corymb"
'bytes9 #"Hi"
'bytes10 #"Hi"
'bytes11 #"Hi"
'value1 #"corymb"
'value2 #t
'value3 #t
'value4 #t
'value5 #t
'value6 (list 1 2 3)
'list0 '()
'dict0 (hash)
'string0 ""
'symbol0 '||
'set0 (set)
'set1 (set 1 2 3)
'set1a (set 1 2 3)
'string4 "abc\u6c34\u6C34\\/\"\b\f\n\r\txyz"
'bytes13 #"abc\x6c\x34\xf0\\/\"\b\f\n\r\txyz"
'string5 "\U0001D11E"
'record1 (capture (discard))
'record2 (observe (speak (discard) (capture (discard))))
'record3 (titled 101 "Blackwell" (date 1821 2 3) "Dr")
'record4 (asymmetric (record 'discard '()) (discard))
'record5 (record 7 '(()))
'record6 (asymmetric (record 'discard '(surprise))
'#s(discard surprise))
'record7 (record "aString" '(3 4))
'record8 (record (discard) '(3 4))
'list7 (list 'abc '|...| 'def)
'dict1 (hash 'a 1
"b" #t
'(1 2 3) #"c"
(hash 'first-name "Elizabeth") (hash 'surname "Blackwell"))
'rfc8259-example1 (hash "Image"
(hash "Width" 800
"Height" 600
"Title" "View from 15th Floor"
"Thumbnail" (hash "Url" "http://www.example.com/image/481989943"
"Height" 125
"Width" 100)
"Animated" 'false
"IDs" (list 116 943 234 38793)))
'rfc8259-example2 (list (hash
"precision" "zip"
"Latitude" 37.7668
"Longitude" -122.3959
"Address" ""
"City" "SAN FRANCISCO"
"State" "CA"
"Zip" "94107"
"Country" "US")
(hash
"precision" "zip"
"Latitude" 37.371991
"Longitude" -122.026020
"Address" ""
"City" "SUNNYVALE"
"State" "CA"
"Zip" "94085"
"Country" "US"))
'annotation1 (asymmetric (annotate 9 "abc") 9)
'annotation2 (asymmetric (annotate (list '() (annotate '() "x")) "abc" "def") '(() ()))
'annotation3 (asymmetric (annotate 5 (annotate 2 1) (annotate 4 3)) 5)
'annotation4 (asymmetric (hash (annotate 'a 'ak) (annotate 1 'av)
(annotate 'b 'bk) (annotate 2 'bv))
(hash 'a 1 'b 2))
'annotation5 (asymmetric (annotate `#s(R ,(annotate 'f 'af)) 'ar) `#s(R f))
'annotation6 (asymmetric (record (annotate 'R 'ar) (list (annotate 'f 'af))) `#s(R f))
'annotation7 (asymmetric (annotate '() 'a 'b 'c) '())
))
(define (run-test-case variety t-name loc binary-form annotated-text-form)
(define text-form (strip-annotations annotated-text-form))
(define-values (forward back can-execute-nondet-with-canonicalization?)
(match (hash-ref samples-txt-expected t-name text-form)
[(asymmetric f b) (values f b #f)] ;; #f because e.g. annotation4 includes annotations
[v (values v v #t)]))
(check-equal? text-form back loc) ;; expectation 1
(check-equal? (d-strip (preserve->bytes text-form)) back loc) ;; expectation 2
(check-equal? (d-strip (preserve->bytes forward)) back loc) ;; expectation 3
(check-equal? (d-strip binary-form) back loc) ;; expectation 4
(check-equal? (d binary-form) annotated-text-form loc) ;; expectation 5
(check-equal? (d (preserve->bytes annotated-text-form)) annotated-text-form loc) ;; expectation 6
(check-equal? (string->preserve (preserve->string text-form)) back loc) ;; expectation 7
(check-equal? (string->preserve (preserve->string forward)) back loc) ;; expectation 8
;; similar to 8:
(check-equal? (string->preserve (preserve->string annotated-text-form) #:read-syntax? #t)
annotated-text-form
loc)
(when (and (not (memq variety '(decode)))
(or (not (memq variety '(nondeterministic)))
(and can-execute-nondet-with-canonicalization?)))
;; expectations 9 and 10
(check-equal? (preserve->bytes forward
#:canonicalizing? #t
#:write-annotations? #t)
binary-form
loc))
(unless (memq variety '(decode nondeterministic))
;; expectation 11
(check-equal? (preserve->bytes annotated-text-form #:write-annotations? #t)
binary-form
loc)))
(define-runtime-path tests-path "../../../../../tests")
(let* ((path (build-path tests-path "samples.txt"))
(testfile (call-with-input-file path
(lambda (p)
(port-count-lines! p)
(read-preserve p #:read-syntax? #t #:source path)))))
(match-define (peel-annotations `#s(TestCases ,tests)) testfile)
(for [((t-name* t*) (in-hash (annotated-item tests)))]
(define t-name (strip-annotations t-name*))
(define loc (format "Test case '~a' (~a)" t-name (source-location->string (annotated-srcloc t*))))
(define (fail-test fmt . args)
(fail (format "~a: ~a" loc (apply format fmt args))))
(displayln loc)
(match (peel-annotations t*)
[`#s(Test ,(strip-annotations binary-form) ,annotated-text-form)
(run-test-case 'normal t-name loc binary-form annotated-text-form)]
[`#s(NondeterministicTest ,(strip-annotations binary-form) ,annotated-text-form)
(run-test-case 'nondeterministic t-name loc binary-form annotated-text-form)]
[`#s(StreamingTest ,(strip-annotations binary-form) ,annotated-text-form)
(run-test-case 'streaming t-name loc binary-form annotated-text-form)]
[`#s(DecodeTest ,(strip-annotations binary-form) ,annotated-text-form)
(run-test-case 'decode t-name loc binary-form annotated-text-form)]
[`#s(ParseError ,(strip-annotations str))
(with-handlers [(exn:fail:read:eof?
(lambda (e) (fail-test "Unexpected EOF: ~e" e)))
(exn:fail:read?
(lambda (e) 'ok))
((lambda (e) #t)
(lambda (e) (fail-test "Unexpected exception: ~e" e)))]
(string->preserve str)
(fail-test "Unexpected success"))]
[(or `#s(ParseShort ,(strip-annotations str))
`#s(ParseEOF ,(strip-annotations str)))
(with-handlers [(exn:fail:read:eof? (lambda (e) 'ok))
((lambda (e) #t)
(lambda (e) (fail-test "Unexpected exception: ~e" e)))]
(string->preserve str)
(fail-test "Unexpected success"))]
[(or `#s(DecodeShort ,(strip-annotations bs))
`#s(DecodeEOF ,(strip-annotations bs)))
(check-eq? (d bs) 'short loc)]
[`#s(DecodeError ,(strip-annotations bs))
(check-true (void? (d bs #:allow-invalid-prefix? #t)) loc)]
[_
(write-preserve/text t* #:indent #f)
(newline)]))
)

19
implementations/racket/preserves/preserves/tool.rkt
View File

@ -6,7 +6,7 @@
(module+ main
(require racket/cmdline)
(define input-format 'text)
(define input-format 'any)
(define output-format 'binary)
(define indent? #t)
(define annotations? #t)
@ -17,6 +17,8 @@
["--btoa" "Binary to text"
(begin (set! input-format 'binary)
(set! output-format 'text))]
[("--ia" "--input-any") "Autodetect input mode (default)"
(set! input-format 'any)]
[("--ib" "--input-binary") "Set binary input mode"
(set! input-format 'binary)]
[("--it" "--input-text") "Set text input mode"
@ -25,9 +27,11 @@
(set! output-format 'binary)]
[("--ot" "--output-text") "Set text output mode"
(set! output-format 'text)]
["--indent" "Enable indent for text output"
["--indent" "Enable indent and set text output mode"
(set! output-format 'text)
(set! indent? #t)]
["--no-indent" "Disable indent for text output"
["--no-indent" "Disable indent and set text output mode"
(set! output-format 'text)
(set! indent? #f)]
["--annotations" "Output annotations"
(set! annotations? #t)]
@ -36,9 +40,10 @@
(define v ((if annotations? values strip-annotations)
(match input-format
['text (read-preserve-syntax #:source "<stdin>")]
['binary (decode-syntax (port->bytes))])))
['any (read-preserve #:read-syntax? #t #:source "<stdin>")]
['text (read-preserve/text #:read-syntax? #t #:source "<stdin>")]
['binary (read-preserve/binary #:read-syntax? #t)])))
(void (match output-format
['text (write-preserve v #:indent indent?)]
['binary (write-bytes (encode v))]))
['text (write-preserve/text v #:indent indent?)]
['binary (write-preserve/binary v #:write-annotations? #t)]))
(flush-output))

57
implementations/racket/preserves/preserves/varint.rkt
View File

@ -8,42 +8,53 @@
;; two's complement representation of the number in groups of 7 bits,
;; least significant group first."
(provide encode-varint
(provide write-varint
read-varint
encode-varint
decode-varint)
(require bitsyntax)
(require racket/port)
(define (write-varint v out-port)
(if (< v 128)
(write-byte v out-port)
(begin (write-byte (+ 128 (modulo v 128)) out-port)
(write-varint (quotient v 128) out-port))))
(define (read-varint in-port)
(let/ec return
(let loop ()
(define b (read-byte in-port))
(cond [(eof-object? b) (return b)]
[(< b 128) b]
[else (+ (* (loop) 128) (- b 128))]))))
(define (encode-varint v)
(if (< v 128)
(bytes v)
(bit-string ((+ (modulo v 128) 128) :: bits 8)
((encode-varint (quotient v 128)) :: binary))))
(call-with-output-bytes (lambda (p) (write-varint v p))))
(define (decode-varint bs ks kf)
(bit-string-case bs
#:on-short (lambda (fail) (kf #t))
([ (= 1 :: bits 1) (v :: bits 7) (rest :: binary) ]
(decode-varint rest (lambda (acc tail) (ks (+ (* acc 128) v) tail)) kf))
([ (= 0 :: bits 1) (v :: bits 7) (rest :: binary) ]
(ks v rest))
(else
(kf))))
((call-with-input-bytes bs (lambda (p)
(define v (read-varint p))
(cond [(eof-object? v) (lambda () (kf #t))]
[else (define rest (port->bytes p))
(lambda () (ks v rest))])))))
(module+ test
(require rackunit)
(check-equal? (bit-string->bytes (encode-varint 0)) (bytes 0))
(check-equal? (bit-string->bytes (encode-varint 1)) (bytes 1))
(check-equal? (bit-string->bytes (encode-varint 127)) (bytes 127))
(check-equal? (bit-string->bytes (encode-varint 128)) (bytes 128 1))
(check-equal? (bit-string->bytes (encode-varint 255)) (bytes 255 1))
(check-equal? (bit-string->bytes (encode-varint 256)) (bytes 128 2))
(check-equal? (bit-string->bytes (encode-varint 300)) (bytes #b10101100 #b00000010))
(check-equal? (bit-string->bytes (encode-varint 1000000000)) (bytes 128 148 235 220 3))
(check-equal? (encode-varint 0) (bytes 0))
(check-equal? (encode-varint 1) (bytes 1))
(check-equal? (encode-varint 127) (bytes 127))
(check-equal? (encode-varint 128) (bytes 128 1))
(check-equal? (encode-varint 255) (bytes 255 1))
(check-equal? (encode-varint 256) (bytes 128 2))
(check-equal? (encode-varint 300) (bytes #b10101100 #b00000010))
(check-equal? (encode-varint 1000000000) (bytes 128 148 235 220 3))
(define (ks* v rest) (list v (bit-string->bytes rest)))
(define (ks* v rest) (list v rest))
(define (kf* [short? #f]) (if short? 'short (void)))
(check-equal? (decode-varint (bytes) ks* kf*) 'short)
(check-equal? (decode-varint (bytes 0) ks* kf*) (list 0 (bytes)))
(check-equal? (decode-varint (bytes 0 99) ks* kf*) (list 0 (bytes 99)))
(check-equal? (decode-varint (bytes 1) ks* kf*) (list 1 (bytes)))

120
implementations/racket/preserves/preserves/write-binary.rkt Normal file
View File

@ -0,0 +1,120 @@
#lang racket/base
(provide write-preserve/binary
preserve->bytes)
(require racket/match)
(require (only-in racket/port call-with-output-bytes))
(require "record.rkt")
(require "float.rkt")
(require "annotation.rkt")
(require "varint.rkt")
(require racket/set)
(require racket/dict)
(require (only-in racket/list flatten))
(define (preserve->bytes v
#:canonicalizing? [canonicalizing? #t]
#:write-annotations? [write-annotations? (not canonicalizing?)])
(call-with-output-bytes
(lambda (p) (write-preserve/binary v p
#:canonicalizing? canonicalizing?
#:write-annotations? write-annotations?))))
(define (write-preserve/binary v [out-port (current-output-port)]
#:canonicalizing? [canonicalizing? #t]
#:write-annotations? [write-annotations? (not canonicalizing?)])
(define (output-byte b)
(write-byte b out-port))
(define (output-bytes bs)
(write-bytes bs out-port))
(define (output-varint v)
(write-varint v out-port))
(define-syntax-rule (with-seq tag body ...)
(begin (output-byte (+ tag #xB0))
body ...
(output-byte #x84)))
(define (count-bytes tag bs)
(output-byte (+ tag #xB0))
(output-varint (bytes-length bs))
(output-bytes bs))
(define (prepare v) (preserve->bytes v #:canonicalizing? #t))
(define (output-all vs)
(for [(v (in-list vs))] (output v)))
(define output-set
(match* [canonicalizing? write-annotations?]
[[#t #f] (lambda (v)
(for-each output-bytes
(sort (for/list [(e (in-set v))] (prepare e)) bytes<?)))]
[[#t #t] (lambda (v)
(for-each output
(map cdr
(sort (for/list [(e (in-set v))] (cons (prepare e) e))
bytes<?
#:key car))))]
[[#f _] (lambda (v) (for [(e (in-set v))] (output e)))]))
(define (prepare-dict d)
(sort (for/list [((k v) (in-dict d))] (list (prepare k) k v)) bytes<? #:key car))
(define output-dict
(match* [canonicalizing? write-annotations?]
[[#t #f] (lambda (v)
(for-each (match-lambda [(list kb _ v) (output-bytes kb) (output v)])
(prepare-dict v)))]
[[#t #t] (lambda (v)
(for-each (match-lambda [(list _ k v) (output k) (output v)])
(prepare-dict v)))]
[[#f _] (lambda (v) (for [((k v) (in-dict v))] (output k) (output v)))]))
(define (output v)
(match v
[#f (output-byte #x80)]
[#t (output-byte #x81)]
[(float v)
(output-byte #x82)
(output-bytes (real->floating-point-bytes v 4 #t))]
[(? flonum?)
(output-byte #x83)
(output-bytes (real->floating-point-bytes v 8 #t))]
[(annotated as _ v)
(when write-annotations?
(for [(a (in-list as))]
(output-byte #x85)
(output a)))
(output v)]
[(? integer?)
(cond [(<= -3 v -1) (output-byte (+ v #xA0))]
[(<= 0 v 12) (output-byte (+ v #x90))]
[else (define raw-bit-count (+ (integer-length v) 1)) ;; at least one sign bit
(define byte-count (quotient (+ raw-bit-count 7) 8))
(if (<= byte-count 16)
(output-byte (+ byte-count #xA0 -1))
(begin (output-byte #xB0)
(output-varint byte-count)))
(for [(shift (in-range (* byte-count 8) 0 -8))]
(output-byte (bitwise-bit-field v (- shift 8) shift)))])]
[(? string?) (count-bytes 1 (string->bytes/utf-8 v))]
[(? bytes?) (count-bytes 2 v)]
[(? symbol?) (count-bytes 3 (string->bytes/utf-8 (symbol->string v)))]
[(record label fields) (with-seq 4 (output label) (output-all fields))]
[(? list?) (with-seq 5 (output-all v))]
[(? set?) (with-seq 6 (output-set v))]
[(? dict?) (with-seq 7 (output-dict v))]
[_ (error 'write-preserve/binary "Invalid value: ~v" v)]))
(output v))

178
implementations/racket/preserves/preserves/write-text.rkt Normal file
View File

@ -0,0 +1,178 @@
#lang racket/base
(provide write-preserve/text
preserve->string
(struct-out binary-display-heuristics)
current-binary-display-heuristics)
(require racket/match)
(require racket/format)
(require net/base64)
(require "annotation.rkt")
(require "float.rkt")
(require "record.rkt")
(require racket/dict)
(require racket/set)
(require (only-in racket/port with-output-to-string))
(define PIPE #\|)
(struct binary-display-heuristics (printable-ascii-proportion max-length) #:transparent)
(define current-binary-display-heuristics (make-parameter (binary-display-heuristics 3/4 1024)))
(define (write-preserve/text v0 [o (current-output-port)]
#:indent [indent-amount0 #f]
#:write-annotations? [write-annotations? #t])
(define indent-amount (match indent-amount0
[#f 0]
[#t 2] ;; a default
[other other]))
(define indenting? (and indent-amount0 #t))
(define-syntax-rule (! fmt arg ...) (fprintf o fmt arg ...))
(define (!indent distance)
(when indenting?
(! "\n~a" (make-string distance #\space))))
(define (!indent* distance)
(if indenting?
(!indent distance)
(! " ")))
(define (write-stringlike-char c [default (lambda (c) (! "~a" c))])
(match c
[#\\ (! "\\\\")]
[#\u08 (! "\\b")]
[#\u0C (! "\\f")]
[#\u0A (! "\\n")]
[#\u0D (! "\\r")]
[#\u09 (! "\\t")]
[_ (default c)]))
(define (write-sequence outer-distance opener comma closer item-writer vs)
(define inner-distance (+ outer-distance indent-amount))
(! "~a" opener)
(match vs
['() (void)]
[(list v0)
(item-writer outer-distance v0)]
[(cons v0 vs)
(!indent inner-distance)
(item-writer inner-distance v0)
(for [(v (in-list vs))]
(! "~a" comma)
(!indent* inner-distance)
(item-writer inner-distance v))
(!indent outer-distance)])
(! "~a" closer))
(define (write-record outer-distance label fields)
(! "<")
(write-value outer-distance label)
(for ([f (in-list fields)])
(! " ")
(write-value outer-distance f))
(! ">"))
(define (write-key-value distance kv)
(match-define (cons k v) kv)
(write-value distance k)
(! ": ")
(write-value distance v))
(define (binunescaped? b)
(or (<= #x20 b #x21)
(<= #x23 b #x5b)
(<= #x5d b #x7e)))
(define (write-binary-stringlike v)
(! "#\"")
(for [(b (in-bytes v))]
(match b
[#x22 (! "\\\"")]
[(? binunescaped?) (write-stringlike-char (integer->char b))]
[_ (write-stringlike-char (integer->char b)
(lambda (c) (! "\\x~a" (~a #:min-width 2
#:align 'right
#:left-pad-string "0"
(number->string b 16)))))]))
(! "\""))
(define (write-binary-base64 outer-distance v)
;; Racket's encoder breaks lines after 72 characters.
;; That corresponds to 54 bytes of input binary.
(! "#[")
(if (and indenting? (> (bytes-length v) 54))
(let* ((inner-distance (+ outer-distance indent-amount))
(line-separator (bytes-append #"\n" (make-bytes inner-distance 32)))
(encoded (base64-encode v line-separator)))
(write-bytes line-separator o)
(write-bytes encoded o 0 (- (bytes-length encoded) indent-amount)))
(write-bytes (base64-encode v #"") o))
(! "]"))
(define (write-binary outer-distance v)
(match-define (binary-display-heuristics proportion maxlen) (current-binary-display-heuristics))
(define vlen (bytes-length v))
(if (>= vlen maxlen)
(write-binary-base64 outer-distance v)
(let* ((sample-length (min vlen maxlen))
(printable-ascii-count (for/sum [(i (in-range 0 sample-length))
(b (in-bytes v))]
(if (or (<= 32 b 126) (= b 9) (= b 10) (= b 13)) 1 0))))
(if (or (zero? vlen) (>= (/ printable-ascii-count sample-length) proportion))
(write-binary-stringlike v)
(write-binary-base64 outer-distance v)))))
(define (write-value distance v)
(match v
[(annotated annotations _ item)
(when write-annotations?
(for [(a (in-list annotations))]
(! "@")
(write-value (+ distance 1) a)
(!indent* distance)))
(write-value distance item)]
[#f (! "#f")]
[#t (! "#t")]
[(float v) (! "~vf" v)]
[(? flonum?) (! "~v" v)]
[(? integer? x) (! "~v" v)]
[(? string?)
(! "\"")
(for [(c (in-string v))]
(match c
[#\" (! "\\\"")]
[_ (write-stringlike-char c)]))
(! "\"")]
[(? bytes?) (write-binary distance v)]
[(? symbol?)
(define s (symbol->string v))
;; FIXME: This regular expression is conservatively correct, but Anglo-chauvinistic.
(if (regexp-match #px"[a-zA-Z~!$%^&*?_=+/.][-a-zA-Z~!$%^&*?_=+/.0-9]*" s)
(! "~a" s)
(begin (! "|")
(for [(c (in-string s))]
(match c
[(== PIPE) (! "\\|")]
[_ (write-stringlike-char c)]))
(! "|")))]
[(record label fields) (write-record distance label fields)]
[(? list?) (write-sequence distance "[" "," "]" write-value v)]
[(? set?) (write-sequence distance "#{" "," "}" write-value (set->list v))]
[(? dict?) (write-sequence distance "{" "," "}" write-key-value (dict->list v))]
[_ (error 'write-preserve/text "Cannot encode value ~v" v)]))
(write-value 0 v0))
(define (preserve->string v0
#:indent [indent-amount #f]
#:write-annotations? [write-annotations? #t])
(with-output-to-string
(lambda () (write-preserve/text v0
#:indent indent-amount
#:write-annotations? write-annotations?))))

10
preserves.el
View File

@ -33,9 +33,9 @@
"Syntax table in use in preserves-mode buffers.")
;; (modify-syntax-entry ?' "\"" preserves-mode-syntax-table)
(modify-syntax-entry ?\n "> b" preserves-mode-syntax-table)
(modify-syntax-entry ?\r "> b" preserves-mode-syntax-table)
(modify-syntax-entry ?/ "_ 12b" preserves-mode-syntax-table)
(modify-syntax-entry ?\n ">" preserves-mode-syntax-table)
(modify-syntax-entry ?\r ">" preserves-mode-syntax-table)
(modify-syntax-entry ?\; "<" preserves-mode-syntax-table)
(modify-syntax-entry ?< "(>" preserves-mode-syntax-table)
(modify-syntax-entry ?> ")<" preserves-mode-syntax-table)
(mapcar #'(lambda (x) (modify-syntax-entry x "_" preserves-mode-syntax-table))
@ -55,9 +55,9 @@
(make-local-variable 'comment-end)
(make-local-variable 'comment-start-skip)
(setq comment-use-syntax t)
(setq comment-start "//")
(setq comment-start ";")
(setq comment-end "")
(setq comment-start-skip "// *")
(setq comment-start-skip "; *")
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults '(preserves-font-lock-keywords nil nil ()))
(make-local-variable 'indent-line-function)

16
preserves.md
View File

@ -367,10 +367,10 @@ double quote mark.
Finally, any `Value` may be represented by escaping from the textual
syntax to the [compact binary syntax](#compact-binary-syntax) by
prefixing a `ByteString` containing the binary representation of the
`Value` with `#`.[^rationale-switch-to-binary]
`Value` with `#=`.[^rationale-switch-to-binary]
[^no-literal-binary-in-text] [^compact-value-annotations]
Compact = "#" ws ByteString
Compact = "#=" ws ByteString
[^rationale-switch-to-binary]: **Rationale.** The textual syntax
cannot express every `Value`: specifically, it cannot express the
@ -686,6 +686,12 @@ encodes to binary as follows:
B7
B1 05 "Image"
B7
B1 03 "IDs" B5
A0 74
A1 03 AF
A1 00 EA
A2 00 97 89
84
B1 05 "Title" B1 14 "View from 15th Floor"
B1 05 "Width" A1 03 20
B1 06 "Height" A1 02 58
@ -693,12 +699,6 @@ encodes to binary as follows:
B1 09 "Thumbnail"
B7
B1 03 "Url" B1 26 "http://www.example.com/image/481989943"
B1 03 "IDs" B5
A0 74
A1 03 AF
A1 00 EA
A2 00 97 89
84
B1 05 "Width" A0 64
B1 06 "Height" A0 7D
84

BIN
tests/samples.bin
View File

Binary file not shown.

456
tests/samples.txt
View File

@ -2,23 +2,22 @@
@<Documentation [
"Individual test cases may be any of the following record types:"
<TestCaseTypes {
Test: {fields: [binary annotatedValue] expectations: {1 2 3 4 5 6 7 8 9 11}}
NondeterministicTest: {fields: [binary annotatedValue] expectations: {1 2 3 4 5 6 7 8 10 11}}
StreamingTest: {fields: [binary annotatedValue] expectations: {1 2 3 4 5 6 7 8 9 }}
DecodeTest: {fields: [binary annotatedValue] expectations: {1 2 3 4 5 6 7 8}}
ParseError: {fields: [text] expectations: {12}}
ParseShort: {fields: [text] expectations: {13}}
ParseEOF: {fields: [text] expectations: {14}}
DecodeError: {fields: [bytes] expectations: {15}}
DecodeShort: {fields: [bytes] expectations: {16}}
DecodeEOF: {fields: [bytes] expectations: {17}}
Test: {fields: [binary annotatedValue] expectations: #{1 2 3 4 5 6 7 8 9 11}}
NondeterministicTest: {fields: [binary annotatedValue] expectations: #{1 2 3 4 5 6 7 8 10 11}}
DecodeTest: {fields: [binary annotatedValue] expectations: #{1 2 3 4 5 6 7 8}}
ParseError: {fields: [text] expectations: #{12}}
ParseShort: {fields: [text] expectations: #{13}}
ParseEOF: {fields: [text] expectations: #{14}}
DecodeError: {fields: [bytes] expectations: #{15}}
DecodeShort: {fields: [bytes] expectations: #{16}}
DecodeEOF: {fields: [bytes] expectations: #{17}}
}>
"In each test, let value = strip(annotatedValue),",
" forward = value,",
" back = value,"
"except where test-case-specific values of `forward` and/or `back` are provided"
"by the executing harness (of particular importance for `StreamingTest`s),"
"and check the following numbered expectations according to the table above:"
"except where test-case-specific values of `forward` and/or `back`",
"are provided by the executing harness, and check the following"
"numbered expectations according to the table above:"
<TestCaseExpectations {
1: "value = back"
2: "strip(decodeBinary(encodeBinary(value))) = back"
@ -40,236 +39,217 @@
16: "decodeBinary(bytes) fails signalling premature EOF after partial parse (NB. never with a syntax error)"
17: "decodeBinary(bytes) fails signalling immediate EOF (NB. never with a syntax error)"
}>
"Each `StreamingTest` will need to have an implementation-specific `forward`"
"supplied that encodes to the specific format C byte sequences in `binary`."
"Alternatively, implementations may choose to skip expectation 11 for"
"`StreamingTest`s, treating them like `DecodeTest`s."
""
"Implementations may vary in their treatment of the difference between expectations"
"13/14 and 16/17, depending on how they wish to treat end-of-stream conditions."
]>
<TestCases {
annotation1: <Test #hex{055361626339} @"abc" 9>
annotation2: <Test #hex{05536162630553646566929005517890} @"abc" @"def" [[] @"x" []]>
annotation3: <Test #hex{050531320505333435} @@1 2 @@3 4 5>
annotation4: <NondeterministicTest #hex{b4 05 72616b 7161 05 726176 31 05 72626b 7162 05 726276 32}
annotation1: <Test #x"85B10361626399" @"abc" 9>
annotation2: <Test #x"85B10361626385B103646566B5B58485B10178B58484" @"abc" @"def" [[] @"x" []]>
annotation3: <Test #x"858591928585939495" @@1 2 @@3 4 5>
annotation4: <NondeterministicTest #x"B7 85 B302616b B30161 85 B3026176 91 85 B302626b B30162 85 B3026276 92 84"
{@ak a: @av 1 @bk b: @bv 2}>
annotation5: <Test #hex{05726172827152057261667166} @ar <R @af f>>
annotation6: <Test #hex{82057261727152057261667166} <@ar R @af f>>
annotation5: <Test #x"85B3026172B4B3015285B3026166B3016684" @ar <R @af f>>
annotation6: <Test #x"B485B3026172B3015285B3026166B3016684" <@ar R @af f>>
annotation7:
@"Stop reading symbols at @ -- this test has three separate annotations"
<Test #hex{05716105716205716390} @a@b@c[]>
bytes1: <StreamingTest #hex{26626865626c6c616f04} #"hello">
bytes2: <Test #hex{6568656c6c6f} #"hello">
bytes2a: <Test @"Internal whitespace is allowed, including commas!" #hex{65, 68, 65, 6c, 6c, 6f} #"hello">
bytes3: <Test #hex{63414243} #"ABC">
bytes4: <Test #hex{63414243} #hex{414243}>
bytes5: <Test #hex{63414a4e} #hex{ 41 4A 4e }>
bytes6: @"Bytes must be 2-digits entire" <ParseError "#hex{414 243}">
bytes7: <Test #"\x66corymb" #base64{Y29yeW1i}>
bytes8: <Test #"\x66corymb" #base64{Y29 yeW 1i}>
bytes9: <Test #"\x62Hi" #base64{SGk=}>
bytes10: <Test #"\x62Hi" #base64{SGk}>
bytes11: <Test #"\x62Hi" #base64{S G k}>
;Stop reading symbols at @ -- this test has three separate annotations
<Test #x"85B3016185B3016285B30163B584" @a@b@c[]>
bytes2: <Test #x"B20568656c6c6f" #"hello">
bytes2a: <Test @"Internal whitespace is allowed, including commas!" #x"B2, 05, 68, 65, 6c, 6c, 6f" #"hello">
bytes3: <Test #x"B203414243" #"ABC">
bytes4: <Test #x"B203414243" #x"414243">
bytes5: <Test #x"B203414a4e" #x" 41 4A 4e ">
bytes6: @"Bytes must be 2-digits entire" <ParseError "#x\"414 243\"">
bytes7: <Test #"\xB2\x06corymb" #[Y29yeW1i]>
bytes8: <Test #"\xB2\x06corymb" #[Y29 yeW 1i]>
bytes9: <Test #"\xB2\x02Hi" #[SGk=]>
bytes10: <Test #"\xB2\x02Hi" #[SGk]>
bytes11: <Test #"\xB2\x02Hi" #[S G k]>
bytes12: @"Bytes syntax only supports \\x, not \\u" <ParseError "#\"\\u6c34\"">
bytes13: <Test #hex{6f 11 61 62 63 6c 34 f0 5c 2f 22 08 0c 0a 0d 09 78 79 7a} #"abc\x6c\x34\xf0\\/\"\b\f\n\r\txyz">
bytes13: <Test #x"B2 11 61 62 63 6c 34 f0 5c 2f 22 08 0c 0a 0d 09 78 79 7a" #"abc\x6c\x34\xf0\\/\"\b\f\n\r\txyz">
dict0: <Test #hex{b0} {}>
dict1: <NondeterministicTest #hex{b8 5162 01 7161 31 93313233 6163 b2 7a66697273742d6e616d65 59456c697a6162657468 b2 777375726e616d65 59426c61636b77656c6c} { a: 1 "b": #true [1 2 3]: #"c" { first-name: "Elizabeth" }: { surname: "Blackwell" } }>
dict0: <Test #x"B784" {}>
dict1: <NondeterministicTest #x"b7 b10162 81 b30161 91 b591929384 b20163 b7 b30a66697273742d6e616d65 b109456c697a6162657468 84 b7 b3077375726e616d65 b109426c61636b77656c6c 84 84" { a: 1 "b": #t [1 2 3]: #"c" { first-name: "Elizabeth" }: { surname: "Blackwell" } }>
dict2: @"Missing close brace" <ParseShort "{ a: b, c: d ">
dict2a: @"Missing close brace" <ParseShort "{">
dict3: @"Duplicate key" <ParseError "{ a: 1, a: 2 }">
dict4: @"Unexpected close brace" <ParseError "}">
dict5: @"Missing value" <DecodeError #hex{b3 31 32 33}>
double1: <Test #hex{033ff0000000000000} 1.0>
double2: <Test #hex{03fe3cb7b759bf0426} -1.202e300>
float1: <Test #hex{023f800000} 1.0f>
int-257: <Test #hex{42feff} -257>
int-256: <Test #hex{42ff00} -256>
int-255: <Test #hex{42ff01} -255>
int-254: <Test #hex{42ff02} -254>
int-129: <Test #hex{42ff7f} -129>
int-128: <Test #hex{4180} -128>
int-127: <Test #hex{4181} -127>
int-4: <Test #hex{41fc} -4>
int-3: <Test #hex{3d} -3>
int-2: <Test #hex{3e} -2>
int-1: <Test #hex{3f} -1>
int0: <Test #hex{30} 0>
int1: <Test #hex{31} 1>
int12: <Test #hex{3c} 12>
int13: <Test #hex{410d} 13>
int127: <Test #hex{417f} 127>
int128: <Test #hex{420080} 128>
int255: <Test #hex{4200ff} 255>
int256: <Test #hex{420100} 256>
int32767: <Test #hex{427fff} 32767>
int32768: <Test #hex{43008000} 32768>
int65535: <Test #hex{4300ffff} 65535>
int65536: <Test #hex{43010000} 65536>
int131072: <Test #hex{43020000} 131072>
list0: <Test #hex{90} []>
list1: <StreamingTest #hex{293132333404} [1 2 3 4]>
list2: <StreamingTest #hex{2925636162630425636465660404} ["abc" "def"]>
list3: <StreamingTest #hex{2992516131925162329251633304} [["a" 1] ["b" 2] ["c" 3]]>
list4: <Test #hex{9431323334} [1 2 3 4]>
list4a: <Test #hex{9431323334} [1, 2, 3, 4]>
list5: <Test #hex{943e3f3031} [-2 -1 0 1]>
list6: <Test #hex{97 5568656c6c6f 757468657265 65776f726c64 90 a0 01 00} ["hello" there #"world" [] #set{} #true #false]>
list7: <Test #hex{93 73616263 732e2e2e 73646566} [abc ... def]>
dict5: @"Missing value" <DecodeError #x"b7 91 92 93 84">
double1: <Test #x"833ff0000000000000" 1.0>
double2: <Test #x"83fe3cb7b759bf0426" -1.202e300>
float1: <Test #x"823f800000" 1.0f>
int-257: <Test #x"a1feff" -257>
int-256: <Test #x"a1ff00" -256>
int-255: <Test #x"a1ff01" -255>
int-254: <Test #x"a1ff02" -254>
int-129: <Test #x"a1ff7f" -129>
int-128: <Test #x"a080" -128>
int-127: <Test #x"a081" -127>
int-4: <Test #x"a0fc" -4>
int-3: <Test #x"9d" -3>
int-2: <Test #x"9e" -2>
int-1: <Test #x"9f" -1>
int0: <Test #x"90" 0>
int1: <Test #x"91" 1>
int12: <Test #x"9c" 12>
int13: <Test #x"a00d" 13>
int127: <Test #x"a07f" 127>
int128: <Test #x"a10080" 128>
int255: <Test #x"a100ff" 255>
int256: <Test #x"a10100" 256>
int32767: <Test #x"a17fff" 32767>
int32768: <Test #x"a2008000" 32768>
int65535: <Test #x"a200ffff" 65535>
int65536: <Test #x"a2010000" 65536>
int131072: <Test #x"a2020000" 131072>
list0: <Test #x"b584" []>
list4: <Test #x"b59192939484" [1 2 3 4]>
list4a: <Test #x"b59192939484" [1, 2, 3, 4]>
list5: <Test #x"b59e9f909184" [-2 -1 0 1]>
list6: <Test #x"b5 b10568656c6c6f b3057468657265 b205776f726c64 b584 b684 81 80 84" ["hello" there #"world" [] #{} #t #f]>
list7: <Test #x"b5 b303616263 b3032e2e2e b303646566 84" [abc ... def]>
list8: @"Missing close bracket" <ParseShort "[">
list9: @"Unexpected close bracket" <ParseError "]">
noop0: <DecodeTest #hex{ff7764697363617264} discard>
noop1: <DecodeTest #hex{ff31} 1>
noop2: <DecodeTest #hex{ffffff42ff00} -256>
noop3: <DecodeTest #hex{ff05ff53616263ff42ff00} @"abc" -256>
noop4: @"No-ops must be followed by something" <DecodeShort #hex{ffffff}>
noop5: @"No input at all" <DecodeEOF #hex{}>
placeholder0: @"Placeholders are no longer supported" <DecodeError #hex{10}>
placeholder1: @"Placeholders are no longer supported" <DecodeError #hex{8110}>
record1: <Test #hex{827763617074757265817764697363617264} <capture <discard>>>
record2: <Test #hex{82 776f627365727665 83 75737065616b 81 7764697363617264 82 7763617074757265 81 7764697363617264} <observe <speak <discard>, <capture <discard>>>>>
record3: <Test #hex{85 95 767469746c6564 76706572736f6e 32 757468696e67 31 4165 59426c61636b77656c6c 84 7464617465 42071d 32 33 524472} <[titled person 2 thing 1] 101 "Blackwell" <date 1821 2 3> "Dr">>
record4: <Test #hex{817764697363617264} <discard>>
record5: <Test #hex{823790} <7[]>>
record6: <Test #hex{827764697363617264787375727072697365} <discard surprise>>
record7: <Test #hex{835761537472696e673334} <"aString" 3 4>>
record8: <Test #hex{838177646973636172643334} <<discard> 3 4>>
list10: @"Missing end byte" <DecodeShort #x"b58080">
noinput0: @"No input at all" <DecodeEOF #x"">
record1: <Test #x"b4 b30763617074757265 b4 b30764697363617264 84 84" <capture <discard>>>
record2: <Test #x"b4 b3076f627365727665 b4 b305737065616b b4 b30764697363617264 84 b4 b30763617074757265 b4 b30764697363617264 84 84 84 84" <observe <speak <discard>, <capture <discard>>>>>
record3: <Test #x"b4 b5 b3067469746c6564 b306706572736f6e 92 b3057468696e67 91 84 a065 b109426c61636b77656c6c b4 b30464617465 a1071d 92 93 84 b1024472 84" <[titled person 2 thing 1] 101 "Blackwell" <date 1821 2 3> "Dr">>
record4: <Test #x"b4 b30764697363617264 84" <discard>>
record5: <Test #x"b497b58484" <7[]>>
record6: <Test #x"b4b30764697363617264b308737572707269736584" <discard surprise>>
record7: <Test #x"b4b10761537472696e67939484" <"aString" 3 4>>
record8: <Test #x"b4b4b3076469736361726484939484" <<discard> 3 4>>
record9: @"Missing record label" <ParseError "<>">
record10: @"Missing close-angle-bracket" <ParseShort "<">
record11: @"Unexpected close-angle-bracket" <ParseError ">">
set0: <Test #hex{a0} #set{}>
set1: <NondeterministicTest #hex{a3313233} {1 2 3}>
set1a: <NondeterministicTest #hex{a3313233} #set{1 2 3}>
set2: @"Missing close brace" <ParseShort "#set{ 1 2 3 ">
set2a: @"Missing close brace" <ParseShort "#set{">
set3: @"Duplicate value" <ParseError "#set{a a}">
stream1: @"Chunk must be bytes" <DecodeError #hex{25516104}>
stream2: @"Chunk must be bytes" <DecodeError #hex{25716104}>
stream3: @"Chunk must be bytes" <DecodeError #hex{26516104}>
stream4: @"Chunk must be bytes" <DecodeError #hex{26716104}>
stream5: @"Chunk must be bytes" <DecodeError #hex{27516104}>
stream6: @"Chunk must be bytes" <DecodeError #hex{27716104}>
stream7: @"Missing end byte" <DecodeShort #hex{290000}>
stream8: @"Missing element" <DecodeShort #hex{930000}>
stream9: @"Unexpected end stream byte" <DecodeError #hex{04}>
stream10: @"Empty chunks forbidden" <DecodeError #hex{25616160616104}>
stream11: @"Empty chunks forbidden" <DecodeError #hex{26616160616104}>
stream12: @"Empty chunks forbidden" <DecodeError #hex{27616160616104}>
string0: <Test #hex{50} "">
string0a: <StreamingTest #hex{2504} "">
string1: <StreamingTest #hex{25626865626c6c616f04} "hello">
string2: <StreamingTest #hex{25626865636c6c6f04} "hello">
string3: <Test #hex{5568656c6c6f} "hello">
string4: <Test #hex{5f 14 616263e6b0b4e6b0b45c2f22080c0a0d0978797a} "abc\u6c34\u6C34\\/\"\b\f\n\r\txyz">
string5: <Test #hex{54f09d849e} "\uD834\uDD1E">
symbol0: <Test #hex{70} ||>
symbol1: <StreamingTest #hex{27626865626c6c616f04} hello>
symbol2: <Test #hex{7568656c6c6f} hello>
set0: <Test #x"b684" #{}>
set1: <NondeterministicTest #x"b691929384" #{1 2 3}>
set2: @"Missing close brace" <ParseShort "#{ 1 2 3 ">
set2a: @"Missing close brace" <ParseShort "#{">
set3: @"Duplicate value" <ParseError "#{a a}">
string0: <Test #x"b100" "">
string3: <Test #x"b10568656c6c6f" "hello">
string4: <Test #x"b1 14 616263e6b0b4e6b0b45c2f22080c0a0d0978797a" "abc\u6c34\u6C34\\/\"\b\f\n\r\txyz">
string5: <Test #x"b104f09d849e" "\uD834\uDD1E">
symbol0: <Test #x"b300" ||>
symbol2: <Test #x"b30568656c6c6f" hello>
tag0: @"Unexpected end tag" <DecodeError #x"84">
tag1: @"Invalid tag" <DecodeError #x"10">
tag2: @"Invalid tag" <DecodeError #x"61b10110">
whitespace0: @"Leading spaces have to eventually yield something" <ParseShort " ">
whitespace1: @"No input at all" <ParseEOF "">
value1: <Test #"\x66corymb" #value#"fcorymb">
value2: <Test #"\x01" #value#"\x01">
value3: <Test #"\x01" #value#base64{AQ}>
value4: <Test #"\x01" #value#base64{AQ==}>
value5: <Test #"\x01" #value #base64{AQ==}>
value6: <Test #hex{93313233} #value#hex{93313233}>
value1: <Test #"\xB2\x06corymb" #=#"\xB2\x06corymb">
value2: <Test #"\x81" #=#"\x81">
value3: <Test #"\x81" #=#[gQ]>
value4: <Test #"\x81" #=#[gQ==]>
value5: <Test #"\x81" #= #[gQ==]>
value6: <Test #x"b591929384" #=#x"b591929384">
longlist14: <Test #hex{9e0000000000000000000000000000}
[#false #false #false #false #false
#false #false #false #false #false
#false #false #false #false]>
longlist15: <Test #hex{9f0f000000000000000000000000000000}
[#false #false #false #false #false
#false #false #false #false #false
#false #false #false #false #false]>
longlist14: <Test #x"b5808080808080808080808080808084"
[#f #f #f #f #f
#f #f #f #f #f
#f #f #f #f]>
longlist15: <Test #x"b580808080808080808080808080808084"
[#f #f #f #f #f
#f #f #f #f #f
#f #f #f #f #f]>
longlist100:
<Test #hex{9f64
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000}
[#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false]>
<Test #x"b5
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
84"
[#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f]>
longlist200:
<Test #hex{9fc801
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000
00000000000000000000}
[#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false
#false #false #false #false #false #false #false #false #false #false]>
<Test #x"b5
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
80808080808080808080
84"
[#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f]>
rfc8259-example1: <NondeterministicTest
#hex{b2 55 496d616765
bc 58 416e696d61746564
75 66616c7365
56 486569676874
42 0258
53 494473
94 41 74
42 03af
42 00ea
43 009789
59 5468756d626e61696c
b6 56 486569676874
41 7d
53 55726c
5f26 687474703a2f2f7777772e6578616d706c652e636f6d2f696d6167652f343831393839393433
55 5769647468
41 64
55 5469746c65
5f14 566965772066726f6d203135746820466c6f6f72
55 5769647468
42 0320}
#x"B7
B1 05 496d616765
B7
B1 03 494473
B5
A0 74
A1 03 AF
A1 00 EA
A2 00 97 89
84
B1 05 5469746c65
B1 14 566965772066726f6d203135746820466c6f6f72
B1 05 5769647468
A1 03 20
B1 06 486569676874
A1 02 58
B1 08 416e696d61746564
B3 05 66616c7365
B1 09 5468756d626e61696c
B7
B1 03 55726c
B1 26 687474703a2f2f7777772e6578616d706c652e636f6d2f696d6167652f343831393839393433
B1 05 5769647468
A0 64
B1 06 486569676874
A0 7D
84
84
84"
{
"Image": {
"Width": 800,
@ -286,22 +266,28 @@
}>
rfc8259-example2: <NondeterministicTest
#hex{92 bf10 57 41646472657373 50
54 43697479 5d 53414e204652414e434953434f
57 436f756e747279 52 5553
58 4c61746974756465 03 4042e226809d4952
59 4c6f6e676974756465 03 c05e99566cf41f21
55 5374617465 52 4341
53 5a6970 55 3934313037
59 707265636973696f6e 53 7a6970
bf10 57 41646472657373 50
54 43697479 59 53554e4e5956414c45
57 436f756e747279 52 5553
58 4c61746974756465 03 4042af9d66adb403
59 4c6f6e676974756465 03 c05e81aa4fca42af
55 5374617465 52 4341
53 5a6970 55 3934303835
59 707265636973696f6e 53 7a6970}
#x"b5
b7
b1 03 5a6970 b1 05 3934313037
b1 04 43697479 b1 0d 53414e204652414e434953434f
b1 05 5374617465 b1 02 4341
b1 07 41646472657373 b1 00
b1 07 436f756e747279 b1 02 5553
b1 08 4c61746974756465 83 4042e226809d4952
b1 09 4c6f6e676974756465 83 c05e99566cf41f21
b1 09 707265636973696f6e b1 03 7a6970
84
b7
b1 03 5a6970 b1 05 3934303835
b1 04 43697479 b1 09 53554e4e5956414c45
b1 05 5374617465 b1 02 4341
b1 07 41646472657373 b1 00
b1 07 436f756e747279 b1 02 5553
b1 08 4c61746974756465 83 4042af9d66adb403
b1 09 4c6f6e676974756465 83 c05e81aa4fca42af
b1 09 707265636973696f6e b1 03 7a6970
84
84"
[
{
"precision": "zip",