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)
|
(define-module (goof)
|
||||||
#:use-module (goof helpers)
|
#:use-module (goof helpers)
|
||||||
#:use-module (goof ref-let)
|
#: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-1) #:select (any circular-list find))
|
||||||
#:use-module ((srfi srfi-43) #:select (vector-copy vector-copy!))
|
#:use-module ((srfi srfi-43) #:select (vector-copy vector-copy!))
|
||||||
#:use-module (srfi srfi-71)
|
#:use-module (srfi srfi-71)
|
||||||
#:use-module (ice-9 futures)
|
#:use-module (ice-9 futures)
|
||||||
#:export (loop
|
#:export (loop
|
||||||
|
loop/list
|
||||||
loop/list
|
loop/sum
|
||||||
loop/sum
|
loop/product
|
||||||
loop/product
|
loop/first
|
||||||
loop/first
|
loop/last
|
||||||
loop/last
|
loop/and
|
||||||
loop/and
|
loop/or
|
||||||
loop/or
|
loop/list/parallel
|
||||||
loop/list/parallel
|
|
||||||
|
|
||||||
:when :unless :break :final :let :let* :subloop :for :acc
|
|
||||||
:length :fill
|
|
||||||
:to :by
|
|
||||||
|
|
||||||
in
|
:when :unless :break :final :let :let* :subloop :for :acc
|
||||||
in-list
|
:length :fill
|
||||||
in-lists
|
:to :by
|
||||||
|
|
||||||
in-vector in-reverse-vector
|
in
|
||||||
in-string in-reverse-string
|
in-list
|
||||||
in-hash
|
in-lists
|
||||||
|
|
||||||
in-port
|
in-vector in-reverse-vector
|
||||||
in-file
|
in-string in-reverse-string
|
||||||
in-generator
|
in-hash
|
||||||
up-from
|
|
||||||
down-from
|
|
||||||
accumulating
|
|
||||||
folding
|
|
||||||
listing
|
|
||||||
listing-reverse
|
|
||||||
appending
|
|
||||||
appending-reverse
|
|
||||||
summing
|
|
||||||
multiplying
|
|
||||||
hashing
|
|
||||||
vectoring
|
|
||||||
|
|
||||||
;; generator clauses
|
in-port
|
||||||
in-cycle
|
in-file
|
||||||
in-indexed
|
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.
|
;; This contains the portable parts of goof-loop.
|
||||||
|
@ -104,6 +104,8 @@
|
||||||
;; generator clauses
|
;; generator clauses
|
||||||
#'in-cycle
|
#'in-cycle
|
||||||
#'in-indexed
|
#'in-indexed
|
||||||
|
#'stop-before
|
||||||
|
#'stop-after
|
||||||
)))
|
)))
|
||||||
(define valid-acc-clauses (make-parameter (list #'folding
|
(define valid-acc-clauses (make-parameter (list #'folding
|
||||||
#'listing
|
#'listing
|
||||||
|
@ -177,6 +179,9 @@
|
||||||
|
|
||||||
(define-syntax inner-recur
|
(define-syntax inner-recur
|
||||||
(syntax-rules ()
|
(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 final-fun () ((v s) ...))
|
||||||
(loop-name s ...))
|
(loop-name s ...))
|
||||||
;; This is somewhat of an ugly thing. We want to test (or user-finals ...)
|
;; This is somewhat of an ugly thing. We want to test (or user-finals ...)
|
||||||
|
|
|
@ -244,7 +244,7 @@
|
||||||
|
|
||||||
(define-syntax in-generator
|
(define-syntax in-generator
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
((_ :for ((var) (source)) next . rest)
|
((_ :for ((var) source) next . rest)
|
||||||
(next ((gen source))
|
(next ((gen source))
|
||||||
((var (gen) (gen)))
|
((var (gen) (gen)))
|
||||||
((eof-object? var))
|
((eof-object? var))
|
||||||
|
@ -307,7 +307,7 @@
|
||||||
|
|
||||||
(define-syntax in-hash
|
(define-syntax in-hash
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
((in-hash :for ((bindings) (expr)) n . rest)
|
((in-hash :for ((bindings) expr) n . rest)
|
||||||
(n
|
(n
|
||||||
()
|
()
|
||||||
((cursor (hash-map->list cons expr) (cdr cursor)))
|
((cursor (hash-map->list cons expr) (cdr cursor)))
|
||||||
|
@ -472,7 +472,7 @@
|
||||||
|
|
||||||
(define-syntax in-cycle
|
(define-syntax in-cycle
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
((_ ((id) (source)) n . rest)
|
((_ :for ((id) (source)) n . rest)
|
||||||
(n ((gen (generator-cycle source)))
|
(n ((gen (generator-cycle source)))
|
||||||
()
|
()
|
||||||
()
|
()
|
||||||
|
@ -492,11 +492,42 @@
|
||||||
(cons index res)))))))
|
(cons index res)))))))
|
||||||
|
|
||||||
(define-syntax in-indexed
|
(define-syntax in-indexed
|
||||||
(syntax-rules ()
|
(syntax-rules (:for)
|
||||||
((_ ((binding) (source)) n . rest)
|
((_ :for ((binding) (source)) n . rest)
|
||||||
(n ((gen (generator-indexed source)))
|
(n ((gen (generator-indexed source)))
|
||||||
((i (gen) (gen)))
|
((i (gen) (gen)))
|
||||||
((eof-object? i))
|
((eof-object? i))
|
||||||
((binding i))
|
((binding i))
|
||||||
()
|
()
|
||||||
. rest))))
|
. 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