diff --git a/lens.lisp b/lens.lisp index 5c3250a..146f7d7 100644 --- a/lens.lisp +++ b/lens.lisp @@ -93,10 +93,10 @@ operator): (== (view lens (set lens value rec)) value) - + (== (set lens (view lens rec) rec) rec) - + (== (set lens value2 (set lens value1 rec)) (set lens value2 rec)) @@ -234,11 +234,12 @@ contain the new value at the location focused by the lens." #:compress-runs #:combine-matching-lists #:sorted #:applicable-when #:of-length #:of-min-length #:of-max-length #:transform-head #:maximizing #:zipping #:applying #:splice-elt #:transform-elt #:denest - #:op #:defalias #:<> #:<>1)) + #:op #:defalias #:<> #:<>1 + #:•)) (in-package :data-lens) -(declaim +(declaim (inline data-lens:over data-lens:transform-tail data-lens:applicable-when data-lens:of-min-length data-lens:on data-lens:over data-lens:slice @@ -524,3 +525,5 @@ contain the new value at the location focused by the lens." (defmacro <>1 (&rest funs) `(alexandria:compose ,@funs)) +(defmacro • (&rest funs) + `(alexandria:compose ,@funs)) diff --git a/wrapped-sequence.lisp b/wrapped-sequence.lisp new file mode 100644 index 0000000..a773255 --- /dev/null +++ b/wrapped-sequence.lisp @@ -0,0 +1,53 @@ +(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)))