From 4a6999e8411ee4c66fad60b8687843676010f192 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Fri, 9 Sep 2022 10:21:20 -0500 Subject: Refactor: combination functions use testiere --- gtwiwtg-test.lisp | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ gtwiwtg.lisp | 51 ++++++++++++++++++++++++++++++++++++--------------- 2 files changed, 84 insertions(+), 15 deletions(-) diff --git a/gtwiwtg-test.lisp b/gtwiwtg-test.lisp index 3fd3781..6ca4c97 100644 --- a/gtwiwtg-test.lisp +++ b/gtwiwtg-test.lisp @@ -4,6 +4,54 @@ (in-package :gtwiwtg-test) +(defun test-resumables () + (let ((foobar + (make-resumable! (range)))) + (take 10 foobar) + (setf foobar (resume! foobar)) + (assert (equal (take 10 foobar) + '(10 11 12 13 14 15 16 17 18 19))))) + +(defun test-inflate! () + (let* ((keys (seq '(:name :occupation :hobbies))) + (vals (seq '("Buckaroo Banzai" + "Rocker" + ("Neuroscience" "Particle Physics" "Piloting Fighter Jets"))))) + (assert + (equal (collect (inflate! #'seq (zip! keys vals))) + '(:name "Buckaroo Banzai" + :occupation "Rocker" + :hobbies ("Neuroscience" "Particle Physics" "Piloting Fighter Jets")))))) + +(defun test-concat! () + (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)))))) + +(defun test-merge! () + (assert (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)))))) + +(defun test-intersperse! () + (assert + (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")))))))) + (defun gtwiwtg::test-collect () (assert (equal '(1 2 3 4) (collect (range :from 1 :to 4 :inclusive t)))) (assert (equal '(1 2 3 4) (collect (range :from 1 :to 5)))) diff --git a/gtwiwtg.lisp b/gtwiwtg.lisp index 67ee209..e8256ff 100644 --- a/gtwiwtg.lisp +++ b/gtwiwtg.lisp @@ -372,7 +372,15 @@ The last generated value of the returned generator will be NIL. ;;; MODIFIERS and COMBINATORS -(defun make-resumable! (gen) +(defun resumablep (gen) + (typep gen 'resumable-generator! )) + +(defun can-be-resumed-p (gen) + (and (resumablep gen) + (not (slot-value gen 'already-resumed-p)) + (stopped-p gen))) + +(defun/t make-resumable! (gen) "Makes a generator resumable. > (defvar *foobar* (make-resumable! (range))) @@ -386,15 +394,15 @@ 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 + (assert (not (resumablep gen)) () "The generator is already resumable.") (sully-when-clean (list gen)) (make-instance 'resumable-generator! :wrapped gen)) -(defun can-be-resumed-p (gen) - (and (typep gen 'resumable-generator!) - (not (slot-value gen 'already-resumed-p)) - (stopped-p gen))) - -(defun resume! (resumable) +(defun/t resume! (resumable) "Resumes a resumable generator. Creates a new generator from RESUMABLE. @@ -417,6 +425,10 @@ 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))) + :end (assert (can-be-resumed-p resumable)) (setf (slot-value resumable 'already-resumed-p) t) (make-instance 'resumable-generator! :wrapped (slot-value resumable 'wrapped))) @@ -446,8 +458,6 @@ Error Conditions: (lambda () (dolist (g all-gens) (stop g)))))) - - (defun filter! (pred gen) "Creats a generator that generates the values of GEN for which PRED is non null. @@ -458,7 +468,7 @@ Error Condition: (make-instance 'filtered-generator! :predicate pred :source-generator gen)) -(defun inflate! (fn gen &key extra-cleanup) +(defun/t inflate! (fn gen &key extra-cleanup) "FN is expected to be a function that accepts elements of GEN and returns a new generator. @@ -486,6 +496,10 @@ 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 (sully-when-clean (list gen)) (if (not (has-next-p gen)) (progn @@ -516,7 +530,7 @@ Error Conditions: (when extra-cleanup (funcall extra-cleanup))))))) -(defun concat! (gen &rest gens) +(defun/t concat! (gen &rest gens) "Returns a generator that is the concatenation of the generators passed as arguments. @@ -524,6 +538,9 @@ 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 (sully-when-clean (cons gen gens)) (inflate! #'identity (seq (cons gen gens)) ;; in the case that not all arguments are consumed, @@ -540,7 +557,7 @@ Error Conditions: (zip! (range) gen)) -(defun merge! (comparator gen1 gen2 &rest gens) +(defun/t 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 @@ -564,6 +581,9 @@ 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 (let ((all-gens (list* gen1 gen2 gens))) (sully-when-clean all-gens) (from-thunk-until @@ -586,7 +606,7 @@ Error Conditions: (dolist (g all-gens) (stop g)))))) -(defun intersperse! (gen1 gen2 &rest gens) +(defun/t 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. @@ -611,6 +631,9 @@ Examples: (0 A 0 1 B -10 2 C -20 3 A -30 4 B -40) " + :tests + (:program test-intersperse!) + :end (inflate! #'seq (apply #'zip! gen1 gen2 gens))) (defun truncate! (n gen) @@ -655,8 +678,6 @@ Example: " (map! (lambda (x) (funcall fn x) x) gen)) - - ;;; CONSUMERS (defmacro with-generator ((var gen) &body body) -- cgit v1.2.3