fiddlerwoaroof/data-lens
1
0
Fork 0
mirror of https://github.com/fiddlerwoaroof/data-lens.git synced 2025-11-08 10:16:32 +00:00
Code Issues Releases Wiki Activity

refactor(wrapped-sequence): use Shinmera/trivial-extensible-sequences

Browse Source
This commit is contained in:
fiddlerwoaroof
2020-12-19 19:35:50 -08:00
parent a7399b43c6
commit 1310d70f9c
1 changed files with 31 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

52
wrapped-sequence.lisp
View File

@ -6,20 +6,26 @@
(defgeneric underlying (wrapper) (defgeneric underlying (wrapper)
(:documentation "Return the underlying object of a wrapper")) (:documentation "Return the underlying object of a wrapper"))
(defclass tagged-sequence (standard-object sequence) (defgeneric key (tagged-sequence))
((%underlying-sequence :initarg :underlying :accessor underlying) (defgeneric invert-key (tagged-sequence))
(%key-fn :initarg :key :reader key) (defclass tagged-sequence (standard-object
(%invert-key :initarg :invert-key :reader invert-key))) org.shirakumo.trivial-extensible-sequences:sequence)
((%underlying-sequence :initarg :underlying :accessor underlying)))
(defmethod sb-sequence:length ((sequence tagged-sequence))
(defmethod org.shirakumo.trivial-extensible-sequences:length
((sequence tagged-sequence))
(length (underlying sequence))) (length (underlying sequence)))
(defmethod sb-sequence:elt ((sequence tagged-sequence) index) (defmethod org.shirakumo.trivial-extensible-sequences:elt
((sequence tagged-sequence) index)
(funcall (key sequence) (funcall (key sequence)
(elt (underlying sequence) (elt (underlying sequence)
index))) index)))
(defmethod (setf sb-sequence:elt) (new-value (sequence tagged-sequence) index) (defmethod (setf org.shirakumo.trivial-extensible-sequences:elt)
(new-value (sequence tagged-sequence) index)
(setf (elt (underlying sequence) (setf (elt (underlying sequence)
index) index)
(funcall (invert-key sequence) (funcall (invert-key sequence)
@ -27,27 +33,25 @@
index) index)
new-value))) new-value)))
(defmethod sb-sequence:adjust-sequence ((sequence tagged-sequence) length (defmethod org.shirakumo.trivial-extensible-sequences:adjust-sequence
((sequence tagged-sequence) length
&rest r &rest r
&key initial-element initial-contents) &key initial-element initial-contents)
(declare (ignore initial-element initial-contents)) (declare (ignore initial-element initial-contents))
(make-instance 'tagged-sequence (unless (slot-boundp sequence '%underlying-sequence)
:underlying (apply #'sb-sequence:adjust-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 (copy-seq (underlying sequence)) length
r) r)))
:key-fn (key sequence) (describe it)))
:invert-key (invert-key sequence)))
(defmethod sb-sequence:make-sequence-like (defmethod org.shirakumo.trivial-extensible-sequences:make-sequence-like
((sequence tagged-sequence) length &rest r) ((sequence tagged-sequence) length &rest r)
(apply #'sb-sequence:adjust-sequence sequence length r)) (apply #'org.shirakumo.trivial-extensible-sequences:adjust-sequence
sequence length r))
(defun wrap-sequence (seq key-fn invert-key-fn) (defun wrap-sequence (class seq)
(if invert-key-fn (make-instance class
(make-instance 'tagged-sequence :underlying seq))
:underlying seq
:key key-fn
:invert-key invert-key-fn)
(make-instance 'tagged-sequence
:underlying seq
:key key-fn)))