- (let* ((types (foreign-record-type-types name))
- (c-struct-pointer (make-c-struct types (list make-arg ...))))
- (make-foreign-record name c-struct-pointer)))
- (define (predicate? record)
- (and
- (foreign-record? record)
- (let* ((record-type (foreign-record-type record))
- (type-name (foreign-record-type-name record-type)))
- (equal? type-name (foreign-record-type-name name)))))
- (export name)
- (export make-name)
- (export predicate?)))))))
+ (wrap-record (make-c-struct (list type-id ...) (list make-arg ...))))
+
+ (define (getter record)
+ (let ((values (parse-c-struct (unwrap-record record) (list type-id ...))))
+ (list-ref values getter-id)))
+ ...
+
+ (define (setter record new-value)
+ (let* ((types (list type-id ...))
+ (type (list-ref types setter-id))
+ (len (sizeof type))
+ (offset (if (> setter-id 0)
+ (sizeof (list-head types setter-id))
+ 0))
+ (bv (pointer->bytevector (unwrap-record record) len offset 'u32)))
+ (bytevector-set! bv new-value type)
+ new-value))
+ ...))))))
+
+(define (bytevector-set! bv value type)
+ (let ((procedure
+ (cond
+ ((= type int8) bytevector-s8-set!)
+ ((= type int16) bytevector-s16-native-set!)
+ ((= type int32) bytevector-s32-native-set!)
+ ((= type int64) bytevector-s64-native-set!)
+ ((= type uint8) bytevector-u8-set!)
+ ((= type uint16) bytevector-u16-native-set!)
+ ((= type uint32) bytevector-u32-native-set!)
+ ((= type uint64) bytevector-u64-native-set!)
+ ((= type float) bytevector-ieee-single-native-set!)
+ ((= type double) bytevector-ieee-double-native-set!)
+ (else #f))))
+ (if procedure
+ (apply procedure bv 0 value '()))))