From a38170a25b16587bc1d4eb60e552f2b9ee1c79c2 Mon Sep 17 00:00:00 2001
From: Linus <bjornstam.linus@fastmail.se>
Date: Tue, 11 May 2021 09:48:21 +0200
Subject: [PATCH] Added stop-after and stop-before

These are equivalent to their racket for loop counterparts, and creates
an iterator that signals exhaustion befor or after yielding a value
where a predicate returns true. Not useful in non-nested loops, but
could be useful in inner loops where you want to exit to an outerloop
instead of :break-ing.

Also fixed some bugs in other generator clauses.
---
 goof.scm           | 87 ++++++++++++++++++++++++----------------------
 goof/iterators.scm | 41 +++++++++++++++++++---
 2 files changed, 82 insertions(+), 46 deletions(-)

diff --git a/goof.scm b/goof.scm
index 6a2172a..fda7b9b 100644
--- a/goof.scm
+++ b/goof.scm
@@ -32,57 +32,57 @@
 (define-module (goof)
   #:use-module (goof helpers)
   #:use-module (goof ref-let)
-  #:use-module (rnrs io simple)
+  #:use-module ((rnrs io simple) #:select (eof-object))
   #:use-module ((srfi srfi-1) #:select (any circular-list find))
   #:use-module ((srfi srfi-43) #:select (vector-copy vector-copy!))
   #:use-module (srfi srfi-71)
   #:use-module (ice-9 futures)
   #:export (loop
-            
-            loop/list
-            loop/sum
-            loop/product
-            loop/first
-            loop/last
-            loop/and
-            loop/or
-            loop/list/parallel
-            
-            :when :unless :break :final :let :let* :subloop :for :acc
-            :length :fill
-            :to :by
+               loop/list
+             loop/sum
+             loop/product
+             loop/first
+             loop/last
+             loop/and
+             loop/or
+             loop/list/parallel
 
-            in
-            in-list
-            in-lists
+             :when :unless :break :final :let :let* :subloop :for :acc
+             :length :fill
+             :to :by
 
-            in-vector in-reverse-vector
-            in-string in-reverse-string
-            in-hash
+             in
+             in-list
+             in-lists
 
-            in-port
-            in-file
-            in-generator
-            up-from
-            down-from
-            accumulating
-            folding
-            listing
-            listing-reverse
-            appending
-            appending-reverse
-            summing
-            multiplying
-            hashing
-            vectoring
+             in-vector in-reverse-vector
+             in-string in-reverse-string
+             in-hash
 
-            ;; generator clauses
-            in-cycle
-            in-indexed
+             in-port
+             in-file
+             in-generator
+             up-from
+             down-from
+             accumulating
+             folding
+             listing
+             listing-reverse
+             appending
+             appending-reverse
+             summing
+             multiplying
+             hashing
+             vectoring
+
+             ;; generator clauses
+             in-cycle
+             in-indexed
+             stop-before
+             stop-after
+             ;; Syntax for adding clauses
+             register-loop-clause))
 
-            ;; Syntax for adding clauses
-            register-loop-clause
-            ))
 
 
 ;; This contains the portable parts of goof-loop.
@@ -104,6 +104,8 @@
                                                 ;; generator clauses
                                                 #'in-cycle
                                                 #'in-indexed
+                                                #'stop-before
+                                                #'stop-after
                                                 )))
 (define valid-acc-clauses (make-parameter (list #'folding
                                                 #'listing
@@ -177,6 +179,9 @@
 
 (define-syntax inner-recur
   (syntax-rules ()
+    ;; If we have no final tests, don't bother producing the code. The guile
+    ;; inliner/DCE stops trying to do more work if the loop is very deep
+    ;; meaning in deeply nested loops, we could end up producing slow code.
     ((_ loop-name final-fun () ((v s) ...))
      (loop-name s ...))
     ;; This is somewhat of an ugly thing. We want to test (or user-finals ...)
diff --git a/goof/iterators.scm b/goof/iterators.scm
index 8fc5b86..cfca749 100644
--- a/goof/iterators.scm
+++ b/goof/iterators.scm
@@ -244,7 +244,7 @@
 
 (define-syntax in-generator
   (syntax-rules ()
-    ((_ :for ((var) (source)) next . rest)
+    ((_ :for ((var) source) next . rest)
      (next ((gen source))
            ((var (gen) (gen)))
            ((eof-object? var))
@@ -307,7 +307,7 @@
 
 (define-syntax in-hash
   (syntax-rules ()
-    ((in-hash :for ((bindings) (expr)) n . rest)
+    ((in-hash :for ((bindings) expr) n . rest)
      (n
       ()
       ((cursor (hash-map->list cons expr) (cdr cursor)))
@@ -472,7 +472,7 @@
         
 (define-syntax in-cycle
   (syntax-rules ()
-    ((_ ((id) (source)) n . rest)
+    ((_ :for ((id) (source)) n . rest)
      (n ((gen (generator-cycle source)))
         ()
         ()
@@ -492,11 +492,42 @@
               (cons index res)))))))
 
 (define-syntax in-indexed
-  (syntax-rules ()
-    ((_ ((binding) (source)) n . rest)
+  (syntax-rules (:for)
+    ((_ :for ((binding) (source)) n . rest)
      (n ((gen (generator-indexed source)))
         ((i (gen) (gen)))
         ((eof-object? i))
         ((binding i))
         ()
         . rest))))
+
+(define (stop-before-generator gen pred)
+  (lambda ()
+    (let ((v (gen)))
+      (if (pred v)
+          (eof-object)
+          v))))
+
+(define (stop-after-generator gen pred)
+  (let ((done? #f))
+    (lambda ()
+      (if done?
+          (eof-object)
+          (let ((v (gen)))
+            (when (pred v)
+              (set! done? #t))
+            v)))))
+
+
+(define-syntax stop-before
+  (syntax-rules (:for)
+    ((_ :for ((binding) (source pred)) n . rest)
+     (in-generator :for ((binding) (stop-before-generator source pred)) n . rest))
+    ((_ expr pred)
+     (stop-before-generator expr pred))))
+
+(define-syntax stop-after
+  (syntax-rules (:for)
+    ((_ :for ((binding) (source pred)) n . rest)
+     (in-generator :for ((binding) (stop-after-generator source pred)) n . rest))
+    ((_ expr pred) (stop-after-generator expr pred))))