diff options
| -rw-r--r-- | cond-thunk.egg | 2 | ||||
| -rw-r--r-- | doc/mcgoron.cond-thunk.values.scm | 7 | ||||
| -rw-r--r-- | mcgoron.cond-thunk.values.scm | 7 | ||||
| -rw-r--r-- | mcgoron.cond-thunk.values.sld | 3 | ||||
| -rw-r--r-- | tests/values.scm | 10 |
5 files changed, 26 insertions, 3 deletions
diff --git a/cond-thunk.egg b/cond-thunk.egg index 2cce087..66ae093 100644 --- a/cond-thunk.egg +++ b/cond-thunk.egg @@ -1,5 +1,5 @@ ((author "Peter McGoron") - (version "0.2.4") + (version "0.2.5") (synopsis "macros for abstracting conditional branches") (category "lang-exts") (license "Apache-2.0") diff --git a/doc/mcgoron.cond-thunk.values.scm b/doc/mcgoron.cond-thunk.values.scm index df514f1..e2c2d5a 100644 --- a/doc/mcgoron.cond-thunk.values.scm +++ b/doc/mcgoron.cond-thunk.values.scm @@ -84,4 +84,9 @@ each field of the record as declared in the `field-spec`. Otherwise it returns no values. Note that the destructor will always return no values for a record type -that has no fields.")))
\ No newline at end of file +that has no fields.")) + ((name "evaluate-destructor-to-boolean") + (signature syntax-rules () ((_ expr))) + (desc " +Evaluates the destructor `expr`. If `expr` returns no values, return `#f`. +Otherwise return `#t`.")))
\ No newline at end of file diff --git a/mcgoron.cond-thunk.values.scm b/mcgoron.cond-thunk.values.scm index 03cae5b..2833de4 100644 --- a/mcgoron.cond-thunk.values.scm +++ b/mcgoron.cond-thunk.values.scm @@ -113,3 +113,10 @@ (after ((when (predicate? record))) (values (accessor record) ...)))))))) +(define-syntax evaluate-destructor-to-boolean + (syntax-rules () + ((_ destructor) + (case-receive destructor + (() #f) + (_ #t))))) + diff --git a/mcgoron.cond-thunk.values.sld b/mcgoron.cond-thunk.values.sld index d30a234..620f5c2 100644 --- a/mcgoron.cond-thunk.values.sld +++ b/mcgoron.cond-thunk.values.sld @@ -21,7 +21,8 @@ define-record-type/destructor receive-ct pair=> - length-at-least=> length=>) + length-at-least=> length=> + evaluate-destructor-to-boolean) (cond-expand (chicken (import (mcgoron cond-thunk srfi 210 compat))) (else (import (srfi 210)))) diff --git a/tests/values.scm b/tests/values.scm index c81b8aa..cea402d 100644 --- a/tests/values.scm +++ b/tests/values.scm @@ -78,6 +78,16 @@ tail) (else #f))) +(test + "evaluate-destructor-to-boolean 1" + #t + (evaluate-destructor-to-boolean (pair=> '(1)))) + +(test + "evaluate-destructor-to-boolean 2" + #f + (evaluate-destructor-to-boolean (pair=> 1))) + (test-assert "length-at-least=> 1" (cond-values |