103 lines
2.5 KiB
Racket
103 lines
2.5 KiB
Racket
#lang racket/base
|
|
|
|
(require ffi/unsafe
|
|
ffi/unsafe/define
|
|
ffi/unsafe/alloc
|
|
(for-syntax racket/base)
|
|
"utils.rkt"
|
|
)
|
|
|
|
(provide make-offsets
|
|
def-cstruct
|
|
struct-helpers
|
|
)
|
|
|
|
(define (make-offsets* defs)
|
|
(let ((name-store (make-hash)))
|
|
|
|
(define (expand-type n t)
|
|
(if (= n 0)
|
|
'()
|
|
(cons t (expand-type (- n 1) t))))
|
|
|
|
(define (make-types defs idx)
|
|
(if (null? defs)
|
|
'()
|
|
(let ((d (car defs)))
|
|
(let ((t (if (list? d)
|
|
(if (symbol? (car d))
|
|
(let ((name (car d)))
|
|
(hash-set! name-store name (list idx (cadr d)))
|
|
(list 1 (cadr d)))
|
|
d)
|
|
(list 1 d))))
|
|
(append (expand-type (car t) (cadr t))
|
|
(make-types (cdr defs) (+ idx (car t))))))
|
|
))
|
|
|
|
(let ((offsets (compute-offsets (make-types defs 0))))
|
|
(let ((keys (hash-keys name-store))
|
|
(offs (make-hash)))
|
|
(for-each (λ (key)
|
|
(let* ((idx-t (hash-ref name-store key))
|
|
(idx (car idx-t))
|
|
(t (cadr idx-t)))
|
|
(hash-set! offs key (list (list-ref offsets idx) t))
|
|
)
|
|
)
|
|
keys)
|
|
offs))))
|
|
|
|
|
|
(define-syntax (make-offset stx)
|
|
(syntax-case stx ()
|
|
((_ (x t))
|
|
(cond
|
|
((number? (syntax->datum #'x)) #'(list x t))
|
|
(else #'(list 'x t))
|
|
)
|
|
)
|
|
((_ t)
|
|
#'(list 1 t))
|
|
)
|
|
)
|
|
|
|
(define-syntax make-offsets
|
|
(syntax-rules ()
|
|
((_ a ...)
|
|
(make-offsets* (list (make-offset a) ...)))))
|
|
|
|
(define-syntax def-cstruct
|
|
(syntax-rules ()
|
|
((_ name (t ...) offs)
|
|
(define-cstruct name
|
|
([t (cadr (hash-ref offs 't)) #:offset (car (hash-ref offs 't))]
|
|
...)))
|
|
)
|
|
)
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Internal structures for ffmpeg decoding
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-syntax def-struct-helpers
|
|
(syntax-rules ()
|
|
((_ (struct-get get struct-set set))
|
|
(begin
|
|
(define get struct-get)
|
|
(define set struct-set))
|
|
)
|
|
((_ (struct-get get))
|
|
(define get struct-get)
|
|
)
|
|
)
|
|
)
|
|
|
|
(define-syntax struct-helpers
|
|
(syntax-rules ()
|
|
((_ a ...)
|
|
(begin
|
|
(def-struct-helpers a)
|
|
...))))
|