data-lens/wrapped-sequence.lisp

(defpackage :data-lens.wrapped-sequence
  (:use :cl )
  (:export ))
(in-package :data-lens.wrapped-sequence)

(defgeneric underlying (wrapper)
  (:documentation "Return the underlying object of a wrapper"))

(defclass tagged-sequence (standard-object sequence)
  ((%underlying-sequence :initarg :underlying :accessor underlying)
   (%key-fn :initarg :key :reader key)
   (%invert-key :initarg :invert-key :reader invert-key)))

(defmethod sb-sequence:length ((sequence tagged-sequence))
  (length (underlying sequence)))

(defmethod sb-sequence:elt ((sequence tagged-sequence) index)
  (funcall (key sequence)
           (elt (underlying sequence)
                index)))

(defmethod (setf sb-sequence:elt) (new-value (sequence tagged-sequence) index)
  (setf (elt (underlying sequence)
             index)
        (funcall (invert-key sequence)
                 (elt (underlying sequence)
                      index)
                 new-value)))

(defmethod sb-sequence:adjust-sequence ((sequence tagged-sequence) length
                                        &rest r
                                        &key initial-element initial-contents)
  (declare (ignore initial-element initial-contents))
  (make-instance 'tagged-sequence
                 :underlying (apply #'sb-sequence:adjust-sequence
                                    (copy-seq (underlying sequence)) length
                                    r)
                 :key-fn (key sequence)
                 :invert-key (invert-key sequence)))

(defmethod sb-sequence:make-sequence-like
    ((sequence tagged-sequence) length &rest r)
  (apply #'sb-sequence:adjust-sequence sequence length r))

(defun wrap-sequence (seq key-fn invert-key-fn)
  (if invert-key-fn
      (make-instance 'tagged-sequence
                     :underlying seq
                     :key key-fn
                     :invert-key invert-key-fn)
      (make-instance 'tagged-sequence
                     :underlying seq
                     :key key-fn)))