41399444 |
(in-package :data-lens.transducers)
|
1f67b287 |
(declaim (inline mapping filtering deduping catting splitting
exit-early taking dropping transduce
hash-table-builder vector-builder list-builder))
|
b6f51ece |
|
12598386 |
(defmacro transducer-lambda (&body (((two-arg-acc two-arg-next) &body two-arg-body)
&optional (((one-arg-arg) &body one-arg-body)
'((it) it))))
(alexandria:with-gensyms (arg1 arg2 next-sym-p)
`(lambda (,arg1 &optional (,arg2 nil ,next-sym-p))
(if ,next-sym-p
(let ((,two-arg-acc ,arg1)
(,two-arg-next ,arg2))
,@two-arg-body)
(let ((,one-arg-arg ,arg1))
,@one-arg-body)))))
(defun mapping (function &rest args)
(flet ((call-function (it)
(apply function it args)))
(lambda (rf)
(transducer-lambda
((acc next)
(funcall rf acc (call-function next)))
((it) (funcall rf it))))))
(defun mv-mapping (function &rest args)
(flet ((call-function (it)
(apply function it args)))
(lambda (rf)
(transducer-lambda
((acc next)
(funcall rf acc
(multiple-value-list (call-function next))))
((it) (funcall rf it))))))
(defun mv-selecting (function &rest args)
(flet ((call-function (it)
(apply function it args)))
(lambda (rf)
(transducer-lambda
((acc next)
(multiple-value-bind (value use-p)
(call-function next)
(if use-p
(funcall rf acc value)
acc)))
((it) (funcall rf it))))))
|
498d6599 |
(defun hash-table-select (hash-table)
(mv-selecting #'gethash hash-table))
|
12598386 |
(defun filtering (function &rest args)
(flet ((call-function (it)
(apply function it args)))
(lambda (rf)
(transducer-lambda
((acc next)
(if (call-function next)
(funcall rf acc next)
acc))
((it) (funcall rf it))))))
|
498d6599 |
(defun mv-filtering (function &rest args)
(filtering (lambda (it)
(nth-value 1 (apply function it args)))))
|
b6f51ece |
|
12598386 |
(defun seq (a b) a b)
|
705dc562 |
(defun compressing-runs (&key (test 'eql) (combiner 'seq))
|
12598386 |
(lambda (rf)
(let (last leftovers)
(transducer-lambda
((acc next)
(if (or (null last)
(funcall test last next))
(progn (setf last (funcall combiner last next)
leftovers t)
acc)
(progn (prog1 (funcall rf acc last)
|
e08fccfe |
(setf last next)))))
|
12598386 |
((it)
(funcall rf
(if leftovers
(funcall rf it last)
it)))))))
|
d0e894f7 |
(defun collecting (collector)
(lambda (rf)
(let (sofar)
(transducer-lambda
((acc next)
(if sofar
(setf sofar (funcall collector sofar next))
(setf sofar next))
(funcall rf acc sofar))))))
|
705dc562 |
(defun deduping (&optional (test 'eql))
(compressing-runs :test test))
|
b6f51ece |
(defun catting ()
(lambda (rf)
|
12598386 |
(transducer-lambda
((acc next)
|
705dc562 |
(reduce-generic next rf acc))
|
12598386 |
((it) (funcall rf it)))))
(defun mapcatting (fun)
(data-lens:• (mapping fun)
(catting)))
|
b6f51ece |
(defun splitting (&rest functions)
(let ((splitter (apply #'data-lens:juxt functions)))
(mapping splitter)))
(defun taking (n)
(lambda (rf)
(let ((taken 0))
|
12598386 |
(transducer-lambda
((acc next)
(incf taken)
(if (<= taken n)
(funcall rf acc next)
(exit-early acc)))
((it) (funcall rf it))))))
|
b6f51ece |
(defun dropping (n)
(lambda (rf)
(let ((taken 0))
|
12598386 |
(transducer-lambda
((acc next)
(if (< taken n)
(progn (incf taken)
acc)
(funcall rf acc next)))
((it) (funcall rf it))))))
|
b6f51ece |
|
41399444 |
(defun eduction (xf seq)
(lambda (build)
|
5bd17dc8 |
(unwrap
|
41399444 |
build
(catch 'done
|
5bd17dc8 |
(reduce-generic seq
(funcall xf (stepper build))
(init build))))))
|
41399444 |
|
5bd17dc8 |
(defmethod init ((it (eql 'hash-table-builder)))
|
41399444 |
(make-hash-table))
|
5bd17dc8 |
(defmethod stepper ((it (eql 'hash-table-builder)))
|
12598386 |
(transducer-lambda
((acc next)
(destructuring-bind (k v) next
(setf (gethash k acc) v))
acc)))
|
bd9ef2fb |
(defmethod data-lens.transducers.internals:builder-for-input ((inp hash-table))
(values 'hash-table-builder
(alexandria:copy-hash-table inp)))
|
1f67b287 |
|
5bd17dc8 |
(defmethod init ((it (eql 'vector-builder)))
|
41399444 |
(make-array 0 :fill-pointer t :adjustable t))
|
5bd17dc8 |
(defmethod stepper ((it (eql 'vector-builder)))
|
12598386 |
(transducer-lambda
((acc next)
(vector-push-extend next acc)
acc)))
|
bd9ef2fb |
(defmethod data-lens.transducers.internals:builder-for-input ((inp vector))
(values 'vector-builder
(make-array (array-dimensions inp)
:initial-contents inp
:fill-pointer t)))
|
1f67b287 |
|
5bd17dc8 |
(defmethod init ((it (eql 'list-builder)))
|
1f67b287 |
(declare (optimize (speed 3)))
|
a7399b43 |
(let ((it (list nil)))
(coerce (vector it it)
'(simple-array list (2)))))
|
5bd17dc8 |
(defmethod stepper ((it (eql 'list-builder)))
|
12598386 |
(transducer-lambda
((acc a)
(declare (optimize (speed 3))
(type (simple-array list (2)) acc))
(let* ((to-build (elt acc 1)))
(push a (cdr to-build))
(setf (elt acc 1) (cdr to-build)))
acc)))
|
5bd17dc8 |
(defmethod unwrap ((it (eql 'list-builder)) obj)
|
a7399b43 |
(cdr (elt obj 0)))
|
bd9ef2fb |
(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)))))
|
b6f51ece |
|
41399444 |
(defmacro comment (&body body)
(declare (ignore body))
nil)
|
b6f51ece |
(comment
(defun 2* (it)
(* 2 it))
|
1f67b287 |
(let ((result (transduce (alexandria:compose
(catting)
(mapping #'parse-integer)
(filtering (complement #'evenp))
|
5bd17dc8 |
(mapping (data-lens:juxt #'identity
#'identity))
|
1f67b287 |
(mapping (data-lens:transform-head #'2*))
(mapping (data-lens:transform-head #'1+))
(taking 2))
|
b6f51ece |
'hash-table-builder
|
1f67b287 |
'(("123" "234" "345" "454")
("568" "490")
("567" "213")))))
|
b6f51ece |
(values result
(alexandria:hash-table-alist result))))
|