You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
typesetting/pitfall/restructure/number.rkt

122 lines
5.3 KiB
Racket

This file contains invisible Unicode characters!

This file contains invisible Unicode characters that may be processed differently from what appears below. If your use case is intentional and legitimate, you can safely ignore this warning. Use the Escape button to reveal hidden characters.

#lang restructure/racket
(require "stream.rkt" "sizes.rkt" (for-syntax "sizes.rkt" racket/match))
(provide (all-defined-out))
#|
approximates
https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
|#
(define (ends-with-8? type)
(define str (symbol->string type))
(equal? (substring str (sub1 (string-length str))) "8"))
(define (signed-type? type)
(not (equal? "u" (substring (symbol->string type) 0 1))))
(test-module
(check-false (signed-type? 'uint16))
(check-true (signed-type? 'int16)))
(define-subclass Streamcoder (Number [type 'uint16] [endian (if (system-big-endian?) 'be 'le)])
(getter-field [number-type (string->symbol (format "~a~a" type (if (ends-with-8? type) "" endian)))])
(define _signed? (signed-type? type))
;; `get-type-size` will raise error if number-type is invalid: use this as check of input
;; size of a number doesn't change, so we can stash it as `_size`
(define _size (with-handlers ([exn:fail:contract?
(λ (exn)
(raise-argument-error 'Number "valid type and endian" (format "~v ~v" type endian)))])
(get-type-size number-type)))
(define/override (size . args) _size)
(define-values (bound-min bound-max)
(let* ([unsigned-max (sub1 (expt 2 (sub1 (* _size 8))))]
[unsigned-min (sub1 (- unsigned-max))])
(if _signed?
(values unsigned-min unsigned-max)
(values (- unsigned-min unsigned-min) (- unsigned-max unsigned-min)))))
(define/augment (decode stream . args)
(define bstr (send stream read _size))
(if (= 1 _size)
(+ (bytes-ref bstr 0) (if _signed? bound-min 0))
(integer-bytes->integer bstr _signed? (eq? endian 'be))))
(define/augment (encode stream val-in)
(define val (if (integer? val-in) (inexact->exact val-in) val-in))
;; todo: better bounds checking
(unless (<= bound-min val bound-max)
(raise-argument-error 'Number:encode (format "value within range of ~a ~a-byte int (~a to ~a)" (if _signed? "signed" "unsigned") _size bound-min bound-max) val))
(define bstr (if (= 1 _size)
(bytes (- val (if _signed? bound-min 0)))
(integer->integer-bytes val _size _signed? (eq? endian 'be))))
(send stream write bstr)))
(test-module
(check-exn exn:fail:contract? (λ () (+Number 'not-a-valid-type)))
(check-exn exn:fail:contract? (λ () (send uint8 encode (+EncodeStream) 256)))
(check-not-exn (λ () (send uint8 encode (+EncodeStream) 255)))
(check-exn exn:fail:contract? (λ () (send int8 encode (+EncodeStream) 256)))
(check-exn exn:fail:contract? (λ () (send int8 encode (+EncodeStream) 255)))
(check-not-exn (λ () (send int8 encode (+EncodeStream) 127)))
(check-not-exn (λ () (send int8 encode (+EncodeStream) -128)))
(check-exn exn:fail:contract? (λ () (send int8 encode (+EncodeStream) -129)))
(check-exn exn:fail:contract? (λ () (send uint16 encode (+EncodeStream) (add1 #xffff))))
(check-not-exn (λ () (send uint16 encode (+EncodeStream) #xffff)))
(let ([o (+Number 'uint16 'le)]
[ip (+DecodeStream (bytes 1 2 3 4))]
[op (open-output-bytes)])
(check-equal? (send o decode ip) 513) ;; 1000 0000 0100 0000
(check-equal? (send o decode ip) 1027) ;; 1100 0000 0010 0000
(send o encode op 513)
(check-equal? (get-output-bytes op) (bytes 1 2))
(send o encode op 1027)
(check-equal? (get-output-bytes op) (bytes 1 2 3 4)))
(let ([o (+Number 'uint16 'be)]
[ip (+DecodeStream (bytes 1 2 3 4))]
[op (open-output-bytes)])
(check-equal? (send o decode ip) 258) ;; 0100 0000 1000 0000
(check-equal? (send o decode ip) 772) ;; 0010 0000 1100 0000
(send o encode op 258)
(check-equal? (get-output-bytes op) (bytes 1 2))
(send o encode op 772)
(check-equal? (get-output-bytes op) (bytes 1 2 3 4))))
(test-module
(check-equal? (send (+Number 'uint8) size) 1)
(check-equal? (send (+Number) size) 2)
(check-equal? (send (+Number 'uint32) size) 4)
(check-equal? (send (+Number 'double) size) 8))
;; use keys of type-sizes hash to generate corresponding number definitions
(define-macro (make-int-types)
(with-pattern ([((ID BASE ENDIAN) ...) (for/list ([k (in-hash-keys type-sizes)])
(define kstr (format "~a" k))
(match-define (list* prefix suffix _)
(regexp-split #rx"(?=[bl]e|$)" kstr))
(map string->symbol
(list (string-downcase kstr)
prefix
(if (positive? (string-length suffix))
suffix
(if (system-big-endian?) "be" "le")))))]
[(ID ...) (suffix-id #'(ID ...) #:context caller-stx)])
#'(begin (define+provide ID (make-object Number 'BASE 'ENDIAN)) ...)))
(make-int-types)
(test-module
(check-equal? (send uint8 size) 1)
(check-equal? (send uint16 size) 2)
(check-equal? (send uint32 size) 4)
(check-equal? (send double size) 8))