Merge remote-tracking branch 'origin/master'

lens.lisp

@@ -179,6 +179,11 @@
   (lambda (seq)
     (map 'list selector seq)))
 
+(defun tap (cb)
+  (lambda (it)
+    (prog1 it
+      (funcall cb it))))
+
 (defun slice (start &optional end)
   (lambda (it)
     (subseq it start end)))
@@ -418,6 +423,31 @@
                       (reverse (cdr it))))
               (alexandria:hash-table-alist groups)))))
 
+(defun x-group (fn)
+  (lambda (groups)
+    (loop for (key . group) in groups
+          collect (funcall fn key group))))
+
+(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))))

package.lisp

@@ -21,7 +21,7 @@
            #:transform-elt #:denest #:op #:defalias #:<> #:<>1 #:== #:•
            #:∘ #:suffixp #:functionalize #:inc #:group-by #:keys
            #:conj #:disj #:delay #:of-type #:transform #:calling*
-           #:calling))
+           #:calling #:hash-join #:tap #:x-group))
 
 (defpackage :data-lens.transducers.internals
   (:use :cl)