aboutsummaryrefslogtreecommitdiffhomepage
path: root/gtwiwtg.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'gtwiwtg.lisp')
-rw-r--r--gtwiwtg.lisp43
1 files changed, 25 insertions, 18 deletions
diff --git a/gtwiwtg.lisp b/gtwiwtg.lisp
index 1f46c9a..413fce0 100644
--- a/gtwiwtg.lisp
+++ b/gtwiwtg.lisp
@@ -363,6 +363,30 @@ Error Conditions:
(lambda ()
(dolist (g all-gens) (stop g))))))
+(defclass filtered-generator (generator!)
+ ((on-deck :initform (list))
+ (source-generator :initform (error "filtered generator must have a source")
+ :initarg :source)
+ (predicate :initform (error "filtered generator must have a predicate")
+ :initarg :predicate)))
+
+(defmethod next ((gen filtered-generator))
+ (pop (slot-value gen 'on-deck)))
+
+(defmethod has-next-p ((gen filtered-generator))
+ (with-slots (source-generator predicate on-deck) gen
+ (or on-deck
+ (loop :while (has-next-p source-generator)
+ :for candidate = (next source-generator)
+ :when (funcall predicate candidate)
+ :do (push candidate on-deck)
+ (return t)
+ :finally (return nil)))))
+
+(defmethod stop :after ((gen filtered-generator))
+ (stop (slot-value gen 'source-generator)))
+
+
(defun filter! (pred gen)
"Creats a generator that generates the values of GEN for which PRED is non null.
@@ -370,24 +394,7 @@ Error Condition:
- If GEN has been used elsewhere, an error will be signalled.
"
(sully-when-clean (list gen))
- (let (on-deck)
- (from-thunk-until
- (lambda () on-deck) ; consumers always call has-next-p before next
-
- :until
- (lambda ()
- (loop
- :while (has-next-p gen)
- :for candidate = (next gen)
- :when (funcall pred candidate)
- :do (progn
- (setf on-deck candidate)
- (return nil)) ; Don't stop generating, we found one
- :finally (return t))) ; Stop generating, we can't find one.
-
- :clean-up
- (lambda ()
- (stop gen)))))
+ (make-instance 'filtered-generator :predicate pred :source gen))
(defun inflate! (fn gen &key extra-cleanup)