git.fiddlerwoaroof.com
wrapped-sequence.lisp
800a03e0
 (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"))
 
1310d70f
 (defgeneric key (tagged-sequence))
 (defgeneric invert-key (tagged-sequence))
 (defclass tagged-sequence (standard-object
                            org.shirakumo.trivial-extensible-sequences:sequence)
   ((%underlying-sequence :initarg :underlying :accessor underlying)))
800a03e0
 
1310d70f
 
 
 (defmethod org.shirakumo.trivial-extensible-sequences:length
     ((sequence tagged-sequence))
800a03e0
   (length (underlying sequence)))
 
1310d70f
 (defmethod org.shirakumo.trivial-extensible-sequences:elt
     ((sequence tagged-sequence) index)
800a03e0
   (funcall (key sequence)
            (elt (underlying sequence)
                 index)))
 
1310d70f
 (defmethod (setf org.shirakumo.trivial-extensible-sequences:elt)
     (new-value (sequence tagged-sequence) index)
800a03e0
   (setf (elt (underlying sequence)
              index)
         (funcall (invert-key sequence)
                  (elt (underlying sequence)
                       index)
                  new-value)))
 
1310d70f
 (defmethod org.shirakumo.trivial-extensible-sequences:adjust-sequence
     ((sequence tagged-sequence) length
      &rest r
      &key initial-element initial-contents)
800a03e0
   (declare (ignore initial-element initial-contents))
1310d70f
   (unless (slot-boundp sequence '%underlying-sequence)
     (setf (underlying sequence) ()))
   (fw.lu:prog1-bind (it (make-instance (class-of sequence)
                                        :underlying (apply
                                                     #'org.shirakumo.trivial-extensible-sequences:adjust-sequence
                                                     (copy-seq (underlying sequence)) length
                                                     r)))
     (describe it)))
 
 (defmethod org.shirakumo.trivial-extensible-sequences:make-sequence-like
800a03e0
     ((sequence tagged-sequence) length &rest r)
1310d70f
   (apply #'org.shirakumo.trivial-extensible-sequences:adjust-sequence
          sequence length r))
 
 (defun wrap-sequence (class seq)
   (make-instance class
                  :underlying seq))