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.
This commit is contained in:
Linus 2021-05-11 09:48:21 +02:00
parent 3908019bbc
commit a38170a25b
2 changed files with 82 additions and 46 deletions

View file

@ -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 ...)

View file

@ -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))))