experimental nfurcate! and partition! transformers

1 files changed, 45 insertions, 0 deletions

diff --git a/gtwiwtg.lisp b/gtwiwtg.lisp
index 1fbf825..93a7922 100644
--- a/gtwiwtg.lisp
+++ b/gtwiwtg.lisp
@@ -293,6 +293,24 @@ distinction.
 
 ;;; Some utilities
 
+(defun make-queue ()
+  (cons nil nil))
+
+(defun enqueue (x q) 
+  (push x (car q)))
+
+(defun dequeue (q)
+  (when (and (car q) (null (cdr q)))
+    (setf (cdr q) (reverse (car q))
+          (car q) nil))
+  (when (cdr q) (pop (cdr q))))
+             
+(defun queue-empty-p (q)
+  (and (null (car q))
+       (null (cdr q))))
+
+;;; Some assertion tests
+
 (defun all-different (things)
   (= (length things) (length (remove-duplicates things))))
 
@@ -545,6 +563,33 @@ returns NIL."
   gen)
 
 
+(defun nfurcate! (count gen)
+  (make-dirty gen)
+  (let ((qs (loop :for _ :below count-if :collect (make-queue))))
+    (loop :for build-q :in qs
+       :collect
+         (let ((local-q build-q))
+           (from-thunk-until
+            (lambda ()
+              (cond ((not (queue-empty-p local-q))
+                     (dequeue local-q))
+
+                    ((has-next-p gen)
+                     (let ((next-v (next gen)))
+                       (loop :for q :in qs :do (enqueue next-v q))
+                       (dequeue local-q)))
+
+                    (t (error "Attempted to get next from a spent generator."))))
+
+            (lambda ()
+              (and (not (has-next-p gen))
+                   (queue-empty-p local-q))))))))
+
+(defun partition! (pred gen)
+  (destructuring-bind (gen1 gen2) (nfurcate! 2 gen)
+    (list (filter! pred gen1)
+          (filter! (complement pred) gen2))))
+
 ;;; CONSUMERS
 
 (defmacro for (var-exp gen &body body)