Skip to content

Commit

Permalink
experimental nfurcate! and partition! transformers
Browse files Browse the repository at this point in the history
  • Loading branch information
loskool committed Jul 9, 2020
1 parent c4a87f4 commit 7abfc97
Show file tree
Hide file tree
Showing 2 changed files with 47 additions and 0 deletions.
45 changes: 45 additions & 0 deletions gtwiwtg.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -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))))

Expand Down Expand Up @@ -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)
Expand Down
2 changes: 2 additions & 0 deletions package.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,8 @@
#:merge!
#:skip!
#:skip-while!
#:nfurcate!
#:partition!
#:for
#:fold
#:collect
Expand Down

0 comments on commit 7abfc97

Please sign in to comment.