Major refactor. It's all OOPy now.

The purpose for this refactor was twofold.

First, I wanted to make stream-backed generators safer to use.

Second, I wanted to make all of the code shorter and easier to
understand.

This refactor certainly accomplishes the first, and hopefully the
second.

1 files changed, 232 insertions, 264 deletions

diff --git a/gtwiwtg.lisp b/gtwiwtg.lisp
index 3d03317..c0f5da5 100644
--- a/gtwiwtg.lisp
+++ b/gtwiwtg.lisp
@@ -1,44 +1,119 @@
 (defpackage #:gtwiwtg (:use #:cl))
 (in-package :gtwiwtg)
 
-(defclass generator! ()
-  ((dirty-p
-    :accessor dirty-p
-    :initform nil)
-   (state
-    :accessor gen-state
-    :initarg :state
-    :initform (error "no state"))
-   (next-p-fn
-    :accessor next-p-fn
-    :initarg :next-p-fn
-    :initform (error "no next-p"))
-   (next-fn
-    :accessor next-fn
-    :initarg :next-fn
-    :initform (error "no next-fn"))))
+;;; Generator Protocol ;;;
 
 (defgeneric next (gen)
   (:documentation "gets next if available. Throws an error otherwise."))
 
-(defmethod next ((gen generator!))
-  (assert (has-next-p gen))
-  (with-slots (state next-fn dirty-p) gen
-    (setf dirty-p t)
-    (multiple-value-bind (val new-state) (funcall next-fn state)
-      (setf state new-state)
-      val)))
-
 (defgeneric has-next-p (gen)
   (:documentation "returns true if next can be called on this generator!"))
 
-(defmethod has-next-p ((gen generator!))
-  (with-slots (next-p-fn state) gen
-    (funcall next-p-fn state)))
+(defgeneric stop (gen)
+  (:documentation "stops the generator"))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun make-keyword (symb)
+    (read-from-string (format nil ":~a" symb))))
+
+;;; Utility Class Builder ;;; 
+
+(defmacro a-class (name supers &rest slots)
+  `(defclass ,name ,supers
+     ,(mapcar (lambda (def)
+                 (if (consp def)
+                     `(,(car def)
+                        :initarg ,(make-keyword (car def))
+                        :initform ,(second def))
+                     `(,def :initarg ,(make-keyword def)
+                            :initform nil)))
+               slots)))
 
+;;; Base Generator Class ;;; 
+
+(defclass generator! ()
+  ((dirty-p
+    :accessor dirty-p
+    :initform nil
+    :documentation "Indicates whether or not this any of this
+    generator has been consumed, or should behave as if it has been.")
+   (stopped-p
+    :accessor stopped-p
+    :initform nil
+    :documentation "Indicates whether or not this generator has been
+    explicitly stopped.")))
+
+(defmethod stop ((g generator!))
+  (setf (stopped-p g) t))
 
 (defun make-dirty (g) (setf (dirty-p g) t))
 
+;;; Generator Classes ;;; 
+
+(a-class range-backed-generator! (generator!)
+         (at 0) to (by 1) inclusive (comparator #'<))
+
+(defmethod has-next-p ((g range-backed-generator!))
+  (with-slots (to current comparator by at stopped-p) g
+    (unless stopped-p
+      (or (not to)
+          (funcall comparator
+                   (+ by at)
+                   to)))))
+
+(defmethod next ((g range-backed-generator!))
+  (with-slots (at by) g
+    (incf at by)
+    at))
+
+(a-class sequence-backed-generator! (generator!)
+         sequence index)
+
+(defmethod has-next-p ((g sequence-backed-generator!))
+  (with-slots (stopped-p index sequence) g
+    (unless stopped-p
+      (< index (1- (length sequence))))))
+
+(defmethod next ((g sequence-backed-generator!))
+  (with-slots (index sequence) g
+    (incf index)
+    (elt sequence index)))
+
+(a-class thunk-backed-generator! (generator!)
+         next-p-fn
+         next-fn
+         stop-fn)
+
+(defmethod has-next-p ((g thunk-backed-generator!))
+  (with-slots (stopped-p next-p-fn) g
+    (unless stopped-p (funcall next-p-fn))))
+
+(defmethod next ((g thunk-backed-generator!))
+  (funcall (slot-value g 'next-fn)))
+
+(defmethod stop :after ((g thunk-backed-generator!))
+  (with-slots (stop-fn) g
+    (when stop-fn
+      (funcall stop-fn))))
+
+(a-class stream-backed-generator! (generator!)
+         stream reader)
+
+(defmethod has-next-p ((g stream-backed-generator!))
+  (with-slots (stopped-p stream) g
+    (unless stopped-p
+      (open-stream-p stream))))
+
+(defmethod next ((g stream-backed-generator!))
+  (with-slots (reader stream) g
+    (let ((read-value (funcall reader stream)))
+      (unless read-value
+        (close stream))
+      read-value)))
+
+(defmethod stop :after ((g stream-backed-generator!))
+  (close (slot-value g 'stream)))         
+
 ;;; CONSTRUCTORS
 
 (defun range (&key (from 0) to (by 1) inclusive)
@@ -72,70 +147,42 @@ If TO is NIL, then the generator produces an infinite sequence.
   (let ((comparator (if (plusp by)
                         (if inclusive #'<= #'<)
                         (if inclusive #'>= #'>))))
-    (make-instance 'generator!
-                   :state (list (- from by) to)
-                   :next-p-fn (lambda (state) (or (not to)
-                                                  (funcall comparator
-                                                           (+ by  (first state))
-                                                           (second state))))
-                   :next-fn (lambda (state)
-                              (incf (car state) by)
-                              (values (car state) state)))))
+    (make-instance 'range-backed-generator!
+                   :comparator comparator
+                   :inclusive inclusive
+                   :at (- from by)
+                   :to to
+                   :by by)))
 
 (defun times (n)
   "Shorthand for (RANGE :TO N)"
   (range :to n))
 
-(defun seq (sequence)
+
+(defun seq (sequence &key (start 0))
   "Turns a sequecne (a list, vector, string, etc) into a
 generator. The resulting generator will generate exactly the memebers
 of the sequence."
-  (make-instance 'generator!
-                 :state 0
-                 :next-p-fn (lambda (state)
-                              (< state (length sequence)))
-                 :next-fn (lambda (state)
-                            (let ((val (elt sequence state)))
-                              (values val (1+ state))))))
-
-(defun repeater (&rest args)
-  "Produces a generator that produces an infinite series consisting in
-the values passed as ARGS looped forever."
-  (make-instance 'generator!
-                 :state (copy-list args)
-                 :next-p-fn (constantly t)
-                 :next-fn (lambda (state)
-                            (if (cdr state)
-                                (values (car state) (cdr state))
-                                (values (car args) (copy-list (cdr args)))))))
-
-
-(defun noise (&optional (arg 1.0))
-  "Creates a generator that produces an infinite series of random
-  numbers that are the result of calling (RANDOM ARG)."
-  (make-instance 'generator!
-                 :state nil
-                 :next-p-fn (constantly t)
-                 :next-fn (lambda (state)
-                            (declare (ignore state))
-                            (values (random arg) nil))))
-
-
+  (make-instance 'sequence-backed-generator!
+                 :sequence sequence
+                 :index (1- start)))
 
 
-(defun from-thunk-until (thunk &optional (until (constantly nil)))
+(defun from-thunk-until (thunk &optional (until (constantly nil)) clean-up)
   "Creates a generator that produces a series of value by successively
 calling (FUNCALL THUNK).  The iterator stops whenever (FUNCALL UNTIL)
 is non null.
 
+If a CLEAN-UP thunk is supplied, it will be run after consumption of
+the new generator has finished. I.e. when passing this form to a
+consumer such as FOR, FOLD, COLLECT, etc.
+
 By default, UNTIL is the function (CONSTANTLY NIL). I.e. it will
 generate forever."
-  (make-instance 'generator!
-                 :state nil
-                 :next-p-fn (lambda (ignore) (declare (ignore ignore)) (not (funcall until)))
-                 :next-fn (lambda (ignore)
-                            (declare (ignore ignore))
-                            (values (funcall thunk) nil))))
+  (make-instance 'thunk-backed-generator! 
+                 :stop-fn clean-up
+                 :next-p-fn (complement until)
+                 :next-fn thunk))
 
 
 (defun from-thunk (thunk)
@@ -166,10 +213,10 @@ should be K, the number of arguments acepted by REC.
 
 Example
 
-> (let ((fibs (from-recurrence (lambda (n-1 n-2) (+ n-1 n-2)) 1 0)))
+> (let ((fibs (from-recurrence #'+ 1 0)))
      (take 10 fibs))
 
-(1 1 2 3 5 8 13 21 34 55)
+(1 2 3 5 8 13 21 34 55 89)
 
 "
   (let* ((history (cons n-1 n-m))
@@ -179,6 +226,24 @@ Example
                      nth))))
     (from-thunk thunk)))
 
+
+(defun repeater (&rest args)
+  "Produces a generator that produces an infinite series consisting in
+the values passed as ARGS looped forever."
+  (let ((state (copy-list args)))
+    (from-thunk
+     (lambda ()
+       (unless (car state)
+         (setf state (copy-list args)))
+       (pop state)))))
+
+
+(defun noise (&optional (arg 1.0))
+  "Creates a generator that produces an infinite series of random
+  numbers that are the result of calling (RANDOM ARG)."
+  (from-thunk (lambda () (random arg))))
+
+
 (defun from-input-stream (stream stream-reader)
   "Create a generator from a STREAM.
 
@@ -186,109 +251,57 @@ You must supply as STREAM-READER function that accepts the stream as
 its only argument and returns NIL if the stream has run out of input,
 Non-NIL otherwise.
 
-This function will close the stream when it reaches the end.
-
 A quirk is that the last value returned from this generator is NIL.
 
-Avoid using with TAKE or PICK-OUT as the file stream will not be closed.
-
-If you need to use TAKE or PICK-OUT or other consumers that will not
-consume the whole generator, you should evaluate the whole generator
-within an UNWIND-PROTECTing form like WITH-OPEN-FILE.
-
-e.g.
+Consumers of the new generator will ensure that the stream is properly
+closed..
 
-This is fine:
-
-(with-open-file (input \"hey.txt\")
-       (take 2 (from-input-stream
-                 input
-                 (lambda (s) (read-char s nil nil)))))
-(#\\h #\\e)
-
-But this isn't:
+Here is an example:
 
-(take 2 (from-input-stream
+ (take 2 (from-input-stream
           (open \"hey.txt\")
           (lambda (s) (read-char s nil nil))))
 
-(#\\h #\\e)
+ (#\\h #\\e)
+
 "
-  (make-instance 'generator!
-                 :state stream
-                 :next-p-fn #'open-stream-p
-                 :next-fn (lambda (stream)
-                            (let ((val (funcall stream-reader stream)))
-                              (if val
-                                  (values val stream)
-                                  (progn
-                                    (close stream)
-                                    (values nil stream)))))))
+  (make-instance 'stream-backed-generator!
+                 :stream stream
+                 :reader stream-reader))
 
 
 (defun file-lines (file)
   "Creates a generator that produces the lines of a file.  The stream
 to the file is closed when the generator finishes.
 
-FILE is either a path to a file, or is an open character input stream
-to a file.
+FILE is either a path to a file.
 
 Returns NIL on the last iteration.
 
-Avoid using with TAKE or PICK-OUT as the file stream will not be closed.
-
-If you need to use TAKE or PICK-OUT or other consumers that will not
-consume the whole generator, you should evaluate the whole generator
-within an UNWIND-PROTECTing form such as WITH-OPEN-FILE.
-
-See the documentation for FROM-INPUT-STREAM for an example of the
-distinction.
 "
-  (from-input-stream (if (streamp file) file (open file))
+  (from-input-stream (open file)
                      (lambda (stream) (read-line stream nil nil))))
 
 (defun file-chars (file)
   "Creates a generator that produces the characters of a file. The
 stream to the file is closed when the generator finishes.
 
-FILE is either a path to a file, or is an open character input stream
-to a file.
+FILE is either a path to a file.
 
 Returns NIL on the last iteration.
-
-Avoid using with TAKE or PICK-OUT as the file stream will not be closed.
-
-If you need to use TAKE or PICK-OUT or other consumers that will not
-consume the whole generator, you should evaluate the whole generator
-within an UNWIND-PROTECTing form such as WITH-OPEN-FILE.
-
-See the documentation for FROM-INPUT-STREAM for an example of the
-distinction.
-
 "
-  (from-input-stream (if (streamp file) file (open file))
+  (from-input-stream (open file)
                      (lambda (stream) (read-char stream nil nil))))
 
 (defun file-bytes (file)
   "Creates a generator that produces the bytes of a file. The
 stream to the file is closed when the generator finishes.
 
-FILE is either a path to a file, or is an open byte input stream to a
-file.
+FILE is either a path to a file.
 
 Returns NIL on the last iteration.
-
-Avoid using with TAKE or PICK-OUT as the file stream will not be closed.
-
-If you need to use TAKE or PICK-OUT or other consumers that will not
-consume the whole generator, you should evaluate the whole generator
-within an UNWIND-PROTECTing form such as WITH-OPEN-FILE.
-
-See the documentation for FROM-INPUT-STREAM for an example of the
-distinction.
 "
-  (from-input-stream (if (streamp file) file
-                         (open file :element-type '(unsigned-byte 8)))
+  (from-input-stream (open file :element-type '(unsigned-byte 8))
                      (lambda (stream) (read-byte stream nil nil))))
 
 ;;; Some utilities
@@ -314,7 +327,6 @@ distinction.
 (defun all-different (things)
   (= (length things) (length (remove-duplicates things))))
 
-
 (defun all-clean (gens)
   (every (complement #'dirty-p) gens))
 
@@ -323,35 +335,6 @@ distinction.
 
 ;;; MODIFIERS and COMBINATORS
 
-(defmethod yield-to! (gen1 gen2)
-  "GEN1 passes generation control to GEN2. This control will be return
-to GEN1 after GEN2 is done. This function modifies GEN1.
-
-Hence, YIELD-TO! can be used within an iteration to conditionally dive
-off into some new iteration, knowing that business as usuall will
-resume when the \"sub iteration\" finishes.
-
-It is kind of dark magic, and so I don't recommend using it except in
-the rareest of circumstances."
-  (assert (not (eq gen1 gen2)))
-  (make-dirty gen2)
-  (let ((orig-pred (next-p-fn gen1))
-        (orig-fn (next-fn gen1)))
-    (with-slots ((s1 state) (p1 next-p-fn) (f1 next-fn)) gen1
-      (with-slots ((s2 state) (p2 next-p-fn) (f2 next-fn)) gen2
-        (setf s1 (list s1 s2))
-        (setf p1 (lambda (state)
-                   (or (funcall p2 (second state))
-                       (funcall orig-pred (first state)))))
-        (setf f1 (lambda (state)
-                   (if (funcall p2 (second state))
-                       (multiple-value-bind (val new-s2) (funcall f2 (second state))
-                         (values val (list (first state) new-s2)))
-                       (multiple-value-bind (val new-s1) (funcall orig-fn (car state))
-                         (values val (list new-s1 (second state)))))))))))
-
-
-
 (defun map! (map-fn gen &rest gens)
   "Maps a function over a number of generators, returning a generator
 that produces values that result from calling MAP-FN on those
@@ -365,34 +348,17 @@ generators.
 Error Conditions:
  - If any of the generators compare EQL an error will be signalled
  - If any of the generators have been used elsewhere, an error will be signalled.
-
-Caveat: 
- - This function modifies and returns its first generator argument.
 "
-  (assert (all-good (list* gen gens)))
-  (dolist (g gens) (make-dirty g)) ;; to ensure gens wont be re-used after use here.
-
-  (let ((orig-fns (mapcar #'next-fn (cons gen gens)))
-        (orig-preds (mapcar #'next-p-fn (cons gen gens))))
-    (setf (gen-state gen) (mapcar #'gen-state (cons gen gens))
-          (next-p-fn gen) (lambda (states)
-                            (loop
-                               :for state :in states
-                               :for pred :in orig-preds
-                               :unless (funcall pred state) :do (return nil)
-                               :finally (return t)))
-          (next-fn gen) (lambda (states)
-                          (let ((args)
-                                (new-states))
-                            (loop
-                               :for state :in states
-                               :for fn :in orig-fns
-                               :do (multiple-value-bind (val new-state) (funcall fn state)
-                                     (push val args)
-                                     (push new-state new-states)))
-                            (values (apply map-fn (reverse args))
-                                    (reverse new-states))))))
-  gen)
+  (let ((all-gens (list* gen gens)))
+    (assert (all-good all-gens))
+    (dolist (g all-gens) (make-dirty g))
+    (from-thunk-until
+     (lambda ()
+       (apply map-fn (mapcar #'next all-gens)))
+     (lambda ()
+       (some (complement #'has-next-p) all-gens))
+     (lambda ()
+       (dolist (g all-gens) (stop g))))))
 
 (defun filter! (pred gen)
   "Produces a generator that filters out members of GEN that are NIL
@@ -400,37 +366,23 @@ when applied to PRED.
 
 Error Condition:
  - If GEN has been used elsewhere, an error will be signalled.
-
-Caveat:
- - This function modifies and returns its generator argument.
-
 "
   (assert (not (dirty-p 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))
+  (make-dirty gen)
+  (let (on-deck)
+    (from-thunk-until
+     (lambda () on-deck)
+     (lambda ()
+       (loop
+          :while (has-next-p gen)
+          :for candidate = (next gen)
+          :when (funcall pred candidate)
+          :do (progn
+                (setf on-deck candidate)
+                (return nil))
+          :finally (return t)))
+     (lambda ()
+       (stop gen)))))
 
 
 (defun inflate! (fn gen)
@@ -454,28 +406,29 @@ Here is an example:
 
 Error Conditions:
  - If GEN has been used elsewhere, an error will be signalled.
-
-Caveat: 
- - INFLATE! Modifies and returns its generator argument.
 "
   (assert (not (dirty-p gen)))
-  (let ((orig-fn (next-fn gen))
-        (orig-p (next-p-fn gen))
-        (orig-state (gen-state gen)))
-    (multiple-value-bind (val state) (funcall orig-fn orig-state)
-      (setf orig-state state
-            (gen-state gen) (funcall fn val)
-            (next-p-fn gen) (lambda (sub)
-                              (or (has-next-p sub)
-                                  (funcall orig-p orig-state)))
-            (next-fn gen) (lambda (sub)
-                            (if (has-next-p sub)
-                                (values (next sub) sub)
-                                (multiple-value-bind (val state) (funcall orig-fn orig-state)
-                                  (setf orig-state state)
-                                  (let ((new-sub (funcall fn val)))
-                                    (values (next new-sub) new-sub))))))))
-  gen)
+  (make-dirty gen)
+
+  (let ((sub-gen (funcall fn (next gen))))
+    (from-thunk-until
+     (lambda () (next sub-gen))
+
+     (lambda ()
+       (loop
+          :until (has-next-p sub-gen)
+          :while (has-next-p gen)
+          :do
+            (stop sub-gen)
+            (setf sub-gen (funcall fn (next gen))))
+
+       ;; the 'until' thunk must return t when we should stop generating
+       ;; hence:
+       (not (or (has-next-p sub-gen)
+                (has-next-p gen))))
+     (lambda ()
+       (stop gen)
+       (when sub-gen (stop sub-gen))))))
 
 
 (defun concat! (gen &rest gens)
@@ -493,7 +446,7 @@ Caveat:
  - CONCAT! Modifies and returns its first argument.
 "
   (assert (all-good (list* gen gens)))
-  (dolist (g gens) (make-dirty g)) ;; to help ensure that gens can be combined elsewhere
+  (dolist (g (list* gen gens)) (make-dirty g)) 
   (inflate! #'identity (seq (list* gen gens))))
 
 (defun zip! (gen &rest gens)
@@ -540,8 +493,12 @@ Error Conditions:
                               (nconc (when (cdr vals) (list (seq (cdr vals))))
                                      all-gens)))
          (car vals)))
+
      (lambda ()
-       (null all-gens)))))
+       (null all-gens))
+
+     (lambda ()
+       (dolist (g all-gens) (stop g))))))
 
 
 (defun skip! (n gen)
@@ -563,7 +520,7 @@ returns NIL."
   gen)
 
 
-(defun nfurcate! (count gen)
+(defun nfurcate! (count source-generator)
   "EXERIMENTAL. MAY BE REMOVED
 
 Return a list of COUNT copies of GEN.
@@ -576,26 +533,36 @@ Caveat:
    on infinite generators.
 
 "
-  (make-dirty gen)
-  (let ((qs (loop :for _ :below count :collect (make-queue))))
-    (loop :for build-q :in qs
+  (make-dirty source-generator)
+  (let ((qs (loop :for _ :below count :collect (make-queue)))
+        (stop-cells (loop :for _ :below count :collect (list nil))))
+    (loop
+       :for build-q :in qs
+       :for stop-cell :in stop-cells  
        :collect
-         (let ((local-q build-q))
+         (let ((local-q build-q)
+               (local-stop stop-cell))
+
            (from-thunk-until
             (lambda ()
               (cond ((not (queue-empty-p local-q))
                      (dequeue local-q))
 
-                    ((has-next-p gen)
-                     (let ((next-v (next gen)))
+                    ((has-next-p source-generator)
+                     (let ((next-v (next source-generator)))
                        (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))))))))
+              (and (not (has-next-p source-generator))
+                   (queue-empty-p local-q)))
+
+            (lambda ()
+              (setf (car local-stop) t)
+              (when (every #'car stop-cells)
+                (stop source-generator))))))))
 
 (defun partition! (pred gen)
   "EXPERIMENTAL. MAY BE REMOVED. 
@@ -634,8 +601,8 @@ procuded by GEN.
 
 Example:
 
-(for (x y) (zip! (repeater 'a 'b 'c) (times 5))
-  (format t \"~a -- ~a~%\" x y))
+ (for (x y) (zip! (repeater 'a 'b 'c) (times 5))
+   (format t \"~a -- ~a~%\" x y))
 
 A -- 0
 B -- 1
@@ -652,7 +619,8 @@ A -- 4
        (loop
           :while (has-next-p ,gen-var)
           :do
-            ,expr-body))))
+            ,expr-body)
+       (stop ,gen-var))))
 
 (defmacro fold ((acc init-val) (var-exp gen) expr)
   "The accumulating generator consumer.