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

feat: add • compose operator

Browse Source
This commit is contained in:
Ed Langley
2020-09-30 15:48:03 -07:00
parent 32b8a0bb7f
commit 800a03e0c6
2 changed files with 60 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
lens.lisp
View File

@ -93,10 +93,10 @@ operator):
(== (view lens (set lens value rec)) (== (view lens (set lens value rec))
value) value)
(== (set lens (view lens rec) rec) (== (set lens (view lens rec) rec)
rec) rec)
(== (set lens value2 (set lens value1 rec)) (== (set lens value2 (set lens value1 rec))
(set lens value2 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 #:compress-runs #:combine-matching-lists #:sorted #:applicable-when
#:of-length #:of-min-length #:of-max-length #:transform-head #:of-length #:of-min-length #:of-max-length #:transform-head
#:maximizing #:zipping #:applying #:splice-elt #:transform-elt #:denest #:maximizing #:zipping #:applying #:splice-elt #:transform-elt #:denest
#:op #:defalias #:<> #:<>1)) #:op #:defalias #:<> #:<>1
#:•))
(in-package :data-lens) (in-package :data-lens)
(declaim (declaim
(inline data-lens:over data-lens:transform-tail (inline data-lens:over data-lens:transform-tail
data-lens:applicable-when data-lens:of-min-length data-lens:applicable-when data-lens:of-min-length
data-lens:on data-lens:over data-lens:slice 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) (defmacro <>1 (&rest funs)
`(alexandria:compose ,@funs)) `(alexandria:compose ,@funs))
(defmacro • (&rest funs)
`(alexandria:compose ,@funs))

53
wrapped-sequence.lisp Normal file
View File

@ -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)))