define-record-type/destructor

1 files changed, 16 insertions, 0 deletions

diff --git a/mcgoron.cond-thunk.values.scm b/mcgoron.cond-thunk.values.scm
index ca4469a..8330ba1 100644
--- a/mcgoron.cond-thunk.values.scm
+++ b/mcgoron.cond-thunk.values.scm
@@ -74,3 +74,19 @@
                             (when-ct (null? rest)
                               (apply values whole-list)))))
 
+(define-syntax define-record-type/destructor
+  (syntax-rules ()
+    ((_ type-name cstr predicate? destructor=>
+        (arg-name accessor . rest)
+        ...)
+     (begin
+       (define-record-type type-name
+         str
+         predicate?
+         (arg-name accessor . rest)
+         ...)
+       (define (destructor=> record)
+         (cond-values
+           (after ((when (predicate? record)))
+             (values (accessor record) ...))))))))
+