diff --git a/t/transducers.lisp b/t/transducers.lisp index abb6bf3..fd0a660 100644 --- a/t/transducers.lisp +++ b/t/transducers.lisp @@ -237,6 +237,22 @@ '< :key 'car)))) + (5am:is (equalp #(1 2 3 4) + (data-lens.transducers:into #() '(1 2 3 4))) + "~s can be used to convert one type into another without a transducer" + 'data-lens.transducers:into) + + (5am:is (equalp #(1 2 4) + (handler-bind ((simple-error #'continue)) + (data-lens.transducers:into #() + (data-lens.transducers:mapping + (lambda (it) + (if (= it 3) + (error "fail") + it))) + '(1 2 3 4)))) + "transducers provide a continue restart") + (loop for type in '(vector list) do (5am:is (equalp #(1 2 3 4 5 6) (data-lens.transducers:into #(1 2 3) diff --git a/transducer-protocol.lisp b/transducer-protocol.lisp index d03a330..6035a25 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,8 +27,29 @@ ,@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. @@ -56,7 +71,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 +91,7 @@ CONSTRAINT: SEQ should be copied, not modified")) (catch 'done (reduce-generic from transducer - init))))))) + init)))))))) (defmacro defdocumentation (name &body doc-specs) name doc-specs diff --git a/transducers.lisp b/transducers.lisp index 0fa02a1..4257db8 100644 --- a/transducers.lisp +++ b/transducers.lisp @@ -23,7 +23,12 @@ (lambda (rf) (transducer-lambda ((acc next) - (funcall rf acc (call-function next))) + (restart-case + (funcall rf acc (call-function next)) + (continue () + :report (lambda (s) + (format s "skip this item")) + acc))) ((it) (funcall rf it)))))) (defun mv-mapping (function &rest args)