aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--gtwiwtg.lisp231
-rw-r--r--package.lisp1
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