@@ -6,16 +6,17 @@ the composition of more primitive operations.

 #+BEGIN_SRC lisp

   DATA-LENS> (funcall (on (compress-runs :collector 'combine-matching-lists)

                           (alexandria:compose 

-                           (over (juxt (element 0)

-                                       'identity))

-                           (sorted 'string<)))

-                      '("January"   "February" "March"    "April"

-                        "May"       "June"     "July"     "August"

-                        "September" "October"  "November" "December"))

-  #| ==> ((#\A "April" "August") 

+                           (over (data-lens:juxt

+                                  (data-lens:element 0)

+                                  'identity))

+                           (sorted 'char< :key (element 0))))

+                      '("January" "February" "March" "April"

+                        "May" "June" "July" "August"

+                        "September" "October" "November" "December"))

+  #| ==> ((#\A "April" "August")

           (#\D "December")

           (#\F "February")

-          (#\J "January" "July" "June")

+          (#\J "January" "June" "July")

           (#\M "March" "May")

           (#\N "November")

           (#\O "October")

@@ -52,15 +52,18 @@

         acc

         (cons next acc))))

+(defun matching-list-reducer (test acc next)

+  (if (and acc

+           (funcall test (caar acc) (car next)))

+      (cons (cons (caar acc)

+                  (append (cdar acc)

+                          (cdr next)))

+            (cdr acc))

+      (cons next acc)))

+

 (defun combine-matching-lists (&key (test 'eql) &allow-other-keys)

   (lambda (acc next)

-    (if (and acc

-             (funcall test (caar acc) (car next)))

-        (cons (cons (caar acc)

-                    (append (cdar acc)

-                            (cdr next)))

-              (cdr acc))

-        (cons next acc))))

+    (matching-list-reducer test acc next)))

 (defun-ct compress-runs (&key (collector 'cons-new) (test 'eql) (key 'identity))

   (lambda (it)

@@ -72,7 +75,7 @@

 (defun-ct sorted (comparator &rest r &key key)

   (declare (ignore key))

   (lambda (it)

-    (apply #'sort (copy-seq it) comparator r)))

+    (apply #'stable-sort (copy-seq it) comparator r)))

 (defun-ct element (num)

   (lambda (it)