feat(transducers): add DATA-LENS.TRANSDUCERS:INTO, with tests

package.lisp

@@ -18,7 +18,8 @@
            #: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 #:== #:• #:suffixp #:functionalize))
+           #:op #:defalias #:<> #:<>1 #:== #:• #:suffixp #:functionalize
+           #:inc))
 
 (defpackage :data-lens.transducers.internals
   (:use :cl)
@@ -29,11 +30,11 @@
   (:use :cl)
   (:import-from :data-lens.transducers.internals
                 #:unwrap #:init #:reduce-generic #:stepper #:transduce
-                #:exit-early)
+                #:exit-early #:into)
   (:export #:mapping :filtering :deduping :catting :splitting
            #:exit-early :taking :dropping :transduce
            #:hash-table-builder :vector-builder :list-builder
            #:collecting #:mv-mapping #:mv-selecting
            #:hash-table-select #:mv-filtering #:mapcatting
            #:lazy-sequence #:compressing-runs #:iota
-           #:repeating #:repeating*))
+           #:repeating #:repeating* #:into))

t/transducers.lisp

@@ -195,3 +195,65 @@
                    (funcall (data-lens:• (data-lens:sorted '< :key 'car)
                                          (data-lens:sorted '< :key 'cdr))
                             (alexandria:hash-table-alist result))))))
+
+(5am:def-test into (:suite :data-lens.transducers :depends-on mapping)
+  (5am:is (equal '(0 1 2)
+                 (data-lens.transducers:into '()
+                                             (data-lens.transducers:taking 3)
+                                             (data-lens.transducers:iota))))
+
+  (5am:is (equal '(0 1 2)
+                 (data-lens.transducers:into '(0 1 2)
+                                             (data-lens.transducers:taking 0)
+                                             (data-lens.transducers:iota))))
+
+  (5am:is (equal '()
+                 (data-lens.transducers:into '()
+                                             (data-lens.transducers:taking 0)
+                                             (data-lens.transducers:iota))))
+
+  (5am:is (equal '()
+                 (data-lens.transducers:into '()
+                                             (data-lens.transducers:mapping #'identity)
+                                             #())))
+
+  (5am:is (equalp (alexandria:plist-hash-table '(:p 0 :l 1 :i 2 :s 3 :t 4))
+                  (let ((count 0))
+                    (data-lens.transducers:into (make-hash-table)
+                                                (data-lens.transducers:mapping
+                                                 (lambda (it)
+                                                   (prog1 (list it count)
+                                                     (incf count))))
+                                                '(:p :l :i :s :t)))))
+
+  (loop for type in '(vector list)
+        do (5am:is (equalp #(1 2 3 4 5 6)
+                           (data-lens.transducers:into #(1 2 3)
+                                                       (data-lens.transducers:mapping
+                                                        (data-lens:inc 4))
+                                                       (coerce #(0 1 2) type))))
+           (5am:is (equal '(1 2 3 4 5 6)
+                          (data-lens.transducers:into '(1 2 3)
+                                                      (data-lens.transducers:mapping
+                                                       (data-lens:inc 4))
+                                                      (coerce #(0 1 2) type))))
+
+           (5am:is (equal '(1 2 3 4 5 6)
+                          (data-lens.transducers:into '(1 2 3)
+                                                      (data-lens.transducers:mapping
+                                                       (data-lens:inc 4))
+                                                      (coerce #(0 1 2) type))))
+           (5am:is (equal '(1 2 3 4 5 6)
+                          (data-lens.transducers:into '(1 2 3)
+                                                      (data-lens:•
+                                                       (data-lens.transducers:taking 3)
+                                                       (data-lens.transducers:mapping
+                                                        (data-lens:inc 4)))
+                                                      (data-lens.transducers:iota))))
+           (5am:is (equalp #(1 2 3 4 5 6)
+                           (data-lens.transducers:into #(1 2 3)
+                                                       (data-lens:•
+                                                        (data-lens.transducers:taking 3)
+                                                        (data-lens.transducers:mapping
+                                                         (data-lens:inc 4)))
+                                                       (data-lens.transducers:iota))))))

transducer-protocol.lisp

@@ -16,10 +16,19 @@
                seq)
       acc)))
 
+#+(or)
+(defun document (&rest strings)
+  (serapeum:string-join strings #.(format nil "~2%")))
+
 (defgeneric init (client))
 (defgeneric stepper (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"))
 
 (defun exit-early (acc)
   (throw 'done acc))
@@ -36,10 +45,29 @@
                                        transducer
                                        (init build)))))))
 
-#+(or)
+(defun into (to xf from)
+  (multiple-value-bind (builder init) (builder-for-input to)
+    (let* ((xf (etypecase xf
+                 (list (apply 'alexandria:compose xf))
+                 ((or function symbol) xf)))
+           (transducer (funcall xf (stepper builder))))
+      (unwrap builder
+              (funcall transducer
+                       (catch 'done
+                         (reduce-generic from
+                                         transducer
+                                         init)))))))
+
+(defmacro defdocumentation (name &body doc-specs)
+  name doc-specs
+  nil)
+
 (defdocumentation transducer-protocol
-    (:function transduce (xf build seq)
+  (:function transduce (xf builder seq)
-               )
+             "Run a transducer XF over sequence SEQ using BUILDER to accumulate results.
+
+Uses the generic function REDUCE-GENERIC so transducers work over lazy
+sequences and hash tables.")
   (:generic-function unwrap (client obj)
                      )
   (:generic-function unwrap (client obj)

transducers.lisp

@@ -155,6 +155,9 @@
      (destructuring-bind (k v) next
        (setf (gethash k acc) v))
      acc)))
+(defmethod data-lens.transducers.internals:builder-for-input ((inp hash-table))
+  (values 'hash-table-builder
+          (alexandria:copy-hash-table inp)))
 
 (defmethod init ((it (eql 'vector-builder)))
   (make-array 0 :fill-pointer t :adjustable t))
@@ -163,6 +166,12 @@
     ((acc next)
      (vector-push-extend next acc)
      acc)))
+(defmethod data-lens.transducers.internals:builder-for-input ((inp vector))
+  (values 'vector-builder
+          (make-array (array-dimensions inp)
+                      :initial-contents inp
+                      :fill-pointer t)))
+
 
 (defmethod init ((it (eql 'list-builder)))
   (declare (optimize (speed 3)))
@@ -180,6 +189,13 @@
      acc)))
 (defmethod unwrap ((it (eql 'list-builder)) obj)
   (cdr (elt obj 0)))
+(defmethod data-lens.transducers.internals:builder-for-input ((inp list))
+  (let ((builder 'list-builder))
+    (values builder
+            (if inp
+                (let ((inp (cons nil (copy-list inp))))
+                  (vector inp (last inp)))
+                (init builder)))))
 
 (defmacro comment (&body body)
   (declare (ignore body))