diff options
| -rw-r--r-- | gtwiwtg.lisp | 231 | ||||
| -rw-r--r-- | package.lisp | 1 |
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 |