feat: two-arg INTO and continue restart for xfs

This commit is contained in:
Edward Langley
2025-06-28 14:58:32 -07:00
parent d52023f9f4
commit ffe67ab084
3 changed files with 54 additions and 9 deletions

View File

@ -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