From 742a155e9113953e0ffd2df2888addc469216550 Mon Sep 17 00:00:00 2001
From: Edward Langley <el-github@elangley.org>
Date: Sat, 1 Feb 2025 12:54:06 -0800
Subject: [PATCH 1/2] feat: extensible lenses, add functionalize method for
 fset

---
 data-lens-fset.lisp | 13 ++++++++++---
 optics.lisp         | 20 ++++++++++++++++++--
 2 files changed, 28 insertions(+), 5 deletions(-)

diff --git a/data-lens-fset.lisp b/data-lens-fset.lisp
index 7465e49..c953f37 100644
--- a/data-lens-fset.lisp
+++ b/data-lens-fset.lisp
@@ -17,9 +17,9 @@
   (data-lens.transducers:transducer-lambda
     ((acc next)
      (fset:with acc next))))
-(defmethod data-lens:functionalize ((it fset:set))
-  (lambda (key)
-    (nth-value 1 (fset:lookup it key))))
+(defmethod data-lens:functionalize ((set fset:set))
+  (lambda (it)
+    (fset:contains? set it)))
 (defmethod data-lens:extract-key ((it fset:set) key)
   (nth-value 1 (fset:lookup it key)))
 (defun make-set-lens (item)
@@ -63,6 +63,11 @@
            rec))
 
 
+(defmethod data-lens.transducers.internals:reduce-generic ((map fset:map) (func function) init)
+  (fset:reduce (lambda (acc k v)
+                 (funcall func acc (list k v)))
+               map
+               :initial-value init))
 (defmethod data-lens.transducers.internals:builder-for-input ((map fset:map))
   (values 'fset-map-builder
           map))
@@ -104,7 +109,9 @@
             m)))
 (defun make-bag-lens (item)
   (make-set-lens item))
+
 (defmethod data-lens.lenses:generic-lens ((rec fset:bag) cb loc)
   (funcall (funcall (make-set-lens loc)
                     cb)
            rec))
+
diff --git a/optics.lisp b/optics.lisp
index 8e9009b..92a8bcb 100644
--- a/optics.lisp
+++ b/optics.lisp
@@ -210,10 +210,26 @@ contain the new value at the location focused by the lens."
   (defun a-lens (cb)
     (lambda (foo)
       (fw.lu:prog1-bind (new (clone foo))
-                        (setf (a new)
-                              (funcall cb (a foo))))))
+        (setf (a new)
+              (funcall cb (a foo))))))
   (view 'a-lens
         (over 'a-lens '1+
               (set 'a-lens 2
                    (make-instance 'foo :a 1)))) #|
   ==> 3 |#)
+
+(defgeneric generic-lens (rec cb loc)
+  (:method ((rec hash-table) cb loc)
+    (funcall (funcall (make-hash-table-lens loc)
+                      cb)
+             rec))
+  (:method ((rec vector) cb loc)
+    (funcall (funcall (make-list-lens loc)
+                      cb)
+             rec)))
+
+(defun lens (loc)
+  "extensible lens using a multimethod for internal implementation"
+  (lambda (cb)
+    (lambda (rec)
+      (generic-lens rec cb loc))))

From f76e0e0320a834645d7cd6e0ce403be7c659aa8b Mon Sep 17 00:00:00 2001
From: Edward Langley <el-github@elangley.org>
Date: Sat, 28 Jun 2025 14:52:11 -0700
Subject: [PATCH 2/2] feat: transduer handles edge cases more correctly

---
 transducer-protocol.lisp | 43 ++++++++++++++++++++++++++++++++--------
 1 file changed, 35 insertions(+), 8 deletions(-)

diff --git a/transducer-protocol.lisp b/transducer-protocol.lisp
index d03a330..a094b8c 100644
--- a/transducer-protocol.lisp
+++ b/transducer-protocol.lisp
@@ -16,12 +16,6 @@
                seq)
       acc)))
 
-#+(or)
-(defun document (&rest strings)
-  (serapeum:string-join strings #.(format nil "~2%")))
-
-(defgeneric init (client))
-(defgeneric stepper (client))
 (defmacro transducer-lambda (&body (((two-arg-acc two-arg-next) &body two-arg-body)
                                     &optional (((one-arg-arg) &body one-arg-body)
                                                '((it) it))))
@@ -33,16 +27,39 @@
              ,@two-arg-body)
            (let ((,one-arg-arg ,arg1))
              ,@one-arg-body)))))
+
+(defgeneric init (client)
+  (:method ((client symbol))
+    (unless (fboundp client)
+      (error "client not funcallable"))
+    (init (fdefinition client)))
+  (:method ((client function))
+    (funcall client)))
+
+(defgeneric stepper (client)
+  (:method ((client function))
+    (transducer-lambda
+      ((acc a)
+       (declare (optimize (speed 3)))
+       (funcall client acc a))))
+  (:method ((client symbol))
+    (unless (fboundp client)
+      (error "client not funcallable"))
+    (init (fdefinition client))))
+
 (defgeneric unwrap (client obj)
   (:method (client obj) obj))
+
 (defgeneric builder-for-input (seq)
   (:documentation
    "Take a transducible sequence, return a builder and an init value for that builder.
 
 CONSTRAINT: SEQ should be copied, not modified"))
 
+(declaim (inline exit-early))
 (defun exit-early (acc)
   (throw 'done acc))
+(declaim (notinline exit-early))
 
 (defun transduce (xf build seq)
   (let* ((xf (etypecase xf
@@ -56,7 +73,16 @@ CONSTRAINT: SEQ should be copied, not modified"))
                                        transducer
                                        (init build)))))))
 
-(defun into (to xf from)
+(defun into (to xf &optional (from nil from-p))
+  (if (not from-p)
+      (let ((from xf))
+        (data-lens.transducers:into to
+                                    (data-lens.transducers:mapping
+                                     (lambda (&rest args)
+                                       (if (null (cdr args))
+                                           (car args)
+                                           args)))
+                                    from))
   (multiple-value-bind (builder init) (builder-for-input to)
     (let* ((xf (etypecase xf
                  (list (apply 'alexandria:compose xf))
@@ -67,7 +93,8 @@ CONSTRAINT: SEQ should be copied, not modified"))
                        (catch 'done
                          (reduce-generic from
                                          transducer
-                                         init)))))))
+                                             init))))))))
+
 
 (defmacro defdocumentation (name &body doc-specs)
   name doc-specs