updated to use testiere 1.0

2 files changed, 140 insertions, 92 deletions

diff --git a/gtwiwtg.lisp b/gtwiwtg.lisp
index e8256ff..a058ae1 100644
--- a/gtwiwtg.lisp
+++ b/gtwiwtg.lisp
@@ -1,5 +1,7 @@
 (in-package :gtwiwtg)
 
+(declaim (optimize (speed 3)))
+
 ;;; Generator Protocol ;;;
 
 ;; None of the following are meant to be called directly by users of the library.
@@ -45,7 +47,7 @@
   (defun make-keyword (symb)
     (intern (symbol-name symb) 'keyword)))
 
-(defmacro a-generator-class (name supers &rest slots)
+(defmacro a-generator-class (name supers &body slots)
   `(defclass ,name ,(cons 'generator! supers)
      ,(mapcar (lambda (def)
                  (if (consp def)
@@ -59,7 +61,7 @@
 ;;; Generator Classes ;;; 
 
 (a-generator-class range-backed-generator! ()
-         (at 0) to (by 1) (comparator #'<))
+  (at 0) to (by 1) (comparator #'<))
 
 (defmethod has-next-p ((g range-backed-generator!))
   (with-slots (to comparator by at) g
@@ -74,7 +76,7 @@
     at))
 
 (a-generator-class sequence-backed-generator! ()
-         sequence index)
+  sequence index)
 
 (defmethod has-next-p ((g sequence-backed-generator!))
   (with-slots (index sequence) g
@@ -86,7 +88,7 @@
     (elt sequence index)))
 
 (a-generator-class list-backed-generator! ()
-         list)
+  list)
 
 (defmethod has-next-p ((g list-backed-generator!))
   (consp (slot-value g 'list)))
@@ -95,9 +97,9 @@
   (pop (slot-value g 'list)))
 
 (a-generator-class thunk-backed-generator! ()
-         next-p-fn
-         next-fn
-         stop-fn)
+  next-p-fn
+  next-fn
+  stop-fn)
 
 (defmethod has-next-p ((g thunk-backed-generator!))
   (funcall (slot-value g 'next-p-fn) ))
@@ -111,7 +113,7 @@
       (funcall stop-fn))))
 
 (a-generator-class stream-backed-generator! ()
-         stream reader)
+  stream reader)
 
 (defmethod has-next-p ((g stream-backed-generator!))
   (open-stream-p (slot-value g 'stream)))
@@ -127,9 +129,9 @@
   (close (slot-value g 'stream)))         
 
 (a-generator-class filtered-generator! ()
-                   (on-deck (list))
-                   (source-generator (error "filtered generator must have a source"))
-                   (predicate (error "filtered generator must have a predicate")))
+  (on-deck (list))
+  (source-generator (error "filtered generator must have a source"))
+  (predicate (error "filtered generator must have a predicate")))
 
 (defmethod next ((gen filtered-generator!))
   (pop (slot-value gen 'on-deck)))
@@ -149,8 +151,8 @@
 
 
 (a-generator-class resumable-generator! ()
-                   already-resumed-p
-                   (wrapped (error "Resumable generators must wrap another generator")))
+  already-resumed-p
+  (wrapped (error "Resumable generators must wrap another generator")))
 
 (defmethod next ((gen resumable-generator!))
   (next (slot-value gen 'wrapped)))
@@ -188,8 +190,6 @@ E.g.
 If TO is NIL, then the generator produces an infinite series of
 values.
 "
-  :tests
-  :end
   (let ((comparator (if (plusp by)
                         (if inclusive #'<= #'<)
                         (if inclusive #'>= #'>))))
@@ -380,7 +380,7 @@ The last generated value of the returned generator will be NIL.
         (not (slot-value gen 'already-resumed-p))
         (stopped-p gen)))
 
-(defun/t make-resumable! (gen)
+(defun make-resumable! (gen)
   "Makes a generator resumable. 
 
 > (defvar *foobar* (make-resumable! (range)))
@@ -394,15 +394,19 @@ The last generated value of the returned generator will be NIL.
 > (take 10 *foobar*)
 (10 11 12 13 14 15 16 17 18 19)
 "
-  :tests
-  (:program test-resumables)
-  (:fails ((make-resumable! (range))))  ; cannot make a resumable resumable
-  :end
+  #+testiere
+  (:tests
+   (:let ((rr (make-resumable! (range))))
+     (:do (take 10 rr))
+     (:do (setf rr (resume! rr)))
+     (equal (take 10 rr)
+            '(10 11 12 13 14 15 16 17 18 19)))
+   (:fails (make-resumable! (make-resumable! (range)))))
   (assert (not (resumablep gen)) () "The generator is already resumable.")
   (sully-when-clean (list gen))
   (make-instance 'resumable-generator! :wrapped gen))
 
-(defun/t resume! (resumable)
+(defun resume! (resumable)
   "Resumes a resumable generator.  Creates a new generator from
 RESUMABLE.  
 
@@ -425,9 +429,14 @@ once. Here is how you would resume a generator several times:
 ;; but *new-foobar* can be resumed
 > (setf *new-foobar* (resume! *new-foobar*))
 "
-  :tests
-  (:program test-resumables)
-  (:fails ((times 10)))
+  #+testiere
+  (:tests
+   (:let ((rr (make-resumable! (range))))
+     (:do (take 10 rr))
+     (:do (setf rr (resume! rr)))
+     (equal (take 10 rr)
+            '(10 11 12 13 14 15 16 17 18 19)))
+   (:fails (resume! (times 10))))
   :end
   (assert (can-be-resumed-p resumable))
   (setf (slot-value resumable 'already-resumed-p) t)
@@ -468,7 +477,7 @@ Error Condition:
   (make-instance 'filtered-generator! :predicate pred :source-generator gen))
 
 
-(defun/t inflate! (fn gen &key extra-cleanup)
+(defun inflate! (fn gen &key extra-cleanup)
   "FN is expected to be a function that accepts elements of GEN and
 returns a new generator.  
 
@@ -496,10 +505,19 @@ Here is an example:
 Error Conditions:
  - If GEN has been used elsewhere, an error will be signalled.
 "
-  :tests
-  (:program test-inflate!)
-  (:fails (#'cons (times 10)))          ; cons does not return an iterator
-  :end
+  #+testiere
+  (:tests
+   (:let ((keys
+            (seq '(:name :occupation :hobbies)))
+          (vals
+            (seq '("Buckaroo Banzai"
+                   "Rocker"
+                   ("Neuroscience" "Particle Physics" "Piloting Fighter Jets")))))
+     (equal
+      (collect (inflate! #'seq (zip! keys vals)))
+      '(:name "Buckaroo Banzai"
+        :occupation "Rocker"
+        :hobbies ("Neuroscience" "Particle Physics" "Piloting Fighter Jets")))))
   (sully-when-clean (list gen))  
   (if (not (has-next-p gen))
       (progn
@@ -530,7 +548,7 @@ Error Conditions:
            (when extra-cleanup (funcall extra-cleanup)))))))
 
 
-(defun/t concat! (gen &rest gens)
+(defun concat! (gen &rest gens)
   "Returns a generator that is the concatenation of the generators
 passed as arguments.
 
@@ -538,9 +556,13 @@ Error Conditions:
  - If any of the generators compare EQL, an error will be signalled.
  - If any of the generators has been used elsewhere, an error will be sigalled.
 "
-  :tests
-  (:program test-concat!)
-  :end
+  #+testiere
+  (:tests
+   (equal
+    '(1 2 3 a b c :e :f :g)
+    (collect (concat! (range :from 1 :to 4)
+                      (seq '(a b c))
+                      (seq '(:e :f :g))))))
   (sully-when-clean (cons gen gens))
   (inflate! #'identity (seq (cons gen gens))
             ;; in the case that not all arguments are consumed,
@@ -557,7 +579,7 @@ Error Conditions:
   (zip! (range) gen))
 
 
-(defun/t merge! (comparator gen1 gen2 &rest gens)
+(defun merge! (comparator gen1 gen2 &rest gens)
   "Emulates the behavior of MERGE (in the ANSI standard), but for generators.
 
 The emulation is not perfect, but it holds in the following sense: If
@@ -581,9 +603,15 @@ 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.
 "
-  :tests
-  (:program test-merge!)
-  :end
+  #+testiere
+  (:tests
+   (equal
+    '(-10 -4 0 1 2 2 3 4 6 8 8 14 20 26)
+    (collect
+        (merge! #'<
+                (times 4)
+                (range :from 4 :to 10 :by 2)
+                (range :from -10 :to 28 :by 6)))))
   (let ((all-gens (list* gen1 gen2 gens)))
     (sully-when-clean all-gens)
     (from-thunk-until
@@ -606,7 +634,7 @@ Error Conditions:
        (dolist (g all-gens) (stop g))))))
 
 
-(defun/t intersperse! (gen1 gen2 &rest gens)
+(defun intersperse! (gen1 gen2 &rest gens)
   "Produces a generator that intersperses one value from each of its
 argument generators, one after the other, until any of those
 generators run out of values.
@@ -631,9 +659,18 @@ Examples:
 
  (0 A 0 1 B -10 2 C -20 3 A -30 4 B -40)
  "
-  :tests
-  (:program test-intersperse!)
-  :end
+  #+testiere
+  (:tests
+   (equal
+    '(:NAME "buckaroo banzai" :JOB "rocker" :HOBBIES
+      ("neuroscience" "particle physics" "flying fighter jets"))
+    (collect 
+        (intersperse! (seq '(:name :job :hobbies))
+                      (seq '("buckaroo banzai" 
+                             "rocker" 
+                             ("neuroscience" 
+                              "particle physics"
+                              "flying fighter jets")))))))
   (inflate! #'seq (apply #'zip! gen1 gen2 gens)))
 
 (defun truncate! (n gen)
@@ -784,33 +821,42 @@ Example: building data
        (setf ,acc ,expr))
      ,acc))
 
-(defun/t collect (gen)
+(defun collect (gen)
   "Consumes GEN by collecting its values into a list."
-  :tests
-  (:program test-collect)
-  :end
+  #+testiere
+  (:tests
+   (equal '(1 2 3 4) (collect (range :from 1 :to 4 :inclusive t)))   
+   (equal '(1 2 3 4) (collect (range :from 1 :to 5)))
+   (equal '((1 #\a) (2 #\b) (3 #\c))
+          (collect (zip! (range :from 1) (seq "abc"))))
+   (:is (null (collect (seq ())))))
   (nreverse (fold (xs nil) (x gen) (cons x xs))))
 
-(defun/t take (n gen)
+(defun take (n gen)
   "Consumes GEN by collecting its first N values into a list"
-  :tests
-  (:program test-take)
-  :end
+  #+testiere
+  (:tests
+   (:is (null (take 100 (seq ""))))
+   (equal '() (take 10 (seq "asdf")))
+   (equal '(#\a #\b #\c) (take 100 (seq "abc")))
+   (equal '(#\a #\b) (take 2 (seq "abcdefg"))))
   (nreverse (fold (xs nil) (x (zip! gen (times n)))
                   (cons (car x) xs))))
 
-(defun/t pick-out (indexes gen)
+(defun pick-out (indexes gen)
   "Consumes GEN by picking out certain members by their index.
 
 INDEXES is a list of non-negative integers.
 
 Returns a list of values from GEN such that each value was an element
 of indexes."
-  :tests
-  (:program test-pick-out)
-  (:fails (() (range)))                 ; index list cannot be null
-  (:fails ('(-10) (range)))             ; indices cannot be negative
-  :end
+  #+testiere
+  (:tests
+   (equal '(101) (pick-out '(101)  (range)))
+   (equal '(40 30 20)
+          (pick-out '(3 2 1) (range :from 10 :by 10)))
+   (:fails (pick-out () (range)))                 ; index list cannot be null
+   (:fails (pick-out '(-10) (range))))             ; indices cannot be negative
   (assert (notany #'minusp indexes))
   (let ((acc (make-array (length indexes))))
     (for (x idx) (zip! gen (times (1+ (apply #'max indexes))))
@@ -822,42 +868,41 @@ of indexes."
            :do (setf (aref acc i) x))))
     (concatenate 'list acc)))
 
-(defun/t size (gen)
+(defun size (gen)
   "Consumes GEN by calculating its size."
-  :tests
-  (= ((seq nil)) 0)
-  (= ((range :to 3)) 3)
-  :end
+  #+testiere
+  (:tests
+   (= 0 (size (seq nil)))
+   (= 3 (size (range :to 3))))
   (fold (n 0) (x (map! (constantly 1) gen)) (+ n x)))
 
-(defun/t maximum (gen)
+(defun best (chooser gen)
+  "Consumes GEN. CHOOSER is a function of two arguments that returns one
+of them. Returns the member of GEN that is consistently chosen.
+Chooser should be transitive. Returns NIL if GEN is empty."
+  #+testiere
+  (:tests
+   (= 4 (best #'max (range :to 5)))
+   (= 5 (best #'max (range :to 5 :inclusive t))))
+  (when (has-next-p gen)
+    (fold (b (next gen)) (x gen)
+          (funcall chooser b x))))
+
+(defun maximum (gen)
   "Consumes GEN, returning its maximum value."
-  :tests
-  (= ((range :to 5)) 4)
-  (= ((range :to 5 :inclusive t)) 5)
-  (= ((range :from -10 :to 0 :by 3)) -1)
-  (:fails ((seq "hey")))
-  :end
-  (fold (m nil) (x gen)
-        (if m (max m x) x)))
+  (best #'max gen))
 
-(defun/t minimum (gen)
+(defun minimum (gen)
   "Consumes GEN, returning its minimum value."
-  :tests
-  (= ((range :to 5)) 0)
-  (= ((range :from -10 :to 0 :by 3)) -10)
-  (:fails ((seq "hey")))
-  :end
-  (fold (m nil) (x gen)
-        (if m (min m x) x)))
+  (best #'min gen))
 
-(defun/t average (gen)
+(defun average (gen)
   "Consumes GEN, returning its average value."
-  :tests
-  (= ((range :from 1 :to 4 :inclusive t)) 5/2)
-  (:signals ((seq nil)) division-by-zero) ; empty sum signals division by zero
-  (:fails ((seq "foo")))                  ; numeric sequences only
-  :end
+  #+testiere
+  (:tests
+   (= 5/2 (average (range :from 1 :to 4 :inclusive t)))
+   (:signals division-by-zero (average (seq nil))) 
+   (:fails (average (seq "foo"))))                  
   (let ((sum 0)
         (count 0))
     (for x gen
@@ -865,12 +910,14 @@ of indexes."
       (incf count))
     (/ sum count)))
 
-(defun/t argmax (fn gen)
+(defun argmax (fn gen)
   "Consumes GEN. Returns a pair (X . VALUE) such that (FUNCALL FN X)
 is maximal among the values of GEN.  VALUE is the value of (FUNCALL FN X)"
-  :tests
-  (:program test-argmax)
-  :end 
+  #+testiere
+  (:tests
+   (equal '(-10 . 100)
+          (argmax (lambda (x) (* x x))
+                  (seq '(1 -10 3 4 -4)))))
   (fold (am nil)
         (arg gen)
         (let ((val (funcall fn arg)))
@@ -878,12 +925,14 @@ is maximal among the values of GEN.  VALUE is the value of (FUNCALL FN X)"
               (cons arg val)
               am))))
 
-(defun/t argmin (fn gen)
+(defun argmin (fn gen)
     "Consumes GEN. Returns a pair (X . VALUE) such that (FUNCALL FN X)
 is minimal among the values of GEN.  VALUE is the value of (FUNCALL FN X)"
-  :tests
-  (:program test-argmin)
-  :end
+  #+testiere
+  (:tests
+   (equal '(1 . 1)
+          (argmin (lambda (x) (* x x))
+                  (seq '(1 -10 3 4 -4)))))
   (fold (am nil)
         (arg gen)
         (let ((val (funcall fn arg)))
diff --git a/package.lisp b/package.lisp
index c771b82..b6efe86 100644
--- a/package.lisp
+++ b/package.lisp
@@ -2,7 +2,6 @@
 
 (defpackage #:gtwiwtg
   (:use #:cl)
-  (:import-from #:testiere #:defun/t)
   (:export #:range
            #:times
            #:seq