sequence: add initiate-sequence

Add `initiate-sequence`, which is a helper function to construct a thunk for `make-do-sequence`.
racket · Sep 24, 2023 · eddb38d · eddb38d
1 parent 652da1a
commit eddb38d
Show file tree

Hide file tree

Showing 3 changed files with 77 additions and 3 deletions.
diff --git a/pkgs/racket-doc/scribblings/reference/sequences.scrbl b/pkgs/racket-doc/scribblings/reference/sequences.scrbl
@@ -764,7 +764,10 @@ each element in the sequence.
   and the @defterm{element}, which may consist of multiple values.
 
   The @racket[thunk] procedure must return either six or seven values.
-  If it returns six values:
+  However, use @racket[initiate-sequence] to return these multiple values,
+  as opposed to listing the values directly.
+
+  If @racket[thunk] returns six values:
   @itemize[
     @item{The first result is a @racket[_pos->element] procedure that
       takes the current position and returns the value(s) for the
@@ -1104,7 +1107,7 @@ If @racket[min-count] is a number, the stream is required to have at least that
 
 }
 
-@subsubsection{Additional Sequence Constructors}
+@subsubsection{Additional Sequence Constructors and Functions}
 
 @defproc[(in-syntax [stx syntax?]) sequence?]{
   Produces a sequence whose elements are the successive subparts of
@@ -1129,6 +1132,40 @@ If @racket[min-count] is a number, the stream is required to have at least that
   @history[#:added "6.3"]
 }
 
+@defproc[(initiate-sequence
+          [#:pos->element pos->element (any/c . -> . any)]
+          [#:early-next-pos early-next-pos (or/c (any/c . -> . any) #f) #f]
+          [#:next-pos next-pos (any/c . -> . any/c)]
+          [#:init-pos init-pos any/c]
+          [#:continue-with-pos? continue-with-pos? (or/c (any/c . -> . any/c) #f) #f]
+          [#:continue-with-val? continue-with-val? (or/c (any/c ... . -> . any/c) #f) #f]
+          [#:continue-after-pos+val? continue-after-pos+val? (or/c (any/c any/c ... . -> . any/c) #f) #f])
+         (values (any/c . -> . any)
+                 (or/c (any/c . -> . any) #f)
+                 (any/c . -> . any/c)
+                 any/c
+                 (or/c (any/c . -> . any/c) #f)
+                 (or/c (any/c ... . -> . any/c) #f)
+                 (or/c (any/c any/c ... . -> . any/c) #f))]{
+  Returns values suitable for the thunk argument in @racket[make-do-sequence].
+  See @racket[make-do-sequence] for the meaning of each argument.
+
+  @examples[#:eval sequence-evaluator
+    (define (in-alt-list xs)
+      (make-do-sequence
+       (λ ()
+         (initiate-sequence
+          #:pos->element car
+          #:next-pos (λ (xs) (cdr (cdr xs)))
+          #:init-pos xs
+          #:continue-with-pos? pair?
+          #:continue-after-pos+val? (λ (xs _) (pair? (cdr xs)))))))
+    (sequence->list (in-alt-list '(1 2 3 4 5 6)))
+    (sequence->list (in-alt-list '(1 2 3 4 5 6 7)))
+  ]
+  @history[#:added "8.10.0.5"]
+}
+
 
 @; ======================================================================
 @section[#:tag "streams"]{Streams}

diff --git a/pkgs/racket-test-core/tests/racket/sequence.rktl b/pkgs/racket-test-core/tests/racket/sequence.rktl
@@ -279,4 +279,25 @@
 
 ;; ----------------------------------------
 
+;; initiate-sequence
+
+(define (in-alt-list xs)
+  (make-do-sequence
+   (λ ()
+     (initiate-sequence
+      #:pos->element car
+      #:next-pos (λ (xs) (cdr (cdr xs)))
+      #:init-pos xs
+      #:continue-with-pos? pair?
+      #:continue-after-pos+val? (λ (xs _) (pair? (cdr xs)))))))
+
+    (sequence->list (in-alt-list '(1 2 3 4 5 6 7)))
+
+(test '() 'initiate-sequence (sequence->list (in-alt-list '())))
+(test '(1) 'initiate-sequence (sequence->list (in-alt-list '(1))))
+(test '(1) 'initiate-sequence (sequence->list (in-alt-list '(1 2))))
+(test '(1 3) 'initiate-sequence (sequence->list (in-alt-list '(1 2 3))))
+(test '(1 3 5) 'initiate-sequence (sequence->list (in-alt-list '(1 2 3 4 5 6))))
+(test '(1 3 5 7) 'initiate-sequence (sequence->list (in-alt-list '(1 2 3 4 5 6 7))))
+
 (report-errs)
diff --git a/racket/collects/racket/sequence.rkt b/racket/collects/racket/sequence.rkt
@@ -30,7 +30,8 @@
          sequence-count
          (rename-out [-sequence/c sequence/c])
          in-syntax
-         (contract-out [in-slice (exact-positive-integer? sequence? . -> . any)]))
+         (contract-out [in-slice (exact-positive-integer? sequence? . -> . any)])
+         initiate-sequence)
 
 (define empty-sequence
   (make-do-sequence
@@ -421,3 +422,18 @@
       #f
       (λ (val) (pair? val))
       #f))))
+
+(define (initiate-sequence #:pos->element pos->element
+                           #:early-next-pos [early-next-pos #f]
+                           #:next-pos next-pos
+                           #:init-pos init-pos
+                           #:continue-with-pos? [continue-with-pos? #f]
+                           #:continue-with-val? [continue-with-val? #f]
+                           #:continue-after-pos+val? [continue-after-pos+val? #f])
+  (values pos->element
+          early-next-pos
+          next-pos
+          init-pos
+          continue-with-pos?
+          continue-with-val?
+          continue-after-pos+val?))