summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--sly/records.scm41
1 files changed, 40 insertions, 1 deletions
diff --git a/sly/records.scm b/sly/records.scm
index a7e180d..3ac2fda 100644
--- a/sly/records.scm
+++ b/sly/records.scm
@@ -23,8 +23,12 @@
;;; Code:
(define-module (sly records)
+ #:use-module (srfi srfi-4)
#:use-module (srfi srfi-9)
- #:export (define-record-type*))
+ #:use-module (srfi srfi-9 gnu)
+ #:use-module (rnrs bytevectors)
+ #:export (define-record-type*
+ define-packed-f64-record-type))
(define-syntax-rule (define-record-type* type
constructor keyword-constructor
@@ -52,3 +56,38 @@ overridden."
(lambda* (#:key (inherit default-record)
(field (getter inherit)) ...)
(constructor field ...))))))
+
+;; A little hack until Guile can unbox fields in record types. ;)
+(define-syntax-rule (define-packed-f64-record-type <name>
+ constructor
+ box unbox
+ predicate?
+ (field index getter setter) ...)
+ (begin
+ (define-record-type <name>
+ (box bv)
+ predicate?
+ (bv unbox))
+
+ (set-record-type-printer! <name>
+ (lambda (obj port)
+ (display "<" port)
+ (display '<name> port)
+ (begin
+ (display " " port)
+ (display 'field port)
+ (display ": " port)
+ (display (getter obj) port))
+ ...
+ (display " >" port)))
+
+ (define-inlinable (constructor field ...)
+ (box (f64vector field ...)))
+
+ (define-inlinable (getter obj)
+ (f64vector-ref (unbox obj) index))
+ ...
+
+ (define-inlinable (setter obj value)
+ (f64vector-set! (unbox obj) index value))
+ ...))