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

chore: remote-tracking branch 'gh/master'

Browse Source
This commit is contained in:
Edward Langley
2025-06-28 15:02:08 -07:00
parent ffe67ab084 f76e0e0320
commit 184464a017
3 changed files with 13 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
data-lens-fset.lisp
View File

@ -17,9 +17,9 @@
(data-lens.transducers:transducer-lambda (data-lens.transducers:transducer-lambda
((acc next) ((acc next)
(fset:with acc next)))) (fset:with acc next))))
(defmethod data-lens:functionalize ((it fset:set)) (defmethod data-lens:functionalize ((set fset:set))
(lambda (key) (lambda (it)
(nth-value 1 (fset:lookup it key)))) (fset:contains? set it)))
(defmethod data-lens:extract-key ((it fset:set) key) (defmethod data-lens:extract-key ((it fset:set) key)
(nth-value 1 (fset:lookup it key))) (nth-value 1 (fset:lookup it key)))
(defun make-set-lens (item) (defun make-set-lens (item)
@ -114,3 +114,4 @@
(funcall (funcall (make-set-lens loc) (funcall (funcall (make-set-lens loc)
cb) cb)
rec)) rec))

10
optics.lisp
View File

@ -210,8 +210,8 @@ contain the new value at the location focused by the lens."
(defun a-lens (cb) (defun a-lens (cb)
(lambda (foo) (lambda (foo)
(fw.lu:prog1-bind (new (clone foo)) (fw.lu:prog1-bind (new (clone foo))
(setf (a new) (setf (a new)
(funcall cb (a foo)))))) (funcall cb (a foo))))))
(view 'a-lens (view 'a-lens
(over 'a-lens '1+ (over 'a-lens '1+
(set 'a-lens 2 (set 'a-lens 2
@ -222,10 +222,14 @@ contain the new value at the location focused by the lens."
(:method ((rec hash-table) cb loc) (:method ((rec hash-table) cb loc)
(funcall (funcall (make-hash-table-lens loc) (funcall (funcall (make-hash-table-lens loc)
cb) cb)
rec))
(:method ((rec vector) cb loc)
(funcall (funcall (make-list-lens loc)
cb)
rec))) rec)))
(defun lens (loc) (defun lens (loc)
"A lens for updating a hash-table, discarding previous values" "extensible lens using a multimethod for internal implementation"
(lambda (cb) (lambda (cb)
(lambda (rec) (lambda (rec)
(generic-lens rec cb loc)))) (generic-lens rec cb loc))))

2
transducer-protocol.lisp
View File

@ -56,8 +56,10 @@
CONSTRAINT: SEQ should be copied, not modified")) CONSTRAINT: SEQ should be copied, not modified"))
(declaim (inline exit-early))
(defun exit-early (acc) (defun exit-early (acc)
(throw 'done acc)) (throw 'done acc))
(declaim (notinline exit-early))
(defun transduce (xf build seq) (defun transduce (xf build seq)
(let* ((xf (etypecase xf (let* ((xf (etypecase xf