diff options
| author |  Peter McGoron
| 2024-12-29 17:41:04 -0500 |
|---|---|---|
| committer | Peter McGoron
| 2024-12-29 17:41:04 -0500 |
| commit | f761933a5b480d51ae009c3d6b6bfb83bd440e08 (patch) | |
| tree | c3beee4d924328ffd5c3e70b84c0387ceca88d3b | |
| parent | generalize generated files (diff) | |
define-record-type/destructor
| -rw-r--r-- | mcgoron.cond-thunk.values.scm | 16 | ||||
| -rw-r--r-- | mcgoron.cond-thunk.values.sld | 1 |
2 files changed, 17 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) ...)))))))) + diff --git a/mcgoron.cond-thunk.values.sld b/mcgoron.cond-thunk.values.sld index 55f5b22..5597eea 100644 --- a/mcgoron.cond-thunk.values.sld +++ b/mcgoron.cond-thunk.values.sld @@ -18,6 +18,7 @@ (import (scheme base) (mcgoron cond-thunk)) (export after apply-after cond-values + define-record-type/destructor pair=> length-at-least=> length=>) (cond-expand |