Update Racket implementation
This commit is contained in:
parent
5d719c2c6f
commit
85fe7b3b07
|
@ -1,6 +1,5 @@
|
||||||
#lang setup/infotab
|
#lang setup/infotab
|
||||||
(define collection 'multi)
|
(define collection 'multi)
|
||||||
(define deps '("base"
|
(define deps '("base"
|
||||||
"bitsyntax"
|
|
||||||
"rackunit-lib"
|
"rackunit-lib"
|
||||||
"data-lib"))
|
"data-lib"))
|
||||||
|
|
|
@ -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])))
|
|
@ -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)
|
|
@ -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))))
|
File diff suppressed because it is too large
Load Diff
|
@ -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)))))
|
|
@ -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))]))))
|
|
@ -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)]))
|
|
@ -20,8 +20,9 @@
|
||||||
[(record label fields) (values #t label fields)]
|
[(record label fields) (values #t label fields)]
|
||||||
[(? non-object-struct?)
|
[(? non-object-struct?)
|
||||||
(define key (prefab-struct-key r))
|
(define key (prefab-struct-key r))
|
||||||
(when (not key) (error 'preserves "Cannot process non-prefab struct ~v" r))
|
(if key
|
||||||
(values #t key (cdr (vector->list (struct->vector r))))]
|
(values #t key (cdr (vector->list (struct->vector r))))
|
||||||
|
(values #f #f #f))]
|
||||||
[_ (values #f #f #f)]))
|
[_ (values #f #f #f)]))
|
||||||
|
|
||||||
(define-match-expander record-expander
|
(define-match-expander record-expander
|
||||||
|
|
|
@ -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)]))
|
||||||
|
)
|
|
@ -6,7 +6,7 @@
|
||||||
|
|
||||||
(module+ main
|
(module+ main
|
||||||
(require racket/cmdline)
|
(require racket/cmdline)
|
||||||
(define input-format 'text)
|
(define input-format 'any)
|
||||||
(define output-format 'binary)
|
(define output-format 'binary)
|
||||||
(define indent? #t)
|
(define indent? #t)
|
||||||
(define annotations? #t)
|
(define annotations? #t)
|
||||||
|
@ -17,6 +17,8 @@
|
||||||
["--btoa" "Binary to text"
|
["--btoa" "Binary to text"
|
||||||
(begin (set! input-format 'binary)
|
(begin (set! input-format 'binary)
|
||||||
(set! output-format 'text))]
|
(set! output-format 'text))]
|
||||||
|
[("--ia" "--input-any") "Autodetect input mode (default)"
|
||||||
|
(set! input-format 'any)]
|
||||||
[("--ib" "--input-binary") "Set binary input mode"
|
[("--ib" "--input-binary") "Set binary input mode"
|
||||||
(set! input-format 'binary)]
|
(set! input-format 'binary)]
|
||||||
[("--it" "--input-text") "Set text input mode"
|
[("--it" "--input-text") "Set text input mode"
|
||||||
|
@ -25,9 +27,11 @@
|
||||||
(set! output-format 'binary)]
|
(set! output-format 'binary)]
|
||||||
[("--ot" "--output-text") "Set text output mode"
|
[("--ot" "--output-text") "Set text output mode"
|
||||||
(set! output-format 'text)]
|
(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)]
|
(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)]
|
(set! indent? #f)]
|
||||||
["--annotations" "Output annotations"
|
["--annotations" "Output annotations"
|
||||||
(set! annotations? #t)]
|
(set! annotations? #t)]
|
||||||
|
@ -36,9 +40,10 @@
|
||||||
|
|
||||||
(define v ((if annotations? values strip-annotations)
|
(define v ((if annotations? values strip-annotations)
|
||||||
(match input-format
|
(match input-format
|
||||||
['text (read-preserve-syntax #:source "<stdin>")]
|
['any (read-preserve #:read-syntax? #t #:source "<stdin>")]
|
||||||
['binary (decode-syntax (port->bytes))])))
|
['text (read-preserve/text #:read-syntax? #t #:source "<stdin>")]
|
||||||
|
['binary (read-preserve/binary #:read-syntax? #t)])))
|
||||||
(void (match output-format
|
(void (match output-format
|
||||||
['text (write-preserve v #:indent indent?)]
|
['text (write-preserve/text v #:indent indent?)]
|
||||||
['binary (write-bytes (encode v))]))
|
['binary (write-preserve/binary v #:write-annotations? #t)]))
|
||||||
(flush-output))
|
(flush-output))
|
||||||
|
|
|
@ -8,42 +8,53 @@
|
||||||
;; two's complement representation of the number in groups of 7 bits,
|
;; two's complement representation of the number in groups of 7 bits,
|
||||||
;; least significant group first."
|
;; least significant group first."
|
||||||
|
|
||||||
(provide encode-varint
|
(provide write-varint
|
||||||
|
read-varint
|
||||||
|
encode-varint
|
||||||
decode-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)
|
(define (encode-varint v)
|
||||||
(if (< v 128)
|
(call-with-output-bytes (lambda (p) (write-varint v p))))
|
||||||
(bytes v)
|
|
||||||
(bit-string ((+ (modulo v 128) 128) :: bits 8)
|
|
||||||
((encode-varint (quotient v 128)) :: binary))))
|
|
||||||
|
|
||||||
(define (decode-varint bs ks kf)
|
(define (decode-varint bs ks kf)
|
||||||
(bit-string-case bs
|
((call-with-input-bytes bs (lambda (p)
|
||||||
#:on-short (lambda (fail) (kf #t))
|
(define v (read-varint p))
|
||||||
([ (= 1 :: bits 1) (v :: bits 7) (rest :: binary) ]
|
(cond [(eof-object? v) (lambda () (kf #t))]
|
||||||
(decode-varint rest (lambda (acc tail) (ks (+ (* acc 128) v) tail)) kf))
|
[else (define rest (port->bytes p))
|
||||||
([ (= 0 :: bits 1) (v :: bits 7) (rest :: binary) ]
|
(lambda () (ks v rest))])))))
|
||||||
(ks v rest))
|
|
||||||
(else
|
|
||||||
(kf))))
|
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(require rackunit)
|
(require rackunit)
|
||||||
|
|
||||||
(check-equal? (bit-string->bytes (encode-varint 0)) (bytes 0))
|
(check-equal? (encode-varint 0) (bytes 0))
|
||||||
(check-equal? (bit-string->bytes (encode-varint 1)) (bytes 1))
|
(check-equal? (encode-varint 1) (bytes 1))
|
||||||
(check-equal? (bit-string->bytes (encode-varint 127)) (bytes 127))
|
(check-equal? (encode-varint 127) (bytes 127))
|
||||||
(check-equal? (bit-string->bytes (encode-varint 128)) (bytes 128 1))
|
(check-equal? (encode-varint 128) (bytes 128 1))
|
||||||
(check-equal? (bit-string->bytes (encode-varint 255)) (bytes 255 1))
|
(check-equal? (encode-varint 255) (bytes 255 1))
|
||||||
(check-equal? (bit-string->bytes (encode-varint 256)) (bytes 128 2))
|
(check-equal? (encode-varint 256) (bytes 128 2))
|
||||||
(check-equal? (bit-string->bytes (encode-varint 300)) (bytes #b10101100 #b00000010))
|
(check-equal? (encode-varint 300) (bytes #b10101100 #b00000010))
|
||||||
(check-equal? (bit-string->bytes (encode-varint 1000000000)) (bytes 128 148 235 220 3))
|
(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)))
|
(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) ks* kf*) (list 0 (bytes)))
|
||||||
(check-equal? (decode-varint (bytes 0 99) ks* kf*) (list 0 (bytes 99)))
|
(check-equal? (decode-varint (bytes 0 99) ks* kf*) (list 0 (bytes 99)))
|
||||||
(check-equal? (decode-varint (bytes 1) ks* kf*) (list 1 (bytes)))
|
(check-equal? (decode-varint (bytes 1) ks* kf*) (list 1 (bytes)))
|
||||||
|
|
|
@ -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))
|
|
@ -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
10
preserves.el
|
@ -33,9 +33,9 @@
|
||||||
"Syntax table in use in preserves-mode buffers.")
|
"Syntax table in use in preserves-mode buffers.")
|
||||||
|
|
||||||
;; (modify-syntax-entry ?' "\"" preserves-mode-syntax-table)
|
;; (modify-syntax-entry ?' "\"" preserves-mode-syntax-table)
|
||||||
(modify-syntax-entry ?\n "> b" preserves-mode-syntax-table)
|
(modify-syntax-entry ?\n ">" preserves-mode-syntax-table)
|
||||||
(modify-syntax-entry ?\r "> b" preserves-mode-syntax-table)
|
(modify-syntax-entry ?\r ">" preserves-mode-syntax-table)
|
||||||
(modify-syntax-entry ?/ "_ 12b" 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)
|
||||||
(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))
|
(mapcar #'(lambda (x) (modify-syntax-entry x "_" preserves-mode-syntax-table))
|
||||||
|
@ -55,9 +55,9 @@
|
||||||
(make-local-variable 'comment-end)
|
(make-local-variable 'comment-end)
|
||||||
(make-local-variable 'comment-start-skip)
|
(make-local-variable 'comment-start-skip)
|
||||||
(setq comment-use-syntax t)
|
(setq comment-use-syntax t)
|
||||||
(setq comment-start "//")
|
(setq comment-start ";")
|
||||||
(setq comment-end "")
|
(setq comment-end "")
|
||||||
(setq comment-start-skip "// *")
|
(setq comment-start-skip "; *")
|
||||||
(make-local-variable 'font-lock-defaults)
|
(make-local-variable 'font-lock-defaults)
|
||||||
(setq font-lock-defaults '(preserves-font-lock-keywords nil nil ()))
|
(setq font-lock-defaults '(preserves-font-lock-keywords nil nil ()))
|
||||||
(make-local-variable 'indent-line-function)
|
(make-local-variable 'indent-line-function)
|
||||||
|
|
16
preserves.md
16
preserves.md
|
@ -367,10 +367,10 @@ double quote mark.
|
||||||
Finally, any `Value` may be represented by escaping from the textual
|
Finally, any `Value` may be represented by escaping from the textual
|
||||||
syntax to the [compact binary syntax](#compact-binary-syntax) by
|
syntax to the [compact binary syntax](#compact-binary-syntax) by
|
||||||
prefixing a `ByteString` containing the binary representation of the
|
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]
|
[^no-literal-binary-in-text] [^compact-value-annotations]
|
||||||
|
|
||||||
Compact = "#" ws ByteString
|
Compact = "#=" ws ByteString
|
||||||
|
|
||||||
[^rationale-switch-to-binary]: **Rationale.** The textual syntax
|
[^rationale-switch-to-binary]: **Rationale.** The textual syntax
|
||||||
cannot express every `Value`: specifically, it cannot express the
|
cannot express every `Value`: specifically, it cannot express the
|
||||||
|
@ -686,6 +686,12 @@ encodes to binary as follows:
|
||||||
B7
|
B7
|
||||||
B1 05 "Image"
|
B1 05 "Image"
|
||||||
B7
|
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 "Title" B1 14 "View from 15th Floor"
|
||||||
B1 05 "Width" A1 03 20
|
B1 05 "Width" A1 03 20
|
||||||
B1 06 "Height" A1 02 58
|
B1 06 "Height" A1 02 58
|
||||||
|
@ -693,12 +699,6 @@ encodes to binary as follows:
|
||||||
B1 09 "Thumbnail"
|
B1 09 "Thumbnail"
|
||||||
B7
|
B7
|
||||||
B1 03 "Url" B1 26 "http://www.example.com/image/481989943"
|
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 05 "Width" A0 64
|
||||||
B1 06 "Height" A0 7D
|
B1 06 "Height" A0 7D
|
||||||
84
|
84
|
||||||
|
|
Binary file not shown.
|
@ -2,23 +2,22 @@
|
||||||
@<Documentation [
|
@<Documentation [
|
||||||
"Individual test cases may be any of the following record types:"
|
"Individual test cases may be any of the following record types:"
|
||||||
<TestCaseTypes {
|
<TestCaseTypes {
|
||||||
Test: {fields: [binary annotatedValue] expectations: {1 2 3 4 5 6 7 8 9 11}}
|
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}}
|
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}}
|
||||||
DecodeTest: {fields: [binary annotatedValue] expectations: {1 2 3 4 5 6 7 8}}
|
ParseError: {fields: [text] expectations: #{12}}
|
||||||
ParseError: {fields: [text] expectations: {12}}
|
ParseShort: {fields: [text] expectations: #{13}}
|
||||||
ParseShort: {fields: [text] expectations: {13}}
|
ParseEOF: {fields: [text] expectations: #{14}}
|
||||||
ParseEOF: {fields: [text] expectations: {14}}
|
DecodeError: {fields: [bytes] expectations: #{15}}
|
||||||
DecodeError: {fields: [bytes] expectations: {15}}
|
DecodeShort: {fields: [bytes] expectations: #{16}}
|
||||||
DecodeShort: {fields: [bytes] expectations: {16}}
|
DecodeEOF: {fields: [bytes] expectations: #{17}}
|
||||||
DecodeEOF: {fields: [bytes] expectations: {17}}
|
|
||||||
}>
|
}>
|
||||||
"In each test, let value = strip(annotatedValue),",
|
"In each test, let value = strip(annotatedValue),",
|
||||||
" forward = value,",
|
" forward = value,",
|
||||||
" back = value,"
|
" back = value,"
|
||||||
"except where test-case-specific values of `forward` and/or `back` are provided"
|
"except where test-case-specific values of `forward` and/or `back`",
|
||||||
"by the executing harness (of particular importance for `StreamingTest`s),"
|
"are provided by the executing harness, and check the following"
|
||||||
"and check the following numbered expectations according to the table above:"
|
"numbered expectations according to the table above:"
|
||||||
<TestCaseExpectations {
|
<TestCaseExpectations {
|
||||||
1: "value = back"
|
1: "value = back"
|
||||||
2: "strip(decodeBinary(encodeBinary(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)"
|
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)"
|
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"
|
"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."
|
"13/14 and 16/17, depending on how they wish to treat end-of-stream conditions."
|
||||||
]>
|
]>
|
||||||
<TestCases {
|
<TestCases {
|
||||||
annotation1: <Test #hex{055361626339} @"abc" 9>
|
annotation1: <Test #x"85B10361626399" @"abc" 9>
|
||||||
annotation2: <Test #hex{05536162630553646566929005517890} @"abc" @"def" [[] @"x" []]>
|
annotation2: <Test #x"85B10361626385B103646566B5B58485B10178B58484" @"abc" @"def" [[] @"x" []]>
|
||||||
annotation3: <Test #hex{050531320505333435} @@1 2 @@3 4 5>
|
annotation3: <Test #x"858591928585939495" @@1 2 @@3 4 5>
|
||||||
annotation4: <NondeterministicTest #hex{b4 05 72616b 7161 05 726176 31 05 72626b 7162 05 726276 32}
|
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}>
|
{@ak a: @av 1 @bk b: @bv 2}>
|
||||||
annotation5: <Test #hex{05726172827152057261667166} @ar <R @af f>>
|
annotation5: <Test #x"85B3026172B4B3015285B3026166B3016684" @ar <R @af f>>
|
||||||
annotation6: <Test #hex{82057261727152057261667166} <@ar R @af f>>
|
annotation6: <Test #x"B485B3026172B3015285B3026166B3016684" <@ar R @af f>>
|
||||||
annotation7:
|
annotation7:
|
||||||
@"Stop reading symbols at @ -- this test has three separate annotations"
|
;Stop reading symbols at @ -- this test has three separate annotations
|
||||||
<Test #hex{05716105716205716390} @a@b@c[]>
|
<Test #x"85B3016185B3016285B30163B584" @a@b@c[]>
|
||||||
bytes1: <StreamingTest #hex{26626865626c6c616f04} #"hello">
|
bytes2: <Test #x"B20568656c6c6f" #"hello">
|
||||||
bytes2: <Test #hex{6568656c6c6f} #"hello">
|
bytes2a: <Test @"Internal whitespace is allowed, including commas!" #x"B2, 05, 68, 65, 6c, 6c, 6f" #"hello">
|
||||||
bytes2a: <Test @"Internal whitespace is allowed, including commas!" #hex{65, 68, 65, 6c, 6c, 6f} #"hello">
|
bytes3: <Test #x"B203414243" #"ABC">
|
||||||
bytes3: <Test #hex{63414243} #"ABC">
|
bytes4: <Test #x"B203414243" #x"414243">
|
||||||
bytes4: <Test #hex{63414243} #hex{414243}>
|
bytes5: <Test #x"B203414a4e" #x" 41 4A 4e ">
|
||||||
bytes5: <Test #hex{63414a4e} #hex{ 41 4A 4e }>
|
bytes6: @"Bytes must be 2-digits entire" <ParseError "#x\"414 243\"">
|
||||||
bytes6: @"Bytes must be 2-digits entire" <ParseError "#hex{414 243}">
|
bytes7: <Test #"\xB2\x06corymb" #[Y29yeW1i]>
|
||||||
bytes7: <Test #"\x66corymb" #base64{Y29yeW1i}>
|
bytes8: <Test #"\xB2\x06corymb" #[Y29 yeW 1i]>
|
||||||
bytes8: <Test #"\x66corymb" #base64{Y29 yeW 1i}>
|
bytes9: <Test #"\xB2\x02Hi" #[SGk=]>
|
||||||
bytes9: <Test #"\x62Hi" #base64{SGk=}>
|
bytes10: <Test #"\xB2\x02Hi" #[SGk]>
|
||||||
bytes10: <Test #"\x62Hi" #base64{SGk}>
|
bytes11: <Test #"\xB2\x02Hi" #[S G k]>
|
||||||
bytes11: <Test #"\x62Hi" #base64{S G k}>
|
|
||||||
bytes12: @"Bytes syntax only supports \\x, not \\u" <ParseError "#\"\\u6c34\"">
|
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} {}>
|
dict0: <Test #x"B784" {}>
|
||||||
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" } }>
|
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 ">
|
dict2: @"Missing close brace" <ParseShort "{ a: b, c: d ">
|
||||||
dict2a: @"Missing close brace" <ParseShort "{">
|
dict2a: @"Missing close brace" <ParseShort "{">
|
||||||
dict3: @"Duplicate key" <ParseError "{ a: 1, a: 2 }">
|
dict3: @"Duplicate key" <ParseError "{ a: 1, a: 2 }">
|
||||||
dict4: @"Unexpected close brace" <ParseError "}">
|
dict4: @"Unexpected close brace" <ParseError "}">
|
||||||
dict5: @"Missing value" <DecodeError #hex{b3 31 32 33}>
|
dict5: @"Missing value" <DecodeError #x"b7 91 92 93 84">
|
||||||
double1: <Test #hex{033ff0000000000000} 1.0>
|
double1: <Test #x"833ff0000000000000" 1.0>
|
||||||
double2: <Test #hex{03fe3cb7b759bf0426} -1.202e300>
|
double2: <Test #x"83fe3cb7b759bf0426" -1.202e300>
|
||||||
float1: <Test #hex{023f800000} 1.0f>
|
float1: <Test #x"823f800000" 1.0f>
|
||||||
int-257: <Test #hex{42feff} -257>
|
int-257: <Test #x"a1feff" -257>
|
||||||
int-256: <Test #hex{42ff00} -256>
|
int-256: <Test #x"a1ff00" -256>
|
||||||
int-255: <Test #hex{42ff01} -255>
|
int-255: <Test #x"a1ff01" -255>
|
||||||
int-254: <Test #hex{42ff02} -254>
|
int-254: <Test #x"a1ff02" -254>
|
||||||
int-129: <Test #hex{42ff7f} -129>
|
int-129: <Test #x"a1ff7f" -129>
|
||||||
int-128: <Test #hex{4180} -128>
|
int-128: <Test #x"a080" -128>
|
||||||
int-127: <Test #hex{4181} -127>
|
int-127: <Test #x"a081" -127>
|
||||||
int-4: <Test #hex{41fc} -4>
|
int-4: <Test #x"a0fc" -4>
|
||||||
int-3: <Test #hex{3d} -3>
|
int-3: <Test #x"9d" -3>
|
||||||
int-2: <Test #hex{3e} -2>
|
int-2: <Test #x"9e" -2>
|
||||||
int-1: <Test #hex{3f} -1>
|
int-1: <Test #x"9f" -1>
|
||||||
int0: <Test #hex{30} 0>
|
int0: <Test #x"90" 0>
|
||||||
int1: <Test #hex{31} 1>
|
int1: <Test #x"91" 1>
|
||||||
int12: <Test #hex{3c} 12>
|
int12: <Test #x"9c" 12>
|
||||||
int13: <Test #hex{410d} 13>
|
int13: <Test #x"a00d" 13>
|
||||||
int127: <Test #hex{417f} 127>
|
int127: <Test #x"a07f" 127>
|
||||||
int128: <Test #hex{420080} 128>
|
int128: <Test #x"a10080" 128>
|
||||||
int255: <Test #hex{4200ff} 255>
|
int255: <Test #x"a100ff" 255>
|
||||||
int256: <Test #hex{420100} 256>
|
int256: <Test #x"a10100" 256>
|
||||||
int32767: <Test #hex{427fff} 32767>
|
int32767: <Test #x"a17fff" 32767>
|
||||||
int32768: <Test #hex{43008000} 32768>
|
int32768: <Test #x"a2008000" 32768>
|
||||||
int65535: <Test #hex{4300ffff} 65535>
|
int65535: <Test #x"a200ffff" 65535>
|
||||||
int65536: <Test #hex{43010000} 65536>
|
int65536: <Test #x"a2010000" 65536>
|
||||||
int131072: <Test #hex{43020000} 131072>
|
int131072: <Test #x"a2020000" 131072>
|
||||||
list0: <Test #hex{90} []>
|
list0: <Test #x"b584" []>
|
||||||
list1: <StreamingTest #hex{293132333404} [1 2 3 4]>
|
list4: <Test #x"b59192939484" [1 2 3 4]>
|
||||||
list2: <StreamingTest #hex{2925636162630425636465660404} ["abc" "def"]>
|
list4a: <Test #x"b59192939484" [1, 2, 3, 4]>
|
||||||
list3: <StreamingTest #hex{2992516131925162329251633304} [["a" 1] ["b" 2] ["c" 3]]>
|
list5: <Test #x"b59e9f909184" [-2 -1 0 1]>
|
||||||
list4: <Test #hex{9431323334} [1 2 3 4]>
|
list6: <Test #x"b5 b10568656c6c6f b3057468657265 b205776f726c64 b584 b684 81 80 84" ["hello" there #"world" [] #{} #t #f]>
|
||||||
list4a: <Test #hex{9431323334} [1, 2, 3, 4]>
|
list7: <Test #x"b5 b303616263 b3032e2e2e b303646566 84" [abc ... def]>
|
||||||
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]>
|
|
||||||
list8: @"Missing close bracket" <ParseShort "[">
|
list8: @"Missing close bracket" <ParseShort "[">
|
||||||
list9: @"Unexpected close bracket" <ParseError "]">
|
list9: @"Unexpected close bracket" <ParseError "]">
|
||||||
noop0: <DecodeTest #hex{ff7764697363617264} discard>
|
list10: @"Missing end byte" <DecodeShort #x"b58080">
|
||||||
noop1: <DecodeTest #hex{ff31} 1>
|
noinput0: @"No input at all" <DecodeEOF #x"">
|
||||||
noop2: <DecodeTest #hex{ffffff42ff00} -256>
|
record1: <Test #x"b4 b30763617074757265 b4 b30764697363617264 84 84" <capture <discard>>>
|
||||||
noop3: <DecodeTest #hex{ff05ff53616263ff42ff00} @"abc" -256>
|
record2: <Test #x"b4 b3076f627365727665 b4 b305737065616b b4 b30764697363617264 84 b4 b30763617074757265 b4 b30764697363617264 84 84 84 84" <observe <speak <discard>, <capture <discard>>>>>
|
||||||
noop4: @"No-ops must be followed by something" <DecodeShort #hex{ffffff}>
|
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">>
|
||||||
noop5: @"No input at all" <DecodeEOF #hex{}>
|
record4: <Test #x"b4 b30764697363617264 84" <discard>>
|
||||||
placeholder0: @"Placeholders are no longer supported" <DecodeError #hex{10}>
|
record5: <Test #x"b497b58484" <7[]>>
|
||||||
placeholder1: @"Placeholders are no longer supported" <DecodeError #hex{8110}>
|
record6: <Test #x"b4b30764697363617264b308737572707269736584" <discard surprise>>
|
||||||
record1: <Test #hex{827763617074757265817764697363617264} <capture <discard>>>
|
record7: <Test #x"b4b10761537472696e67939484" <"aString" 3 4>>
|
||||||
record2: <Test #hex{82 776f627365727665 83 75737065616b 81 7764697363617264 82 7763617074757265 81 7764697363617264} <observe <speak <discard>, <capture <discard>>>>>
|
record8: <Test #x"b4b4b3076469736361726484939484" <<discard> 3 4>>
|
||||||
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>>
|
|
||||||
record9: @"Missing record label" <ParseError "<>">
|
record9: @"Missing record label" <ParseError "<>">
|
||||||
record10: @"Missing close-angle-bracket" <ParseShort "<">
|
record10: @"Missing close-angle-bracket" <ParseShort "<">
|
||||||
record11: @"Unexpected close-angle-bracket" <ParseError ">">
|
record11: @"Unexpected close-angle-bracket" <ParseError ">">
|
||||||
set0: <Test #hex{a0} #set{}>
|
set0: <Test #x"b684" #{}>
|
||||||
set1: <NondeterministicTest #hex{a3313233} {1 2 3}>
|
set1: <NondeterministicTest #x"b691929384" #{1 2 3}>
|
||||||
set1a: <NondeterministicTest #hex{a3313233} #set{1 2 3}>
|
set2: @"Missing close brace" <ParseShort "#{ 1 2 3 ">
|
||||||
set2: @"Missing close brace" <ParseShort "#set{ 1 2 3 ">
|
set2a: @"Missing close brace" <ParseShort "#{">
|
||||||
set2a: @"Missing close brace" <ParseShort "#set{">
|
set3: @"Duplicate value" <ParseError "#{a a}">
|
||||||
set3: @"Duplicate value" <ParseError "#set{a a}">
|
string0: <Test #x"b100" "">
|
||||||
stream1: @"Chunk must be bytes" <DecodeError #hex{25516104}>
|
string3: <Test #x"b10568656c6c6f" "hello">
|
||||||
stream2: @"Chunk must be bytes" <DecodeError #hex{25716104}>
|
string4: <Test #x"b1 14 616263e6b0b4e6b0b45c2f22080c0a0d0978797a" "abc\u6c34\u6C34\\/\"\b\f\n\r\txyz">
|
||||||
stream3: @"Chunk must be bytes" <DecodeError #hex{26516104}>
|
string5: <Test #x"b104f09d849e" "\uD834\uDD1E">
|
||||||
stream4: @"Chunk must be bytes" <DecodeError #hex{26716104}>
|
symbol0: <Test #x"b300" ||>
|
||||||
stream5: @"Chunk must be bytes" <DecodeError #hex{27516104}>
|
symbol2: <Test #x"b30568656c6c6f" hello>
|
||||||
stream6: @"Chunk must be bytes" <DecodeError #hex{27716104}>
|
tag0: @"Unexpected end tag" <DecodeError #x"84">
|
||||||
stream7: @"Missing end byte" <DecodeShort #hex{290000}>
|
tag1: @"Invalid tag" <DecodeError #x"10">
|
||||||
stream8: @"Missing element" <DecodeShort #hex{930000}>
|
tag2: @"Invalid tag" <DecodeError #x"61b10110">
|
||||||
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>
|
|
||||||
whitespace0: @"Leading spaces have to eventually yield something" <ParseShort " ">
|
whitespace0: @"Leading spaces have to eventually yield something" <ParseShort " ">
|
||||||
whitespace1: @"No input at all" <ParseEOF "">
|
whitespace1: @"No input at all" <ParseEOF "">
|
||||||
value1: <Test #"\x66corymb" #value#"fcorymb">
|
value1: <Test #"\xB2\x06corymb" #=#"\xB2\x06corymb">
|
||||||
value2: <Test #"\x01" #value#"\x01">
|
value2: <Test #"\x81" #=#"\x81">
|
||||||
value3: <Test #"\x01" #value#base64{AQ}>
|
value3: <Test #"\x81" #=#[gQ]>
|
||||||
value4: <Test #"\x01" #value#base64{AQ==}>
|
value4: <Test #"\x81" #=#[gQ==]>
|
||||||
value5: <Test #"\x01" #value #base64{AQ==}>
|
value5: <Test #"\x81" #= #[gQ==]>
|
||||||
value6: <Test #hex{93313233} #value#hex{93313233}>
|
value6: <Test #x"b591929384" #=#x"b591929384">
|
||||||
|
|
||||||
longlist14: <Test #hex{9e0000000000000000000000000000}
|
longlist14: <Test #x"b5808080808080808080808080808084"
|
||||||
[#false #false #false #false #false
|
[#f #f #f #f #f
|
||||||
#false #false #false #false #false
|
#f #f #f #f #f
|
||||||
#false #false #false #false]>
|
#f #f #f #f]>
|
||||||
longlist15: <Test #hex{9f0f000000000000000000000000000000}
|
longlist15: <Test #x"b580808080808080808080808080808084"
|
||||||
[#false #false #false #false #false
|
[#f #f #f #f #f
|
||||||
#false #false #false #false #false
|
#f #f #f #f #f
|
||||||
#false #false #false #false #false]>
|
#f #f #f #f #f]>
|
||||||
longlist100:
|
longlist100:
|
||||||
<Test #hex{9f64
|
<Test #x"b5
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000}
|
80808080808080808080
|
||||||
[#false #false #false #false #false #false #false #false #false #false
|
84"
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
[#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false]>
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
|
#f #f #f #f #f #f #f #f #f #f]>
|
||||||
longlist200:
|
longlist200:
|
||||||
<Test #hex{9fc801
|
<Test #x"b5
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000
|
80808080808080808080
|
||||||
00000000000000000000}
|
80808080808080808080
|
||||||
[#false #false #false #false #false #false #false #false #false #false
|
84"
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
[#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
#false #false #false #false #false #false #false #false #false #false]>
|
#f #f #f #f #f #f #f #f #f #f
|
||||||
|
#f #f #f #f #f #f #f #f #f #f]>
|
||||||
|
|
||||||
rfc8259-example1: <NondeterministicTest
|
rfc8259-example1: <NondeterministicTest
|
||||||
#hex{b2 55 496d616765
|
#x"B7
|
||||||
bc 58 416e696d61746564
|
B1 05 496d616765
|
||||||
75 66616c7365
|
B7
|
||||||
56 486569676874
|
B1 03 494473
|
||||||
42 0258
|
B5
|
||||||
53 494473
|
A0 74
|
||||||
94 41 74
|
A1 03 AF
|
||||||
42 03af
|
A1 00 EA
|
||||||
42 00ea
|
A2 00 97 89
|
||||||
43 009789
|
84
|
||||||
59 5468756d626e61696c
|
B1 05 5469746c65
|
||||||
b6 56 486569676874
|
B1 14 566965772066726f6d203135746820466c6f6f72
|
||||||
41 7d
|
B1 05 5769647468
|
||||||
53 55726c
|
A1 03 20
|
||||||
5f26 687474703a2f2f7777772e6578616d706c652e636f6d2f696d6167652f343831393839393433
|
B1 06 486569676874
|
||||||
55 5769647468
|
A1 02 58
|
||||||
41 64
|
B1 08 416e696d61746564
|
||||||
55 5469746c65
|
B3 05 66616c7365
|
||||||
5f14 566965772066726f6d203135746820466c6f6f72
|
B1 09 5468756d626e61696c
|
||||||
55 5769647468
|
B7
|
||||||
42 0320}
|
B1 03 55726c
|
||||||
|
B1 26 687474703a2f2f7777772e6578616d706c652e636f6d2f696d6167652f343831393839393433
|
||||||
|
B1 05 5769647468
|
||||||
|
A0 64
|
||||||
|
B1 06 486569676874
|
||||||
|
A0 7D
|
||||||
|
84
|
||||||
|
84
|
||||||
|
84"
|
||||||
{
|
{
|
||||||
"Image": {
|
"Image": {
|
||||||
"Width": 800,
|
"Width": 800,
|
||||||
|
@ -286,22 +266,28 @@
|
||||||
}>
|
}>
|
||||||
|
|
||||||
rfc8259-example2: <NondeterministicTest
|
rfc8259-example2: <NondeterministicTest
|
||||||
#hex{92 bf10 57 41646472657373 50
|
#x"b5
|
||||||
54 43697479 5d 53414e204652414e434953434f
|
b7
|
||||||
57 436f756e747279 52 5553
|
b1 03 5a6970 b1 05 3934313037
|
||||||
58 4c61746974756465 03 4042e226809d4952
|
b1 04 43697479 b1 0d 53414e204652414e434953434f
|
||||||
59 4c6f6e676974756465 03 c05e99566cf41f21
|
b1 05 5374617465 b1 02 4341
|
||||||
55 5374617465 52 4341
|
b1 07 41646472657373 b1 00
|
||||||
53 5a6970 55 3934313037
|
b1 07 436f756e747279 b1 02 5553
|
||||||
59 707265636973696f6e 53 7a6970
|
b1 08 4c61746974756465 83 4042e226809d4952
|
||||||
bf10 57 41646472657373 50
|
b1 09 4c6f6e676974756465 83 c05e99566cf41f21
|
||||||
54 43697479 59 53554e4e5956414c45
|
b1 09 707265636973696f6e b1 03 7a6970
|
||||||
57 436f756e747279 52 5553
|
84
|
||||||
58 4c61746974756465 03 4042af9d66adb403
|
b7
|
||||||
59 4c6f6e676974756465 03 c05e81aa4fca42af
|
b1 03 5a6970 b1 05 3934303835
|
||||||
55 5374617465 52 4341
|
b1 04 43697479 b1 09 53554e4e5956414c45
|
||||||
53 5a6970 55 3934303835
|
b1 05 5374617465 b1 02 4341
|
||||||
59 707265636973696f6e 53 7a6970}
|
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",
|
"precision": "zip",
|
||||||
|
|
Loading…
Reference in New Issue