diff --git a/lens.lisp b/lens.lisp index 5596a9b..42044d0 100644 --- a/lens.lisp +++ b/lens.lisp @@ -423,6 +423,26 @@ (reverse (cdr it)))) (alexandria:hash-table-alist groups))))) +(defun hash-join (probe join-fn &key (test 'eql) (key 'car)) + (let* ((lookup (make-hash-table :test test :size (length probe))) + (lookup-fn (functionalize lookup))) + (map nil + (lambda (it) + (setf (gethash (funcall key it) + lookup) + it)) + probe) + (lambda (collection) + (map (etypecase collection + (list 'list) + (vector 'vector) + (sequence 'list)) + (lambda (it) + (let* ((key-value (funcall key it)) + (matching-probe (funcall lookup-fn key-value))) + (funcall join-fn it matching-probe))) + collection)))) + #+nil (defmacro <> (arity &rest funs) (let ((arg-syms (loop repeat arity collect (gensym)))) diff --git a/package.lisp b/package.lisp index 17fc338..aa01b33 100644 --- a/package.lisp +++ b/package.lisp @@ -22,6 +22,7 @@ #:∘ #:suffixp #:functionalize #:inc #:group-by #:keys #:conj #:disj #:delay #:of-type #:transform #:calling* #:calling + #:hash-join #:tap)) (defpackage :data-lens.transducers.internals