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:
parent
3908019bbc
commit
a38170a25b
2 changed files with 82 additions and 46 deletions
87
goof.scm
87
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 ...)
|
||||
|
|
|
@ -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))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue