(module utils racket/base (require racket/path racket/runtime-path ffi/unsafe setup/dirs "downloader.rkt" simple-log ) (provide while until build-lib-path get-lib do-for dbg-sound info-sound err-sound warn-sound fatal-sound sync-log-sound integer->int-bytes int-bytes->integer let/assert make-assert a-eq? a-!eq? a->? a-<=? a->=? a-int-bytes v size signed? big? bs pos) (if (= size 3) (if big? (begin (bytes-set! bs pos (bitwise-and (arithmetic-shift v -16) #xff)) (bytes-set! bs (+ pos 1) (bitwise-and (arithmetic-shift v -8) #xff)) (bytes-set! bs (+ pos 2) (bitwise-and v #xff))) (begin (bytes-set! bs pos (bitwise-and v #xff)) (bytes-set! bs (+ pos 1) (bitwise-and (arithmetic-shift v -8) #xff)) (bytes-set! bs (+ pos 2) (bitwise-and (arithmetic-shift v -16) #xff)))) (integer->integer-bytes v size signed? big? bs pos))) (define-syntax-rule (int-bytes->integer bs signed? big? start end) (let ([size (- end start)]) (if (= size 3) (let* ([b0 (bytes-ref bs start)] [b1 (bytes-ref bs (+ start 1))] [b2 (bytes-ref bs (+ start 2))] [u (if big? (bitwise-ior (arithmetic-shift b0 16) (arithmetic-shift b1 8) b2) (bitwise-ior b0 (arithmetic-shift b1 8) (arithmetic-shift b2 16)))]) (if (and signed? (not (zero? (bitwise-and u #x800000)))) (- u #x1000000) u)) (integer-bytes->integer bs signed? big? start end)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; let/assert ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-syntax make-assert (syntax-rules () ((_ name not-name pred) (begin (define-syntax name (syntax-rules () ((_ const) (λ (x) (pred x const))))) (define-syntax not-name (syntax-rules () ((_ const) (λ (x) (not (pred x const)))))) ) ) ) ) (make-assert a-eq? a-!eq? eq?) (define a-nullptr? (a-eq? #f)) (define a-!nullptr? (a-!eq? #f)) (make-assert a->? a-<=? >) (make-assert a->=? a-=) (make-assert a-=? a-!=? =) (define a-true? (a-eq? #t)) (define a-false? (a-eq? #f)) (struct exn:let/assert exn (value) #:transparent) (define (raise-let/assert v) (raise (exn:let/assert "let/assert" (current-continuation-marks) v))) (define (let/assert-value r) (exn:let/assert-value r)) (define-syntax assert-expr (syntax-rules () ((_ expr cond retval) (let ((a expr)) (if (cond a) a (raise-let/assert retval)))) ((_ expr) expr) ) ) (define-syntax let/assert (syntax-rules () ((_ ((v rest ...) ...) b1 ...) (with-handlers ([exn:let/assert? let/assert-value]) (let* ((v (assert-expr rest ...)) ...) b1 ... ) ) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; define/return ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (struct exn:return exn (value) #:transparent) (define (raise-return v) (raise (exn:return "return" (current-continuation-marks) v))) (define (return-value r) (exn:return-value r)) (define-syntax return (syntax-rules () ((_ val) (raise-return val)))) (define-syntax define/return (syntax-rules () ((_ (name ...) b1 ...) (define (name ...) (with-handlers ([exn:return? return-value]) b1 ... ) ) ) ) ) ) ; end of module