add receive-ct

5 files changed, 21 insertions, 1 deletions

diff --git a/cond-thunk.egg b/cond-thunk.egg
index 2cbe3e4..469f237 100644
--- a/cond-thunk.egg
+++ b/cond-thunk.egg
@@ -1,5 +1,5 @@
 ((author "Peter McGoron")
- (version "0.2.2")
+ (version "0.2.3")
  (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 4067594..df514f1 100644
--- a/doc/mcgoron.cond-thunk.values.scm
+++ b/doc/mcgoron.cond-thunk.values.scm
@@ -30,6 +30,12 @@ For each clause,
 Once all clauses succeed, the `after` clause returns a thunk containing
 body. The free variables bound in and surrounding the `after` expression
 are captured in the thunk."))
+ ((name . "receive-ct")
+  (signature syntax-rules () (_ formal generator body ...))
+  (desc "
+If `generator` returns no values, the whole expression returns no values.
+Otherwise bind the values made by `generator` to `formal` and return
+`body ...` as a thunk."))
  ((name . "cond-values")
   (signature syntax-rules () (cond-values clauses ...))
   (desc "
diff --git a/mcgoron.cond-thunk.values.scm b/mcgoron.cond-thunk.values.scm
index 2daffdb..03cae5b 100644
--- a/mcgoron.cond-thunk.values.scm
+++ b/mcgoron.cond-thunk.values.scm
@@ -49,6 +49,12 @@
      (let ((abort (lambda () #f)))
        (%after abort %lambda (clauses ...) body ...)))))
 
+(define-syntax receive-ct
+  (syntax-rules ()
+    ((receive-ct formal generator body ...)
+     (after ((let generator => formal))
+       body ...))))
+
 (define-syntax apply-after
   (syntax-rules ()
     ((apply-after producer consumer)
diff --git a/mcgoron.cond-thunk.values.sld b/mcgoron.cond-thunk.values.sld
index 5597eea..d30a234 100644
--- a/mcgoron.cond-thunk.values.sld
+++ b/mcgoron.cond-thunk.values.sld
@@ -19,6 +19,7 @@
   (export after apply-after
           cond-values
           define-record-type/destructor
+          receive-ct
           pair=>
           length-at-least=> length=>)
   (cond-expand
diff --git a/tests/values.scm b/tests/values.scm
index ef14907..c81b8aa 100644
--- a/tests/values.scm
+++ b/tests/values.scm
@@ -119,6 +119,13 @@
           (list a b c d))
         (else 'else)))
 
+(test "receive-ct 1"
+      #t
+      (cond-values
+        (receive-ct (x y) (length=> '(1 2) 2)
+          #t)
+        (else #f)))
+
 (test "on-fail 1"
       5
       (cond-thunk