Water’s series, using producing

Posting for the memory book.  Appendix A in the Common Lisp manual is a package Richard Water’s created known as series.  A series is a kind of hybrid between sequences (think lists) and streams.  They are cool because the resulting code is damn fast; usually compiling down to raw loops.  In anycase I had more trouble writing the following than I expected.  I kept writing setf rather than setq; which creates some bizarre errors.  Errors printing results actually.  It would also be good if I’d actually read the doc for producing, rather than just skimming it, for any given FOO or BAR the (next-in FOO ...) and (next-out BAR ...) forms should appear once and only once.    You get extra points if they appear at the start or tail of the tagbody respectively.

In this example we want to inhale two series nibbling off one or the other as appropriate.  Series a pain to use when doing this kind of mingling; but mostly because they don’t have a way to seek forward more rapidly than pulling items off the inputs one at a time.  What also makes them painful to use at this level is that you have to write at a level that is enjoyably only because it invokes a nostalgia for assembler language.  No doubt it one was writing a lot of his kind of code then you’d make a micro language that compiles into this pseudo assembler.  The series sources do something along those lines; making them wonderfully hard to read.

I’m really not fluent in using this package, so critiques from more expert users would be welcome.


(defun union-integer-series (s1 s2)
  "Given two ascending series of integers return a series of those integers
    which appear in both."
  (declare (optimizable-series-function)
                    (series s1 s2))
  (producing (items) ((g1 s1) (g2 s2) i1 (i1-ok nil) i2 (i2-ok nil))
      (loop
            (tagbody
                  --TOP--

                  (if i1-ok (go --I1-OK--))
                  (setq i1 (next-in g1 (terminate-producing)))
                  (setf i1-ok t)
                  --I1-OK--

                  (if i2-ok (go --I2-OK--))
                  (setq i2 (next-in g2 (terminate-producing)))
                  (setf i2-ok t)
                  --I2-OK--

                  (unless (= i1 i2)
                      (cond
                          ((< i1 i2)
                            (setq i1-ok nil))
                          (t
                            (setq i2-ok nil)))
                      (go --TOP--))

                  (setq i1-ok nil)
                  (setq i2-ok nil)
                  (next-out items i1)
                ))))

By example

> (setf *print-length* 7)
7
> (scan-range :from 5)
#Z(5 6 7 8 9 10 11 ...)
> (scan-range :upto 9)
#Z(0 1 2 3 4 5 6 ...)
> (union-integer-series * **)
#Z(5 6 7 8 9)
> 

Leave a Reply

Your email address will not be published. Required fields are marked *