829c251bca
Running cognitect aws-api's pure test namespaces (signing/shapes/protocols/ util/retry/endpoints) surfaced general gaps: - extend-protocol/extend-type accept a computed class type, e.g. (Class/forName "[B") for the byte-array class — the byte-array idiom data.json and aws-api use. The macro grouping handled only symbol/nil heads (it crashed on a list type); type->name resolves a Class value via .getName; a byte-array dispatches on the "[B" host tag. - java.nio.ByteBuffer over a jolt byte-array (wrap/allocate/get/put/array/ remaining/position/limit/duplicate/flip), plus extend-protocol to it. - java.util.Arrays (equals/copyOf/copyOfRange/fill) and java.util.Random (nextBytes/nextInt/…). - java.net.URI/create and clojure.lang.RT/baseLoader statics. - clojure.core.async/promise-chan (deliver-once, peek-don't-pop). - a failed java.time parse throws DateTimeParseException (typed), so (catch DateTimeParseException …) matches it instead of leaking an untyped condition. The XML side lives in the jolt-lang/xml library (libxml2 over jolt.ffi); ByteBuffer stays in core as a generic java.nio primitive. Gate: make test green (corpus +6 JVM-certified rows, 0 NEW divergence; unit 553/553; SCI 211).
85 lines
5 KiB
Scheme
85 lines
5 KiB
Scheme
;; byte-buffer.ss — java.nio.ByteBuffer over a jolt byte-array. A buffer is a
|
|
;; jhost tagged "byte-buffer" with mutable #(backing-array position limit); the
|
|
;; backing is a jolt byte-array (vector of 0..255). Covers the slice of the API
|
|
;; portable code reaches for — wrap / get(byte[]) / array / remaining / position /
|
|
;; limit / duplicate / flip / rewind — e.g. cognitect aws-api wrapping blob bytes.
|
|
|
|
(define (make-byte-buffer backing pos limit) (make-jhost "byte-buffer" (vector backing pos limit)))
|
|
(define (bb? x) (and (jhost? x) (string=? (jhost-tag x) "byte-buffer")))
|
|
(define (bb-backing b) (vector-ref (jhost-state b) 0))
|
|
(define (bb-pos b) (vector-ref (jhost-state b) 1))
|
|
(define (bb-limit b) (vector-ref (jhost-state b) 2))
|
|
(define (bb-pos! b n) (vector-set! (jhost-state b) 1 n))
|
|
(define (bb-limit! b n) (vector-set! (jhost-state b) 2 n))
|
|
(define (bb-capacity b) (vector-length (jolt-array-vec (bb-backing b))))
|
|
|
|
;; (ByteBuffer/wrap ba) | (ByteBuffer/wrap ba off len) | (ByteBuffer/allocate n)
|
|
(register-class-statics! "ByteBuffer"
|
|
(list
|
|
(cons "wrap" (lambda (ba . rest)
|
|
(let ((cap (vector-length (jolt-array-vec ba))))
|
|
(if (pair? rest)
|
|
(let ((off (jnum->exact (car rest))) (len (jnum->exact (cadr rest))))
|
|
(make-byte-buffer ba off (+ off len)))
|
|
(make-byte-buffer ba 0 cap)))))
|
|
(cons "allocate" (lambda (n)
|
|
(let ((cap (jnum->exact n)))
|
|
(make-byte-buffer (make-jolt-array (make-vector cap 0) 'byte) 0 cap))))
|
|
;; jolt has one heap; a direct buffer is just a buffer here.
|
|
(cons "allocateDirect" (lambda (n)
|
|
(let ((cap (jnum->exact n)))
|
|
(make-byte-buffer (make-jolt-array (make-vector cap 0) 'byte) 0 cap))))))
|
|
|
|
(register-host-methods! "byte-buffer"
|
|
(list
|
|
(cons "remaining" (lambda (self) (->num (- (bb-limit self) (bb-pos self)))))
|
|
(cons "hasRemaining" (lambda (self) (> (bb-limit self) (bb-pos self))))
|
|
;; position / limit are getters with no arg, setters (returning the buffer) with one
|
|
(cons "position" (lambda (self . a)
|
|
(if (pair? a) (begin (bb-pos! self (jnum->exact (car a))) self) (->num (bb-pos self)))))
|
|
(cons "limit" (lambda (self . a)
|
|
(if (pair? a) (begin (bb-limit! self (jnum->exact (car a))) self) (->num (bb-limit self)))))
|
|
(cons "capacity" (lambda (self) (->num (bb-capacity self))))
|
|
(cons "hasArray" (lambda (self) #t))
|
|
(cons "array" (lambda (self) (bb-backing self)))
|
|
(cons "duplicate" (lambda (self) (make-byte-buffer (bb-backing self) (bb-pos self) (bb-limit self))))
|
|
(cons "rewind" (lambda (self) (bb-pos! self 0) self))
|
|
(cons "flip" (lambda (self) (bb-limit! self (bb-pos self)) (bb-pos! self 0) self))
|
|
(cons "clear" (lambda (self) (bb-pos! self 0) (bb-limit! self (bb-capacity self)) self))
|
|
;; (.get dst) | (.get dst off len): bulk copy from position into a byte-array,
|
|
;; advancing position. Returns the buffer like the JVM.
|
|
;; (.put src): copy bytes into the buffer at position, advancing it. src is
|
|
;; another ByteBuffer (its remaining bytes), a byte-array, or a single byte.
|
|
(cons "put" (lambda (self src . rest)
|
|
(let ((dv (jolt-array-vec (bb-backing self))) (dp (bb-pos self)))
|
|
(cond
|
|
((bb? src)
|
|
(let* ((sv (jolt-array-vec (bb-backing src))) (sp (bb-pos src))
|
|
(n (- (bb-limit src) sp)))
|
|
(do ((i 0 (fx+ i 1))) ((fx=? i n))
|
|
(vector-set! dv (+ dp i) (vector-ref sv (+ sp i))))
|
|
(bb-pos! src (bb-limit src)) (bb-pos! self (+ dp n))))
|
|
((jolt-array? src)
|
|
(let* ((sv (jolt-array-vec src)) (n (vector-length sv)))
|
|
(do ((i 0 (fx+ i 1))) ((fx=? i n))
|
|
(vector-set! dv (+ dp i) (vector-ref sv i)))
|
|
(bb-pos! self (+ dp n))))
|
|
(else (vector-set! dv dp (jnum->exact src)) (bb-pos! self (+ dp 1))))
|
|
self)))
|
|
(cons "get" (lambda (self dst . rest)
|
|
(let* ((src (jolt-array-vec (bb-backing self)))
|
|
(dv (jolt-array-vec dst))
|
|
(off (if (pair? rest) (jnum->exact (car rest)) 0))
|
|
(len (if (and (pair? rest) (pair? (cdr rest))) (jnum->exact (cadr rest)) (vector-length dv)))
|
|
(p (bb-pos self)))
|
|
(do ((i 0 (+ i 1))) ((= i len))
|
|
(vector-set! dv (+ off i) (vector-ref src (+ p i))))
|
|
(bb-pos! self (+ p len))
|
|
self)))))
|
|
|
|
(register-class-arm! bb? (lambda (x) "java.nio.ByteBuffer"))
|
|
(register-instance-check-arm!
|
|
(lambda (type-sym val)
|
|
(if (and (symbol-t? type-sym) (bb? val)
|
|
(member (last-dot (symbol-t-name type-sym)) '("ByteBuffer")))
|
|
#t 'pass)))
|