From 0793b603b564c1f188db999704358f82f6e2d25b Mon Sep 17 00:00:00 2001
From: Colin Okay <cbeok@protonmail.com>
Date: Tue, 7 Jul 2020 18:45:19 -0500
Subject: fiddling

---
 gtwiwtg.lisp | 65 ++++++++++++++++++++++++++++++------------------------------
 1 file changed, 33 insertions(+), 32 deletions(-)

(limited to 'gtwiwtg.lisp')

diff --git a/gtwiwtg.lisp b/gtwiwtg.lisp
index acf8fe1..b8cb63a 100644
--- a/gtwiwtg.lisp
+++ b/gtwiwtg.lisp
@@ -98,32 +98,31 @@
   gen)
 
 (defun filter! (pred gen)
-  (let ((orig-fn (next-fn gen))
-        (orig-p-fn (next-p-fn gen)))
-    (setf (next-fn gen) (labels ((recurse (state) 
-                                   (multiple-value-bind (val next-state) (funcall orig-fn state)
-                                     (if (funcall pred val)
-                                         (values val next-state)
-                                         (if ()) (recurse next-state)))))))))
-
-(defun chain! (gen-of-gen)
-  (let ((orig-fn (next-fn gen-of-gen))
-        (orig-p (next-p-fn gen-of-gen))
-        (orig-state (gen-state gen-of-gen)))
-    (multiple-value-bind (subgen state) (funcall orig-fn orig-state)
-      (setf orig-state state)
-      (setf (gen-state gen-of-gen) subgen)
-      (setf (next-p-fn gen-of-gen)
-            (lambda (sub) (or (has-next-p sub)
-                              (funcall orig-p orig-state))))
-      (setf (next-fn gen-of-gen)
-            (lambda (sub)
-              (if (has-next-p sub)
-                  (values (next sub) sub)
-                  (multiple-value-bind (next-sub state) (funcall orig-fn orig-state)
-                    (setf orig-state state)
-                    (values (next next-sub) next-sub))))))
-    gen-of-gen))
+  (let* ((orig-fn (next-fn gen))
+         (orig-p-fn (next-p-fn gen))
+         (last-good nil)
+         (last-known-state (gen-state gen))
+         (new-next-p-fn (lambda (state)
+                          (or last-good
+                              (loop :while (funcall orig-p-fn state)
+                                 :do (multiple-value-bind (val new-state) (funcall orig-fn state)
+                                       (if (funcall pred val)
+                                           (progn  (setf last-good (list val))
+                                                   (setf last-known-state (list new-state))
+                                                   (return t))
+                                           (setf state new-state)))
+                                 :finally (return nil))))))
+
+    (setf (next-p-fn gen) new-next-p-fn)
+
+    (setf (next-fn gen) (lambda (state)
+                          (declare (ignore state))
+                          (let ((tmp-state (car last-known-state))
+                                (tmp-val (car last-good)))
+                            (setf last-good nil)
+                            (setf last-known-state nil)
+                            (values tmp-val tmp-state))))
+    gen))
 
 
 (defun bind! (fn gen)
@@ -148,12 +147,6 @@
 
 
 (defun thread-through (elem vec)
-  "Returns a generator! of vectors. Each vector is 1+ longer than
-VEC. Each vector looks just like VEC except ELEM is inserted in one
-position.  Returns (1+ (length VEC)) such vectors.
-
-NB: The memory is shared between generated vectors. If you must keep
-that memory around, copy the vector somehow. "
   (let ((target (concatenate 'vector vec (list elem)))) ;; reusable buffer
     (flet ((fill-and-insert (idx) ;; inserts elem into target at idx,
                                   ;; fills rest with vec
@@ -193,3 +186,11 @@ permutations one at a time."
           :do
             ,expr-body))))
 
+(defmacro fold ((fold-var init-val) (var-exp gen) expr)
+  `(let ((,fold-var ,init-val))
+     (iter (,var-exp ,gen)
+       (setf ,fold-var ,expr))
+     ,fold-var))
+
+(defun collect (gen)
+  (nreverse (fold-into (xs nil) (x gen) (cons x xs))))
-- 
cgit v1.2.3