Macros obtain* and obtain*-block.

* lisplib.c (yield_set_entries): Add obtain* and obtain*-block
to autoload list.

* share/txr/stdlib/yield.tl (obtain*, obtain*-block):
New macros.

* txr.1: Documented.

3 files changed, 89 insertions, 0 deletions

diff --git a/lisplib.c b/lisplib.c
index 9848db54..e2ad6ea3 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -262,6 +262,7 @@ static val yield_set_entries(val dlt, val fun)
 {
   val name[] = {
     lit("obtain"), lit("obtain-block"), lit("yield-from"), lit("yield"),
+    lit("obtain*"), lit("obtain*-block"),
     lit("suspend"),
     nil
   };
diff --git a/share/txr/stdlib/yield.tl b/share/txr/stdlib/yield.tl
index d3dac917..6bcf8a46 100644
--- a/share/txr/stdlib/yield.tl
+++ b/share/txr/stdlib/yield.tl
@@ -54,6 +54,18 @@
 (defmacro obtain-block (name . body)
   ^(obtain (block ,name ,*body)))
 
+(defmacro obtain* (. body)
+  (let ((arg (gensym "arg"))
+        (fun (gensym "fun")))
+    ^(let ((,fun (sys:obtain-impl (lambda (,arg)
+                                    (unless (eq ,arg 'sys:cont-free)
+                                      ,*body)))))
+       (call ,fun nil)
+       ,fun)))
+
+(defmacro obtain*-block (name . body)
+  ^(obtain* (block ,name ,*body)))
+
 (defmacro yield-from (:form ctx-form name : (form nil have-form-p))
   (let ((cont-sym (gensym)))
     ^(sys:capture-cont ',name
diff --git a/txr.1 b/txr.1
index b833f54f..725d7d58 100644
--- a/txr.1
+++ b/txr.1
@@ -30050,6 +30050,82 @@ In other words, the following equivalence holds:
   [f] -> nil
 .cble
 
+.coNP Macros @ obtain* and @ obtain*-block
+.synb
+.mets (obtain* << forms *)
+.mets (obtain*-block < name << forms *)
+.syne
+.desc
+The
+.code obtain*
+and
+.code obtain*-block
+macros implement a useful variation of
+.code obtain
+and
+.codn obtain-block .
+
+The
+.code obtain*
+macro differs from
+.code obtain
+in exactly one regard: prior to returning the function, it invokes
+it one time, with the argument value
+.codn nil .
+
+Thus, the following equivalence holds
+
+.cblk
+  (obtain* forms ...)   <-->  (let ((f (obtain forms ...)))
+                                (call f)
+                                f)
+.cble
+
+In other words, the suspended block is immediately resumed, so that it executes
+either to completion (in which case its value is discarded), or to its first
+.code yield
+or
+.code yield-from
+call (in which case the yielded value is discarded).
+
+Note: the
+.code obtain*
+macro is useful in creating suspensions which accept data rather than
+produce data.
+
+The
+.code obtain*-block
+macro combines
+.code obtain*
+and
+.code block
+in the same manner that
+.code obtain-block
+combines
+.code obtain
+and
+.codn block .
+
+.TP* Example:
+
+.cblk
+  ;; Pass three values into suspended block,
+  ;; which get accumulated into list.
+  (let ((f (obtain*-block nil
+             (list (yield nil) (yield nil) (yield nil)))))
+    (call f 1)
+    (call f 2)
+    (call f 3))  ->  (1 2 3)
+
+  ;; Under obtain, extra call is required:
+  (let ((f (obtain-block nil
+             (list (yield nil) (yield nil) (yield nil)))))
+    (call f nil)  ;; execute block to first yield
+    (call f 1)    ;; resume first yield with 1
+    (call f 2)
+    (call f 3))  ->  (1 2 3)
+.cble
+
 .coNP Macro @ suspend
 .synb
 .mets (suspend < block-name < var-name << body-form *)