2022-01-08: Lisp Sequences

There is a neat paper by Christophe Rhodes about creating sequences in (Steel Bank) Common Lisp.

User-extensible sequences in Common Lisp

Whats the paper about? In Lisp we have a limited number of sequences... typically lists, vectors and maybe hashtables? Unsure... but either way there are a bunch of things that we can treat as standard sequences and have a standard way of dealing with (e.g. counting, reducing and the like).

What if you want to add new data structures to these methods? You'd hope it was all some CLOS-ish generic interface but hey all these things were standardised before CLOS so we're straight out of luck... but if we'll forgo a *little* portability...

The sequences API described in that paper gives us exactly what we want.

Given an arbitrary CLOS data-structure we can define methods in the `sb-sequence` package for:

- sequence:length

- sequence:elt

- (setf sequence:elt)

- sequence:adjust-sequence

- sequence:make-sequence-like

...and bingo we get the rest of the normal sequency-methods for free. The SBCL implementors even went and bound some other methods like `some` into this namespace so that we can even override the ones that normally wouldn't be given to us but that we would like to use.

Yes you could do this more easily in Java/Haskell/whatever, but I find Lisp programming to be a uniquely joyous experience. Having little things to drag the language to the 21st century... makes it easier you know? Makes me smile.

Heres an (admittedly broken) example... examples alwaiys help no? I create a new `simple-set` data type (that wraps a list) and then define all the methods. And it all just works (but it doesn't... I should fix that... try `reversing` something). Lisp Makes me happy.

(defclass simple-set (sequence standard-object)
  ((data :accessor set-data
         :initform nil
         :initarg :data)
   (test :accessor set-test
         :initform #'eql
         :initarg :test)))

(defmethod print-object ((obj simple-set) stream)
  (print-unreadable-object (obj stream :type t)
    (format stream "~{~A~^ ~}" (set-data obj))))

(defun add (obj set)
  "Adds the OBJ to the SET."
  (unless (member obj (set-data set)
                  :test (set-test set))
    (push obj (set-data set))))

(defun cleanup (set)
  "Clean up a SETs internal data structure."
  (setf (set-data set) (remove-duplicates (set-data set)
                                          :test (set-test set))))

(defun make-set (&rest of)
  (let ((set (make-instance 'simple-set)))
    (dolist (obj of set)
      (add obj set))))

(defmethod sb-sequence:length ((obj simple-set))
  (length (set-data obj)))

(defmethod sb-sequence:elt ((obj simple-set) index)
  (elt (set-data obj) index))

(defmethod (setf sb-sequence:elt) (new-value (obj simple-set) index)
  (setf
   (elt (set-data obj) index)
   new-value))

(defmethod sb-sequence:adjust-sequence ((obj simple-set) length
                                        &key
                                          (initial-element nil initial-element-p)
                                          (initial-contents nil initial-contents-p))
  (apply #'sb-sequence:make-sequence-like
         `(,obj
           ,@(when initial-element-p (list :initial-element initial-element))
           ,@(when initial-contents-p (list :initial-contents initial-contents)))))

(defun replicate (obj times)
  "Make a sequence of TIMES OBJ."
  (loop repeat times collecting obj))

(defmethod sb-sequence:make-sequence-like ((obj simple-set)
                                           length
                                           &key
                                             (initial-element nil initial-element-p)
                                             (initial-contents nil initial-contents-p))
  (let ((new (make-instance 'simple-set :test (set-test obj) :data (replicate nil length))))
    (cond
      (initial-element-p (add initial-element new))
      (initial-contents-p (dolist (o initial-contents) (add o new)))
      (:otherwise (dolist (o (set-data obj)) (add o new))))
    new))